pxelator/bin/tftpd.pl

#!/usr/bin/perl
use strict;
use lib 'lib';
use Net::TFTPd 0.03 qw(%OPCODES);

die "need to run $0 as root like this\nsudo $0\n" unless $< == 0;

# change ROOTDIR to your TFTP root directory
my $rootdir = $ARGV[0] || 'tftp';

unless(-d $rootdir)
{
        print "\nUsage: $0 path/to/rootdir\n\n";
        exit 1;
}

# callback sub used to print transfer status
sub callback
{
        my $req = shift;
        if($req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'})
        {
                # RRQ
                printf "block: %u\/%u\n", $req->{'_REQUEST_'}{'LASTACK'}, $req->{'_REQUEST_'}{'LASTBLK'};
        }
        elsif($req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'WRQ'})
        {
                # WRQ
                printf "block: %u\/%u\n", $req->{'_REQUEST_'}{'LASTBLK'}, $req->{'_REQUEST_'}{'LASTACK'};
        }
}

# create the listener
my $listener = Net::TFTPd->new(
        'RootDir' => $rootdir,
        'Writable' => 0,
        'Timeout' => 3600, 
        'CallBack' => \&callback,
#       LocalAddr => '10.0.0.100',
#       BlkSize => 8192,
#       BlkSize => 512,
        BlkSize => 1456,        # IBM GE seems to be picky
        Debug => 99,
) or die Net::TFTPd->error;
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'};

while(1) {

        # wait for any request (RRQ or WRQ)
        if(my $request = $listener->waitRQ()) {
                # received request
                printf "Received a %s for file '%s'\n", $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, $request->{'_REQUEST_'}{'FileName'};

                # process the request
                if($request->processRQ()) {
                        print "OK, transfer completed successfully\n";
                } else {
                        warn Net::TFTPd->error;
                        $request->processRQ();
                }
        } else {
                # request not received (timed out waiting for request etc.)
                warn Net::TFTPd->error;
        }

}
1	dpavlin	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			}