/[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

Contents of /lib/PXElator/tftpd.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 93 - (show annotations)
Fri Jul 31 19:59:28 2009 UTC (11 years, 5 months ago) by dpavlin
File size: 2120 byte(s)
much better output

1 package tftpd;
2
3 use warnings;
4 use strict;
5
6 use Net::TFTPd 0.03 qw(%OPCODES);
7 use Data::Dump qw/dump/;
8 use Module::Refresh;
9
10 use server;
11
12 our $debug = server::debug;
13
14 our $dir = "$server::base_dir/tftp";
15
16 sub path {
17 my $glob = shift;
18 my $path = (glob("$dir/$glob"))[0];
19 die "can't find anything for $dir/$glob" unless $path;
20 warn 'path ', $path if $debug;
21 $path =~ s{^$dir}{};
22 return $path;
23 }
24
25 STDERR->autoflush(1);
26
27 sub transfer_status {
28 my $req = shift;
29 if( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'} ) {
30 printf STDERR "RRQ %s %u\/%u\r", map { $req->{_REQUEST_}->{$_} } ( 'FileName', 'LASTACK', 'LASTBLK' );
31 } elsif ( $req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'WRQ'} ) {
32 die "WRQ disabled";
33 printf STDERR "WRQ: %u\/%u\n", $req->{'_REQUEST_'}{'LASTBLK'}, $req->{'_REQUEST_'}{'LASTACK'};
34 } else {
35 warn "IGNORED: ", dump( $req );
36 }
37 }
38
39 sub tftp_request {
40 my $request = shift;
41
42 warn 'request: ', dump( $request ) if $debug;
43
44 if ( $request->{RootDir} ne $dir ) {
45 $request->{RootDir} = $dir;
46 warn "new root: $dir";
47 }
48
49 my $file = $request->{'_REQUEST_'}{'FileName'};
50 # received request
51 print $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, " $file\n";
52
53 # process the request
54 if( $request->processRQ() ) {
55 print "\nOK completed $file ", -s "$dir/$file", "\n";
56 } else {
57 print "ERROR ", Net::TFTPd->error, "\n";
58 $request->processRQ();
59 }
60
61 }
62
63 use server;
64
65 sub start {
66
67 warn 'start';
68
69 my $listener = Net::TFTPd->new(
70 RootDir => $dir,
71 Writable => 0,
72 Timeout => 3600,
73 CallBack => \&transfer_status,
74 # LocalAddr => $server::ip,
75 LocalAddr => '0.0.0.0',
76 # BlkSize => 8192,
77 # BlkSize => 512,
78 BlkSize => 1456, # IBM GE seems to be picky
79 Debug => 99,
80 ) || die Net::TFTPd->error;
81
82 warn 'listener: ',dump( $listener ) if $debug;
83
84 printf "TFTP listen %s:%d timeout: %d dir: $dir\n",
85 $listener->{LocalAddr},
86 $listener->{LocalPort},
87 $listener->{Timeout};
88
89 while(1) {
90
91 Module::Refresh->refresh;
92
93 # wait for any request (RRQ or WRQ)
94 if(my $request = $listener->waitRQ()) {
95 tftp_request $request;
96 } else {
97 warn Net::TFTPd->error;
98 }
99
100 }
101
102 }
103
104 warn "loaded";
105
106 1;

  ViewVC Help
Powered by ViewVC 1.1.26