diff options
Diffstat (limited to 'contrib/t2hproxy/t2hproxy.pl')
| -rwxr-xr-x | contrib/t2hproxy/t2hproxy.pl | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/contrib/t2hproxy/t2hproxy.pl b/contrib/t2hproxy/t2hproxy.pl new file mode 100755 index 00000000..4fc01781 --- /dev/null +++ b/contrib/t2hproxy/t2hproxy.pl @@ -0,0 +1,174 @@ +#!/usr/bin/perl -w +# +# tftp to http proxy +# Copyright 2003 Ken Yap +# Released under GPL2 +# + +require 5.8.0; # needs constant and the pack Z format behaviour + +use bytes; # to forestall Unicode interpretation of strings +use strict; + +use Getopt::Long; +use Socket; +use Sys::Hostname; +use Sys::Syslog; +use LWP; +use POSIX 'setsid'; + +use constant PROGNAME => 't2hproxy'; +use constant VERSION => '0.1'; + +use constant ETH_DATA_LEN => 1500; +use constant { + TFTP_RRQ => 1, TFTP_WRQ => 2, TFTP_DATA => 3, TFTP_ACK => 4, + TFTP_ERROR => 5, TFTP_OACK => 6 +}; +use constant { + E_UNDEF => 0, E_FNF => 1, E_ACC => 2, E_DISK => 3, E_ILLOP => 4, + E_UTID => 5, E_FEXIST => 6, E_NOUSER => 7 +}; + +use vars qw($prefix $proxy $sockh $timeout %options $tsize $bsize); + +# We can't use die because xinetd will think something's wrong +sub log_and_exit ($) { + syslog('info', $_[0]); + exit; +} + +sub what_source ($) { + my ($port, $saddr) = sockaddr_in($_[0]); + my $host = gethostbyaddr($saddr, AF_INET); + return ($host, $port); +} + +sub send_error ($$$) { + my ($iaddr, $error, $message) = @_; + # error packets don't get acked + send(STDOUT, pack('nna*', TFTP_ERROR, $error, $message), 0, $iaddr); +} + +sub send_ack_retry ($$$$$) { + my ($iaddr, $udptimeout, $maxretries, $blockno, $sendfunc) = @_; +RETRY: + while ($maxretries-- > 0) { + &$sendfunc; + my $rin = ''; + my $rout = ''; + vec($rin, fileno($sockh), 1) = 1; + do { + my ($fds, $timeleft) = select($rout = $rin, undef, undef, $udptimeout); + last if ($fds <= 0); + my $ack; + my $theiripaddr = recv($sockh, $ack, 256, 0); + # check it's for us + if ($theiripaddr eq $iaddr) { + my ($opcode, $ackblock) = unpack('nn', $ack); + return (0) if ($opcode == TFTP_ERROR); + # check that the right block was acked + if ($ackblock == $blockno) { + return (1); + } else { + syslog('info', "Resending block $blockno"); + next RETRY; + } + } + # stray packet for some other server instance + send_error($theiripaddr, E_UTID, 'Wrong TID'); + } while (1); + } + return (0); +} + +sub handle_options ($$) { + my ($iaddr, $operand) = @_; + while ($operand ne '') { + my ($key, $value) = unpack('Z*Z*', $operand); + $options{$key} = $value; + syslog('info', "$key=$value"); + $operand = substr($operand, length($key) + length($value) + 2); + } + my $optstr = ''; + if (exists($options{blksize})) { + $bsize = $options{blksize}; + $bsize = 512 if ($bsize < 512); + $bsize = 1432 if ($bsize > 1432); + $optstr .= pack('Z*Z*', 'blksize', $bsize . ''); + } + # OACK expects an ack for block 0 + log_and_exit('Abort received or retransmit limit reached, exiting') + unless send_ack_retry($iaddr, 2, 5, 0, + sub { send($sockh, pack('na*', TFTP_OACK, $optstr), 0, $iaddr); }); +} + +sub http_get ($) { + my ($url) = @_; + syslog('info', "GET $url"); + my $ua = LWP::UserAgent->new; + $ua->timeout($timeout); + $ua->proxy(['http', 'ftp'], $proxy) if (defined($proxy) and $proxy); + my $req = HTTP::Request->new(GET => $url); + my $res = $ua->request($req); + return ($res->is_success, $res->status_line, $res->content_ref); +} + +sub send_file ($$) { + my ($iaddr, $contentref) = @_; + my $blockno = 1; + my $data; + do { + $blockno &= 0xffff; + $data = substr($$contentref, ($blockno - 1) * $bsize, $bsize); + # syslog('info', "Block $blockno length " . length($data)); + log_and_exit('Abort received or retransmit limit reached, exiting') + unless send_ack_retry($iaddr, 2, 5, $blockno, + sub { send($sockh, pack('nna*', TFTP_DATA, $blockno, $data), 0, $iaddr); }); + $blockno++; + } while (length($data) >= $bsize); +} + +sub do_rrq ($$) { + my ($iaddr, $packetref) = @_; + # fork and handle request in child so that *inetd can continue + # to serve incoming requests + defined(my $pid = fork) or log_and_exit("Can't fork: $!"); + exit if $pid; # parent exits + setsid or log_and_exit("Can't start a new session: $!"); + socket(SOCK, PF_INET, SOCK_DGRAM, getprotobyname('udp')) or log_and_exit('Cannot create UDP socket'); + $sockh = *SOCK{IO}; + my ($opcode, $operand) = unpack('na*', $$packetref); + my ($filename, $mode) = unpack('Z*Z*', $operand); + syslog('info', "RRQ $filename $mode"); + my $length = length($filename) + length($mode) + 2; + $operand = substr($operand, $length); + handle_options($iaddr, $operand) if ($operand ne ''); + my ($success, $status_line, $result) = http_get($prefix . $filename); + syslog('info', $status_line); + if ($success) { + send_file($iaddr, $result); + } else { + send_error($iaddr, E_FNF, $status_line); + } +} + +$prefix = 'http://localhost/'; +$timeout = 60; +GetOptions('prefix=s' => \$prefix, + 'proxy=s' => \$proxy, + 'timeout=i' => \$timeout); +$bsize = 512; +openlog(PROGNAME, 'cons,pid', 'user'); +syslog('info', PROGNAME . ' version ' . VERSION); +my $packet; +my $theiriaddr = recv(STDIN, $packet, ETH_DATA_LEN, 0); +my ($host, $port) = what_source($theiriaddr); +syslog('info', "Connection from $host:$port"); +my $opcode = unpack('n', $packet); +if ($opcode == TFTP_RRQ) { + do_rrq($theiriaddr, \$packet); +} else { # anything else is an error + send_error($theiriaddr, E_ILLOP, 'Illegal operation'); +} +exit 0; |