/[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 68 - (show annotations)
Thu Jul 30 22:43:48 2009 UTC (14 years, 8 months ago) by dpavlin
File size: 1947 byte(s)
fix glob

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

  ViewVC Help
Powered by ViewVC 1.1.26