added more link mongodb output

[pxelator] / lib / PXElator / tftpd.pm

diff --git a/lib/PXElator/tftpd.pm b/lib/PXElator/tftpd.pm
index 6b0a6e8..f4a8fde 100644 (file)
--- a/lib/PXElator/tftpd.pm
+++ b/lib/PXElator/tftpd.pm
@@ -4,7 +4,9 @@ use warnings;
 use strict;
 
 use Net::TFTPd 0.03 qw(%OPCODES);
+use IO::Socket::INET;
 use Data::Dump qw/dump/;
+use store;
 
 use server;
 
@@ -16,40 +18,64 @@ sub path {
        my $glob = shift;
        my $path = (glob("$dir/$glob"))[0];
        die "can't find anything for $dir/$glob" unless $path;
-warn $path;
+       warn 'path ', $path if $debug;
        $path =~ s{^$dir}{};
        return $path;
 }
 
+use progress_bar;
+
 sub transfer_status {
-       my $req = shift;
-       if( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'} ) {
-               printf "RRQ %u\/%u\r", $req->{'_REQUEST_'}{'LASTACK'}, $req->{'_REQUEST_'}{'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 "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;
+
+       my $ip = $request->{_REQUEST_}->{PeerAddr};
+       config::for_ip( $ip );
+
        if ( $request->{RootDir} ne $dir ) {
                $request->{RootDir} = $dir;
                warn "new root: $dir";
        }
 
-       # received request
-       printf "Received a %s for file '%s'\n", $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, $request->{'_REQUEST_'}{'FileName'};
+       my $file = $request->{'_REQUEST_'}{'FileName'};
+       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 "OK, transfer completed successfully\n";
+               my $size = -s "$dir/$file";
+               $audit->{state} = 'finish';
+               $audit->{size} = $size;
+               store::audit( $opcode, $audit );
        } else {
-               warn Net::TFTPd->error;
-               $request->processRQ();
+               $audit->{state} = 'error';
+               $audit->{error} = Net::TFTPd->error;
+               store::audit( $opcode, $audit );
        }
 
 }
@@ -60,33 +86,53 @@ sub start {
 
        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;
 
+       store::audit( 'start', {
+               addr => $listener->{LocalAddr},
+               port => $listener->{LocalPort},
+               timeout => $listener->{Timeout},
+               params => { %params },
+       });
+
        while(1) {
-       
-               printf "TFTP listen %s:%d timeout: %d dir: $dir\n",
-                       $listener->{LocalAddr},
-                       $listener->{LocalPort},
-                       $listener->{Timeout};
 
                # 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;
                }
 
        }