use strict;
use Net::TFTPd 0.03 qw(%OPCODES);
+use IO::Socket::INET;
use Data::Dump qw/dump/;
-use Module::Refresh;
+use store;
use server;
return $path;
}
-STDERR->autoflush(1);
+use progress_bar;
sub transfer_status {
- my $req = shift;
- if( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'} ) {
- printf STDERR "RRQ %s %u\/%u\r", map { $req->{_REQUEST_}->{$_} } ( 'FileName', 'LASTACK', 'LASTBLK' );
- } elsif ( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'WRQ'} ) {
+ my $request = shift;
+ my $r = $request->{'_REQUEST_'} || die "no _REQUEST_ in ",dump( $request );
+
+ if( $r->{'OPCODE'} eq $OPCODES{'RRQ'} ) {
+ progress_bar::tick( $r->{FileName}, $r->{BlkSize} * $r->{LASTACK}, $r->{BlkSize} * $r->{LASTBLK} );
+ } elsif ( $r->{'OPCODE'} eq $OPCODES{'WRQ'} ) {
die "WRQ disabled";
- printf STDERR "WRQ: %u\/%u\n", $req->{'_REQUEST_'}{'LASTBLK'}, $req->{'_REQUEST_'}{'LASTACK'};
} else {
- warn "IGNORED: ", dump( $req );
+ warn "IGNORED: ", dump( $request );
}
}
+use config;
+
sub tftp_request {
my $request = shift;
warn 'request: ', dump( $request ) if $debug;
- config::for_ip();
+ my $ip = $request->{_REQUEST_}->{PeerAddr};
+ config::for_ip( $ip );
if ( $request->{RootDir} ne $dir ) {
$request->{RootDir} = $dir;
}
my $file = $request->{'_REQUEST_'}{'FileName'};
- # received request
- print $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, " $file\n";
+ my $opcode = $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}};
+
+ my $audit = {
+ ip => $ip,
+ opcode => $opcode,
+ path => $file,
+ state => 'start',
+ };
+ store::audit( $opcode, $audit );
+
+ progress_bar::start;
# process the request
if( $request->processRQ() ) {
- print "\nOK completed $file ", -s "$dir/$file", "\n";
+ my $size = -s "$dir/$file";
+ $audit->{state} = 'finish';
+ $audit->{size} = $size;
+ store::audit( $opcode, $audit );
} else {
- print "ERROR ", Net::TFTPd->error, "\n";
- $request->processRQ();
+ $audit->{state} = 'error';
+ $audit->{error} = Net::TFTPd->error;
+ store::audit( $opcode, $audit );
}
}
warn 'start';
- my $listener = Net::TFTPd->new(
+ # XXX we need to setup listener ourselfs because we need Reuse
+ my %params = (
+ Proto => 'udp',
+# LocalAddr => $server::ip,
+# LocalAddr => '0.0.0.0',
+ LocalPort => 69,
+ Reuse => 1,
+ );
+
+ my $udpserver = IO::Socket::INET->new(%params);
+ die "can't start server ",dump( \%params ), " $!" unless $udpserver;
+
+ my $listener = bless {
RootDir => $dir,
- Writable => 0,
- Timeout => 3600,
+
+ ACKtimeout => 4,
+ ACKretries => 4,
+ Readable => 1,
+ Writable => 0,
+ Timeout => 3600,
+
CallBack => \&transfer_status,
-# LocalAddr => $server::ip,
- LocalAddr => '0.0.0.0',
# BlkSize => 8192,
-# BlkSize => 512,
- BlkSize => 1456, # IBM GE seems to be picky
+ BlkSize => 512, # Dell's RAC doesn't like bigger packets
+# BlkSize => 1456, # IBM GE seems to be picky
Debug => 99,
- ) || die Net::TFTPd->error;
+ %params, # merge user parameters
+ _UDPSERVER_ => $udpserver,
+ }, 'Net::TFTPd';
warn 'listener: ',dump( $listener ) if $debug;
- printf "TFTP listen %s:%d timeout: %d dir: $dir\n",
- $listener->{LocalAddr},
- $listener->{LocalPort},
- $listener->{Timeout};
+ store::audit( 'start', {
+ addr => $listener->{LocalAddr},
+ port => $listener->{LocalPort},
+ timeout => $listener->{Timeout},
+ params => { %params },
+ });
while(1) {
- Module::Refresh->refresh;
-
# wait for any request (RRQ or WRQ)
if(my $request = $listener->waitRQ()) {
+ server->refresh;
tftp_request $request;
- } else {
- warn Net::TFTPd->error;
+ } elsif ( my $error = Net::TFTPd->error ) {
+ warn $error;
}
}