#!/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 = 'conf/' . readlink('conf/tftp.dir');
$rootdir =~ s{[^/]+/\.\./([^/]+)}{$1};

unless(-d $rootdir)
{
	print "$rootdir isn't directory!\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'};
	} else {
		warn "IGNORED: ", dump( $req );
	}
}

# 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 %s:%d [timeout %d s] $rootdir\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;
	}

}
