git.rot13.org Git - pxelator/blob - bin/tftpd.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use lib 'lib';
   4 use Net::TFTPd 0.03 qw(%OPCODES);
   5
   6 die "need to run $0 as root like this\nsudo $0\n" unless $< == 0;
   7
   8 # change ROOTDIR to your TFTP root directory
   9 my $rootdir = $ARGV[0] || 'tftp';
  10
  11 unless(-d $rootdir)
  12 {
  13         print "\nUsage: $0 path/to/rootdir\n\n";
  14         exit 1;
  15 }
  16
  17 # callback sub used to print transfer status
  18 sub callback
  19 {
  20         my $req = shift;
  21         if($req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'})
  22         {
  23                 # RRQ
  24                 printf "block: %u\/%u\n", $req->{'_REQUEST_'}{'LASTACK'}, $req->{'_REQUEST_'}{'LASTBLK'};
  25         }
  26         elsif($req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'WRQ'})
  27         {
  28                 # WRQ
  29                 printf "block: %u\/%u\n", $req->{'_REQUEST_'}{'LASTBLK'}, $req->{'_REQUEST_'}{'LASTACK'};
  30         }
  31 }
  32
  33 # create the listener
  34 my $listener = Net::TFTPd->new(
  35         'RootDir' => $rootdir,
  36         'Writable' => 0,
  37         'Timeout' => 3600,
  38         'CallBack' => \&callback,
  39 #       LocalAddr => '10.0.0.100',
  40 #       BlkSize => 8192,
  41 #       BlkSize => 512,
  42         BlkSize => 1456,        # IBM GE seems to be picky
  43         Debug => 99,
  44 ) or die Net::TFTPd->error;
  45 printf "TFTP listener is bound to %s:%d\nTFTP listener is waiting %d seconds for a request\n", $listener->{'LocalAddr'} ? $listener->{'LocalAddr'} : "'any address'",  $listener->{'LocalPort'}, $listener->{'Timeout'};
  46
  47 while(1) {
  48
  49         # wait for any request (RRQ or WRQ)
  50         if(my $request = $listener->waitRQ()) {
  51                 # received request
  52                 printf "Received a %s for file '%s'\n", $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, $request->{'_REQUEST_'}{'FileName'};
  53
  54                 # process the request
  55                 if($request->processRQ()) {
  56                         print "OK, transfer completed successfully\n";
  57                 } else {
  58                         warn Net::TFTPd->error;
  59                         $request->processRQ();
  60                 }
  61         } else {
  62                 # request not received (timed out waiting for request etc.)
  63                 warn Net::TFTPd->error;
  64         }
  65
  66 }