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