/usr/share/perl5/Perlbal/UploadListener.pm is in libperlbal-perl 1.80-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | ######################################################################
# Listen for UDP upload status packets
#
# Copyright 2005-2007, Six Apart, Ltd.
package Perlbal::UploadListener;
use strict;
use warnings;
no warnings qw(deprecated);
use base "Perlbal::Socket";
use fields qw(service hostport);
# TCPListener
sub new {
my ($class, $hostport, $service) = @_;
my $sock =
IO::Socket::INET->new(
LocalAddr => $hostport,
Proto => "udp",
ReuseAddr => 1,
Blocking => 0,
);
return Perlbal::error("Error creating listening socket: " . ($@ || $!))
unless $sock;
my $self = fields::new($class);
$self->SUPER::new($sock);
$self->{service} = $service;
$self->{hostport} = $hostport;
$self->watch_read(1);
return $self;
}
my %status;
my @todelete;
sub get_status {
my $ses = shift;
return $status{$ses};
}
# TCPListener: accepts a new client connection
sub event_read {
my Perlbal::TCPListener $self = shift;
my $buf;
$self->{sock}->recv($buf, 500);
return unless $buf =~ /^UPLOAD:(\w{5,50}):(\d+):(\d+):(\d+):(\d+)$/;
my ($ses, $done, $total, $starttime, $nowtime) = ($1, $2, $3, $4, $5);
my $now = time();
$status{$ses} = {
done => $done,
total => $total,
starttime => $starttime,
lasttouch => $now,
};
# keep a history of touched records, then we'll clean 'em
# after 30 seconds.
push @todelete, [$now, $ses];
my $too_old = $now - 4;
while (@todelete && $todelete[0][0] < $too_old) {
my $rec = shift @todelete;
my $to_kill = $rec->[1];
if (my $krec = $status{$to_kill}) {
my $last_touch = $krec->{lasttouch};
delete $status{$to_kill} if $last_touch < $too_old;
}
}
}
sub as_string {
my Perlbal::TCPListener $self = shift;
my $ret = $self->SUPER::as_string;
my Perlbal::Service $svc = $self->{service};
$ret .= ": listening on $self->{hostport} for service '$svc->{name}'";
return $ret;
}
sub as_string_html {
my Perlbal::TCPListener $self = shift;
my $ret = $self->SUPER::as_string_html;
my Perlbal::Service $svc = $self->{service};
$ret .= ": listening on $self->{hostport} for service <b>$svc->{name}</b>";
return $ret;
}
sub die_gracefully {
# die off so we stop waiting for new connections
my $self = shift;
$self->close('graceful_death');
}
1;
# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End:
|