Initial revision
[people/dverkamp/gpxe.git] / contrib / t2hproxy / t2hproxy.pl
1 #!/usr/bin/perl -w
2 #
3 # tftp to http proxy
4 # Copyright 2003 Ken Yap
5 # Released under GPL2
6 #
7
8 require 5.8.0;          # needs constant and the pack Z format behaviour
9
10 use bytes;              # to forestall Unicode interpretation of strings
11 use strict;
12
13 use Getopt::Long;
14 use Socket;
15 use Sys::Hostname;
16 use Sys::Syslog;
17 use LWP;
18 use POSIX 'setsid';
19
20 use constant PROGNAME => 't2hproxy';
21 use constant VERSION => '0.1';
22
23 use constant ETH_DATA_LEN => 1500;
24 use constant {
25         TFTP_RRQ => 1, TFTP_WRQ => 2, TFTP_DATA => 3, TFTP_ACK => 4,
26         TFTP_ERROR => 5, TFTP_OACK => 6
27 };
28 use constant {
29         E_UNDEF => 0, E_FNF => 1, E_ACC => 2, E_DISK => 3, E_ILLOP => 4,
30         E_UTID => 5, E_FEXIST => 6, E_NOUSER => 7
31 };
32
33 use vars qw($prefix $proxy $sockh $timeout %options $tsize $bsize);
34
35 # We can't use die because xinetd will think something's wrong
36 sub log_and_exit ($) {
37         syslog('info', $_[0]);
38         exit;
39 }
40
41 sub what_source ($) {
42         my ($port, $saddr) = sockaddr_in($_[0]);
43         my $host = gethostbyaddr($saddr, AF_INET);
44         return ($host, $port);
45 }
46
47 sub send_error ($$$) {
48         my ($iaddr, $error, $message) = @_;
49         # error packets don't get acked
50         send(STDOUT, pack('nna*', TFTP_ERROR, $error, $message), 0, $iaddr);
51 }
52
53 sub send_ack_retry ($$$$$) {
54         my ($iaddr, $udptimeout, $maxretries, $blockno, $sendfunc) = @_;
55 RETRY:
56         while ($maxretries-- > 0) {
57                 &$sendfunc;
58                 my $rin = '';
59                 my $rout = '';
60                 vec($rin, fileno($sockh), 1) = 1;
61                 do {
62                         my ($fds, $timeleft) = select($rout = $rin, undef, undef, $udptimeout);
63                         last if ($fds <= 0);
64                         my $ack;
65                         my $theiripaddr = recv($sockh, $ack, 256, 0);
66                         # check it's for us
67                         if ($theiripaddr eq $iaddr) {
68                                 my ($opcode, $ackblock) = unpack('nn', $ack);
69                                 return (0) if ($opcode == TFTP_ERROR);
70                                 # check that the right block was acked
71                                 if ($ackblock == $blockno) {
72                                         return (1);
73                                 } else {
74                                         syslog('info', "Resending block $blockno");
75                                         next RETRY;
76                                 }
77                         }
78                         # stray packet for some other server instance
79                         send_error($theiripaddr, E_UTID, 'Wrong TID');
80                 } while (1);
81         }
82         return (0);
83 }
84
85 sub handle_options ($$) {
86         my ($iaddr, $operand) = @_;
87         while ($operand ne '') {
88                 my ($key, $value) = unpack('Z*Z*', $operand);
89                 $options{$key} = $value;
90                 syslog('info', "$key=$value");
91                 $operand = substr($operand, length($key) + length($value) + 2);
92         }
93         my $optstr = '';
94         if (exists($options{blksize})) {
95                 $bsize = $options{blksize};
96                 $bsize = 512 if ($bsize < 512);
97                 $bsize = 1432 if ($bsize > 1432);
98                 $optstr .= pack('Z*Z*', 'blksize', $bsize . '');
99         }
100         # OACK expects an ack for block 0
101         log_and_exit('Abort received or retransmit limit reached, exiting')
102                 unless send_ack_retry($iaddr, 2, 5, 0,
103                 sub { send($sockh, pack('na*', TFTP_OACK, $optstr), 0, $iaddr); });
104 }
105
106 sub http_get ($) {
107         my ($url) = @_;
108         syslog('info', "GET $url");
109         my $ua = LWP::UserAgent->new;
110         $ua->timeout($timeout);
111         $ua->proxy(['http', 'ftp'], $proxy) if (defined($proxy) and $proxy);
112         my $req = HTTP::Request->new(GET => $url);
113         my $res = $ua->request($req);
114         return ($res->is_success, $res->status_line, $res->content_ref);
115 }
116
117 sub send_file ($$) {
118         my ($iaddr, $contentref) = @_;
119         my $blockno = 1;
120         my $data;
121         do {
122                 $blockno &= 0xffff;
123                 $data = substr($$contentref, ($blockno - 1) * $bsize, $bsize);
124                 # syslog('info', "Block $blockno length " . length($data));
125                 log_and_exit('Abort received or retransmit limit reached, exiting')
126                         unless send_ack_retry($iaddr, 2, 5, $blockno,
127                         sub { send($sockh, pack('nna*', TFTP_DATA, $blockno, $data), 0, $iaddr); });
128                 $blockno++;
129         } while (length($data) >= $bsize);
130 }
131
132 sub do_rrq ($$) {
133         my ($iaddr, $packetref) = @_;
134         # fork and handle request in child so that *inetd can continue
135         # to serve incoming requests
136         defined(my $pid = fork) or log_and_exit("Can't fork: $!");
137         exit if $pid;           # parent exits
138         setsid or log_and_exit("Can't start a new session: $!");
139         socket(SOCK, PF_INET, SOCK_DGRAM, getprotobyname('udp')) or log_and_exit('Cannot create UDP socket');
140         $sockh = *SOCK{IO};
141         my ($opcode, $operand) = unpack('na*', $$packetref);
142         my ($filename, $mode) = unpack('Z*Z*', $operand);
143         syslog('info', "RRQ $filename $mode");
144         my $length = length($filename) + length($mode) + 2;
145         $operand = substr($operand, $length);
146         handle_options($iaddr, $operand) if ($operand ne '');
147         my ($success, $status_line, $result) = http_get($prefix . $filename);
148         syslog('info', $status_line);
149         if ($success) {
150                 send_file($iaddr, $result);
151         } else {
152                 send_error($iaddr, E_FNF, $status_line);
153         }
154 }
155
156 $prefix = 'http://localhost/';
157 $timeout = 60;
158 GetOptions('prefix=s' => \$prefix,
159         'proxy=s' => \$proxy,
160         'timeout=i' => \$timeout);
161 $bsize = 512;
162 openlog(PROGNAME, 'cons,pid', 'user');
163 syslog('info', PROGNAME . ' version ' . VERSION);
164 my $packet;
165 my $theiriaddr = recv(STDIN, $packet, ETH_DATA_LEN, 0);
166 my ($host, $port) = what_source($theiriaddr);
167 syslog('info', "Connection from $host:$port");
168 my $opcode = unpack('n', $packet);
169 if ($opcode == TFTP_RRQ) {
170         do_rrq($theiriaddr, \$packet);
171 } else {        # anything else is an error
172         send_error($theiriaddr, E_ILLOP, 'Illegal operation');
173 }
174 exit 0;