/[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 548 - (hide annotations)
Sat Oct 9 20:06:44 2010 UTC (10 years, 4 months ago) by dpavlin
File size: 2958 byte(s)
ignore SIGCHLD
1 dpavlin 45 package tftpd;
2    
3     use warnings;
4     use strict;
5    
6     use Net::TFTPd 0.03 qw(%OPCODES);
7 dpavlin 141 use IO::Socket::INET;
8 dpavlin 45 use Data::Dump qw/dump/;
9 dpavlin 482 use store;
10 dpavlin 45
11 dpavlin 47 use server;
12 dpavlin 45
13 dpavlin 67 our $debug = server::debug;
14    
15 dpavlin 47 our $dir = "$server::base_dir/tftp";
16    
17 dpavlin 45 sub path {
18     my $glob = shift;
19 dpavlin 68 my $path = (glob("$dir/$glob"))[0];
20 dpavlin 45 die "can't find anything for $dir/$glob" unless $path;
21 dpavlin 93 warn 'path ', $path if $debug;
22 dpavlin 45 $path =~ s{^$dir}{};
23     return $path;
24     }
25    
26 dpavlin 115 use progress_bar;
27 dpavlin 93
28 dpavlin 45 sub transfer_status {
29 dpavlin 115 my $request = shift;
30     my $r = $request->{'_REQUEST_'} || die "no _REQUEST_ in ",dump( $request );
31    
32     if( $r->{'OPCODE'} eq $OPCODES{'RRQ'} ) {
33     progress_bar::tick( $r->{FileName}, $r->{BlkSize} * $r->{LASTACK}, $r->{BlkSize} * $r->{LASTBLK} );
34     } elsif ( $r->{'OPCODE'} eq $OPCODES{'WRQ'} ) {
35 dpavlin 45 die "WRQ disabled";
36     } else {
37 dpavlin 115 warn "IGNORED: ", dump( $request );
38 dpavlin 45 }
39     }
40    
41 dpavlin 138 use config;
42    
43 dpavlin 548 $SIG{CHLD}='IGNORE';
44    
45 dpavlin 45 sub tftp_request {
46     my $request = shift;
47    
48 dpavlin 93 warn 'request: ', dump( $request ) if $debug;
49    
50 dpavlin 545 if ( my $pid = fork ) {
51     # parent
52     warn "# forked $pid\n";
53     return;
54     }
55    
56    
57 dpavlin 207 my $ip = $request->{_REQUEST_}->{PeerAddr};
58     config::for_ip( $ip );
59 dpavlin 110
60 dpavlin 45 if ( $request->{RootDir} ne $dir ) {
61     $request->{RootDir} = $dir;
62     warn "new root: $dir";
63     }
64    
65 dpavlin 93 my $file = $request->{'_REQUEST_'}{'FileName'};
66 dpavlin 207 my $opcode = $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}};
67 dpavlin 45
68 dpavlin 208 my $audit = {
69 dpavlin 207 ip => $ip,
70     opcode => $opcode,
71 dpavlin 357 path => $file,
72 dpavlin 208 state => 'start',
73     };
74 dpavlin 482 store::audit( $opcode, $audit );
75 dpavlin 207
76 dpavlin 115 progress_bar::start;
77    
78 dpavlin 45 # process the request
79     if( $request->processRQ() ) {
80 dpavlin 207 my $size = -s "$dir/$file";
81 dpavlin 208 $audit->{state} = 'finish';
82     $audit->{size} = $size;
83 dpavlin 482 store::audit( $opcode, $audit );
84 dpavlin 45 } else {
85 dpavlin 208 $audit->{state} = 'error';
86     $audit->{error} = Net::TFTPd->error;
87 dpavlin 482 store::audit( $opcode, $audit );
88 dpavlin 45 }
89    
90 dpavlin 548 exit 0;
91 dpavlin 45 }
92    
93     use server;
94    
95     sub start {
96    
97     warn 'start';
98    
99 dpavlin 141 # XXX we need to setup listener ourselfs because we need Reuse
100     my %params = (
101     Proto => 'udp',
102     # LocalAddr => $server::ip,
103     # LocalAddr => '0.0.0.0',
104     LocalPort => 69,
105     Reuse => 1,
106     );
107    
108     my $udpserver = IO::Socket::INET->new(%params);
109     die "can't start server ",dump( \%params ), " $!" unless $udpserver;
110    
111     my $listener = bless {
112 dpavlin 45 RootDir => $dir,
113 dpavlin 141
114 dpavlin 544 ACKtimeout => 1, # 4
115     ACKretries => 2, # 4
116 dpavlin 141 Readable => 1,
117     Writable => 0,
118     Timeout => 3600,
119    
120 dpavlin 45 CallBack => \&transfer_status,
121     # BlkSize => 8192,
122 dpavlin 462 BlkSize => 512, # Dell's RAC doesn't like bigger packets
123     # BlkSize => 1456, # IBM GE seems to be picky
124 dpavlin 45 Debug => 99,
125 dpavlin 141 %params, # merge user parameters
126     _UDPSERVER_ => $udpserver,
127     }, 'Net::TFTPd';
128 dpavlin 45
129 dpavlin 67 warn 'listener: ',dump( $listener ) if $debug;
130 dpavlin 45
131 dpavlin 482 store::audit( 'start', {
132 dpavlin 207 addr => $listener->{LocalAddr},
133     port => $listener->{LocalPort},
134     timeout => $listener->{Timeout},
135     params => { %params },
136     });
137 dpavlin 93
138 dpavlin 45 while(1) {
139    
140     # wait for any request (RRQ or WRQ)
141     if(my $request = $listener->waitRQ()) {
142 dpavlin 261 server->refresh;
143 dpavlin 45 tftp_request $request;
144 dpavlin 118 } elsif ( my $error = Net::TFTPd->error ) {
145     warn $error;
146 dpavlin 45 }
147    
148     }
149    
150     }
151    
152     warn "loaded";
153    
154     1;

  ViewVC Help
Powered by ViewVC 1.1.26