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

Annotation of /lib/PXElator/tftpd.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 59 - (hide annotations)
Thu Jul 30 15:23:16 2009 UTC (11 years, 10 months ago) by dpavlin
File size: 1903 byte(s)
listen to 0.0.0.0

1 dpavlin 45 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 dpavlin 47 use server;
10 dpavlin 45
11 dpavlin 47 our $dir = "$server::base_dir/tftp";
12    
13 dpavlin 45 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 dpavlin 59 LocalAddr => '0.0.0.0',
68 dpavlin 45 # 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