/[pxelator]/bin/tftpd.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /bin/tftpd.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (hide annotations)
Tue Jul 28 10:29:33 2009 UTC (14 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 1908 byte(s)
read data from filesystem files and symlinks in conf/

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 dpavlin 17 sub tftp_dir {
9     my $dir = 'conf/' . readlink('conf/tftp.dir');
10     $dir =~ s{[^/]+/\.\./([^/]+)}{$1};
11     return $dir;
12 dpavlin 1 }
13    
14 dpavlin 17 my $tftp_dir = tftp_dir;
15    
16     die "no $tftp_dir\n" unless -e $tftp_dir;
17    
18 dpavlin 1 # callback sub used to print transfer status
19     sub callback
20     {
21     my $req = shift;
22     if($req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'RRQ'})
23     {
24     # RRQ
25     printf "block: %u\/%u\n", $req->{'_REQUEST_'}{'LASTACK'}, $req->{'_REQUEST_'}{'LASTBLK'};
26     }
27     elsif($req->{'_REQUEST_'}{'OPCODE'} eq $OPCODES{'WRQ'})
28     {
29     # WRQ
30     printf "block: %u\/%u\n", $req->{'_REQUEST_'}{'LASTBLK'}, $req->{'_REQUEST_'}{'LASTACK'};
31 dpavlin 13 } else {
32     warn "IGNORED: ", dump( $req );
33 dpavlin 1 }
34     }
35    
36     # create the listener
37     my $listener = Net::TFTPd->new(
38 dpavlin 17 'RootDir' => $tftp_dir,
39 dpavlin 1 'Writable' => 0,
40     'Timeout' => 3600,
41     'CallBack' => \&callback,
42     # LocalAddr => '10.0.0.100',
43     # BlkSize => 8192,
44     # BlkSize => 512,
45     BlkSize => 1456, # IBM GE seems to be picky
46     Debug => 99,
47     ) or die Net::TFTPd->error;
48 dpavlin 17 printf "TFTP on %s:%d timeout: %d dir: $tftp_dir\n", $listener->{'LocalAddr'} ? $listener->{'LocalAddr'} : "'any address'", $listener->{'LocalPort'}, $listener->{'Timeout'};
49 dpavlin 1
50     while(1) {
51    
52     # wait for any request (RRQ or WRQ)
53     if(my $request = $listener->waitRQ()) {
54 dpavlin 17
55     $tftp_dir = tftp_dir;
56    
57     if ( $request->{RootDir} ne $tftp_dir ) {
58     $request->{RootDir} = $tftp_dir;
59     warn "new root: $tftp_dir\n";
60     }
61    
62 dpavlin 1 # received request
63     printf "Received a %s for file '%s'\n", $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}}, $request->{'_REQUEST_'}{'FileName'};
64    
65     # process the request
66     if($request->processRQ()) {
67     print "OK, transfer completed successfully\n";
68     } else {
69     warn Net::TFTPd->error;
70     $request->processRQ();
71     }
72     } else {
73     # request not received (timed out waiting for request etc.)
74     warn Net::TFTPd->error;
75     }
76    
77     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26