/[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 45 - (show annotations)
Wed Jul 29 22:04:58 2009 UTC (11 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 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