git.rot13.org Git - pxelator/blob - lib/PXElator/tftpd.pm

   1 package tftpd;
   2
   3 use warnings;
   4 use strict;
   5
   6 use Net::TFTPd 0.03 qw(%OPCODES);
   7 use Data::Dump qw/dump/;
   8
   9 use server;
  10
  11 our $debug = server::debug;
  12
  13 our $dir  = "$server::base_dir/tftp";
  14
  15 sub path {
  16         my $glob = shift;
  17         my $path = (glob("$dir/$glob"))[0];
  18         die "can't find anything for $dir/$glob" unless $path;
  19         warn 'path ', $path if $debug;
  20         $path =~ s{^$dir}{};
  21         return $path;
  22 }
  23
  24 use progress_bar;
  25
  26 sub transfer_status {
  27         my $request = shift;
  28         my $r = $request->{'_REQUEST_'} || die "no _REQUEST_ in ",dump( $request );
  29
  30         if( $r->{'OPCODE'} eq $OPCODES{'RRQ'} ) {
  31                 progress_bar::tick( $r->{FileName}, $r->{BlkSize} * $r->{LASTACK}, $r->{BlkSize} * $r->{LASTBLK} );
  32         } elsif ( $r->{'OPCODE'} eq $OPCODES{'WRQ'} ) {
  33                 die "WRQ disabled";
  34         } else {
  35                 warn "IGNORED: ", dump( $request );
  36         }
  37 }
  38
  39 sub tftp_request {
  40         my $request = shift;
  41
  42         server->refresh;
  43
  44         warn 'request: ', dump( $request ) if $debug;
  45
  46         config::for_ip();
  47
  48         if ( $request->{RootDir} ne $dir ) {
  49                 $request->{RootDir} = $dir;
  50                 warn "new root: $dir";
  51         }
  52
  53         my $file = $request->{'_REQUEST_'}{'FileName'};
  54         # received request
  55         print $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, " $file\n";
  56
  57         progress_bar::start;
  58
  59         # process the request
  60         if( $request->processRQ() ) {
  61                 print "\nOK completed $file ", -s "$dir/$file", "\n";
  62         } else {
  63                 print "ERROR ", Net::TFTPd->error, "\n";
  64                 $request->processRQ();
  65         }
  66
  67 }
  68
  69 use server;
  70
  71 sub start {
  72
  73         warn 'start';
  74
  75         my $listener = Net::TFTPd->new(
  76                 RootDir => $dir,
  77                 Writable => 0,
  78                 Timeout => 3600,
  79                 CallBack => \&transfer_status,
  80 #               LocalAddr => $server::ip,
  81                 LocalAddr => '0.0.0.0',
  82 #               BlkSize => 8192,
  83 #               BlkSize => 512,
  84                 BlkSize => 1456,        # IBM GE seems to be picky
  85                 Debug => 99,
  86         ) || die Net::TFTPd->error;
  87
  88         warn 'listener: ',dump( $listener ) if $debug;
  89
  90         printf "TFTP listen %s:%d timeout: %d dir: $dir\n",
  91                 $listener->{LocalAddr},
  92                 $listener->{LocalPort},
  93                 $listener->{Timeout};
  94
  95         while(1) {
  96
  97                 # wait for any request (RRQ or WRQ)
  98                 if(my $request = $listener->waitRQ()) {
  99                         tftp_request $request;
 100                 } elsif ( my $error = Net::TFTPd->error ) {
 101                         warn $error;
 102                 }
 103
 104         }
 105
 106 }
 107
 108 warn "loaded";
 109
 110 1;