123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174 |
- #!/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;
|