/[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 59 - (show annotations)
Thu Jul 30 15:23:16 2009 UTC (10 years, 11 months ago) by dpavlin
File size: 1903 byte(s)
listen to 0.0.0.0

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

  ViewVC Help
Powered by ViewVC 1.1.26