/[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 45 - (hide annotations)
Wed Jul 29 22:04:58 2009 UTC (14 years, 8 months ago) by dpavlin
File size: 1874 byte(s)
dump all other peaces in, first configuration which can again boot
(wrong image, that is :-)

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

  ViewVC Help
Powered by ViewVC 1.1.26