/[pxelator]/lib/PXElator/tftpd.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/PXElator/tftpd.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 67 by dpavlin, Thu Jul 30 21:31:30 2009 UTC revision 141 by dpavlin, Tue Aug 4 17:29:59 2009 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use Net::TFTPd 0.03 qw(%OPCODES);  use Net::TFTPd 0.03 qw(%OPCODES);
7    use IO::Socket::INET;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9    
10  use server;  use server;
# Line 14  our $dir  = "$server::base_dir/tftp"; Line 15  our $dir  = "$server::base_dir/tftp";
15    
16  sub path {  sub path {
17          my $glob = shift;          my $glob = shift;
18          my $path = glob("$dir/$glob");          my $path = (glob("$dir/$glob"))[0];
19          die "can't find anything for $dir/$glob" unless $path;          die "can't find anything for $dir/$glob" unless $path;
20  warn $path;          warn 'path ', $path if $debug;
21          $path =~ s{^$dir}{};          $path =~ s{^$dir}{};
22          return $path;          return $path;
23  }  }
24    
25    use progress_bar;
26    
27  sub transfer_status {  sub transfer_status {
28          my $req = shift;          my $request = shift;
29          if( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'} ) {          my $r = $request->{'_REQUEST_'} || die "no _REQUEST_ in ",dump( $request );
30                  printf "RRQ %u\/%u\r", $req->{'_REQUEST_'}{'LASTACK'}, $req->{'_REQUEST_'}{'LASTBLK'};  
31          } elsif ( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'WRQ'} ) {          if( $r->{'OPCODE'} eq $OPCODES{'RRQ'} ) {
32                    progress_bar::tick( $r->{FileName}, $r->{BlkSize} * $r->{LASTACK}, $r->{BlkSize} * $r->{LASTBLK} );
33            } elsif ( $r->{'OPCODE'} eq $OPCODES{'WRQ'} ) {
34                  die "WRQ disabled";                  die "WRQ disabled";
                 printf "WRQ: %u\/%u\n", $req->{'_REQUEST_'}{'LASTBLK'}, $req->{'_REQUEST_'}{'LASTACK'};  
35          } else {          } else {
36                  warn "IGNORED: ", dump( $req );                  warn "IGNORED: ", dump( $request );
37          }          }
38  }  }
39    
40    use config;
41    
42  sub tftp_request {  sub tftp_request {
43          my $request = shift;          my $request = shift;
44    
45            server->refresh;
46    
47            warn 'request: ', dump( $request ) if $debug;
48    
49            config::for_ip( $request->{_REQUEST_}->{PeerAddr} );
50    
51          if ( $request->{RootDir} ne $dir ) {          if ( $request->{RootDir} ne $dir ) {
52                  $request->{RootDir} = $dir;                  $request->{RootDir} = $dir;
53                  warn "new root: $dir";                  warn "new root: $dir";
54          }          }
55    
56            my $file = $request->{'_REQUEST_'}{'FileName'};
57          # received request          # received request
58          printf "Received a %s for file '%s'\n", $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, $request->{'_REQUEST_'}{'FileName'};          print $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, " $file\n";
59    
60            progress_bar::start;
61    
62          # process the request          # process the request
63          if( $request->processRQ() ) {          if( $request->processRQ() ) {
64                  print "OK, transfer completed successfully\n";                  print "\nOK completed $file ", -s "$dir/$file", "\n";
65          } else {          } else {
66                  warn Net::TFTPd->error;                  print "ERROR ", Net::TFTPd->error, "\n";
67                  $request->processRQ();                  $request->processRQ();
68          }          }
69    
# Line 60  sub start { Line 75  sub start {
75    
76          warn 'start';          warn 'start';
77    
78          my $listener = Net::TFTPd->new(          # XXX we need to setup listener ourselfs because we need Reuse
79            my %params = (
80                    Proto => 'udp',
81    #               LocalAddr => $server::ip,
82    #               LocalAddr => '0.0.0.0',
83                    LocalPort => 69,
84                    Reuse => 1,
85            );
86    
87            my $udpserver = IO::Socket::INET->new(%params);
88            die "can't start server ",dump( \%params ), " $!" unless $udpserver;
89    
90            my $listener = bless {
91                  RootDir => $dir,                  RootDir => $dir,
92                  Writable => 0,  
93                  Timeout => 3600,                  ACKtimeout  => 4,
94                    ACKretries  => 4,
95                    Readable    => 1,
96                    Writable    => 0,
97                    Timeout => 3600,
98    
99                  CallBack => \&transfer_status,                  CallBack => \&transfer_status,
 #               LocalAddr => $server::ip,  
                 LocalAddr => '0.0.0.0',  
100  #               BlkSize => 8192,  #               BlkSize => 8192,
101  #               BlkSize => 512,  #               BlkSize => 512,
102                  BlkSize => 1456,        # IBM GE seems to be picky                  BlkSize => 1456,        # IBM GE seems to be picky
103                  Debug => 99,                  Debug => 99,
104          ) || die Net::TFTPd->error;                  %params, # merge user parameters
105                    _UDPSERVER_ => $udpserver,
106            }, 'Net::TFTPd';
107    
108          warn 'listener: ',dump( $listener ) if $debug;          warn 'listener: ',dump( $listener ) if $debug;
109    
110            printf "TFTP listen %s:%d timeout: %d dir: $dir\n",
111                    $listener->{LocalAddr},
112                    $listener->{LocalPort},
113                    $listener->{Timeout};
114    
115          while(1) {          while(1) {
           
                 printf "TFTP listen %s:%d timeout: %d dir: $dir\n",  
                         $listener->{LocalAddr},  
                         $listener->{LocalPort},  
                         $listener->{Timeout};  
116    
117                  # wait for any request (RRQ or WRQ)                  # wait for any request (RRQ or WRQ)
118                  if(my $request = $listener->waitRQ()) {                  if(my $request = $listener->waitRQ()) {
119                          tftp_request $request;                          tftp_request $request;
120                  } else {                  } elsif ( my $error = Net::TFTPd->error ) {
121                          warn Net::TFTPd->error;                          warn $error;
122                  }                  }
123    
124          }          }
Legend:
Removed from v.67  
changed lines
  Added in v.141
  ViewVC Help
Powered by ViewVC 1.1.26