gpxe/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;