diff options
Diffstat (limited to 'contrib/t2hproxy/t2hproxy.pl')
| -rwxr-xr-x | contrib/t2hproxy/t2hproxy.pl | 174 |
1 files changed, 0 insertions, 174 deletions
diff --git a/contrib/t2hproxy/t2hproxy.pl b/contrib/t2hproxy/t2hproxy.pl deleted file mode 100755 index 4fc01781..00000000 --- a/contrib/t2hproxy/t2hproxy.pl +++ /dev/null @@ -1,174 +0,0 @@ -#!/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; |