/[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 482 - (hide annotations)
Sat Jan 23 18:31:14 2010 UTC (14 years, 2 months ago) by dpavlin
File size: 2842 byte(s)
use store::audit proxy all over the place

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 45 sub tftp_request {
44     my $request = shift;
45    
46 dpavlin 93 warn 'request: ', dump( $request ) if $debug;
47    
48 dpavlin 207 my $ip = $request->{_REQUEST_}->{PeerAddr};
49     config::for_ip( $ip );
50 dpavlin 110
51 dpavlin 45 if ( $request->{RootDir} ne $dir ) {
52     $request->{RootDir} = $dir;
53     warn "new root: $dir";
54     }
55    
56 dpavlin 93 my $file = $request->{'_REQUEST_'}{'FileName'};
57 dpavlin 207 my $opcode = $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}};
58 dpavlin 45
59 dpavlin 208 my $audit = {
60 dpavlin 207 ip => $ip,
61     opcode => $opcode,
62 dpavlin 357 path => $file,
63 dpavlin 208 state => 'start',
64     };
65 dpavlin 482 store::audit( $opcode, $audit );
66 dpavlin 207
67 dpavlin 115 progress_bar::start;
68    
69 dpavlin 45 # process the request
70     if( $request->processRQ() ) {
71 dpavlin 207 my $size = -s "$dir/$file";
72 dpavlin 208 $audit->{state} = 'finish';
73     $audit->{size} = $size;
74 dpavlin 482 store::audit( $opcode, $audit );
75 dpavlin 45 } else {
76 dpavlin 208 $audit->{state} = 'error';
77     $audit->{error} = Net::TFTPd->error;
78 dpavlin 482 store::audit( $opcode, $audit );
79 dpavlin 45 }
80    
81     }
82    
83     use server;
84    
85     sub start {
86    
87     warn 'start';
88    
89 dpavlin 141 # XXX we need to setup listener ourselfs because we need Reuse
90     my %params = (
91     Proto => 'udp',
92     # LocalAddr => $server::ip,
93     # LocalAddr => '0.0.0.0',
94     LocalPort => 69,
95     Reuse => 1,
96     );
97    
98     my $udpserver = IO::Socket::INET->new(%params);
99     die "can't start server ",dump( \%params ), " $!" unless $udpserver;
100    
101     my $listener = bless {
102 dpavlin 45 RootDir => $dir,
103 dpavlin 141
104     ACKtimeout => 4,
105     ACKretries => 4,
106     Readable => 1,
107     Writable => 0,
108     Timeout => 3600,
109    
110 dpavlin 45 CallBack => \&transfer_status,
111     # BlkSize => 8192,
112 dpavlin 462 BlkSize => 512, # Dell's RAC doesn't like bigger packets
113     # BlkSize => 1456, # IBM GE seems to be picky
114 dpavlin 45 Debug => 99,
115 dpavlin 141 %params, # merge user parameters
116     _UDPSERVER_ => $udpserver,
117     }, 'Net::TFTPd';
118 dpavlin 45
119 dpavlin 67 warn 'listener: ',dump( $listener ) if $debug;
120 dpavlin 45
121 dpavlin 482 store::audit( 'start', {
122 dpavlin 207 addr => $listener->{LocalAddr},
123     port => $listener->{LocalPort},
124     timeout => $listener->{Timeout},
125     params => { %params },
126     });
127 dpavlin 93
128 dpavlin 45 while(1) {
129    
130     # wait for any request (RRQ or WRQ)
131     if(my $request = $listener->waitRQ()) {
132 dpavlin 261 server->refresh;
133 dpavlin 45 tftp_request $request;
134 dpavlin 118 } elsif ( my $error = Net::TFTPd->error ) {
135     warn $error;
136 dpavlin 45 }
137    
138     }
139    
140     }
141    
142     warn "loaded";
143    
144     1;

  ViewVC Help
Powered by ViewVC 1.1.26