mdap/bin/tftpd.pl

#!/usr/bin/perl
use strict;
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] || '/srv/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,
        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'};

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