#!/bin/sh -- # A comment mentioning perl, to prevent perl from looping. Indented to work with bash.
eval 'exec perl -S $0 ${1+"$@"}'
if 0;
#========================== Server Portion =========================
chop($program = `basename $0`); # this program's name.
$Local = '';
&initialize_variables(); # initialize some global information.
$Usage = &usage_statement();
while (@ARGV) { # loop over command line args.
$_ = shift @ARGV;
CASE: {
/^-p$|^-port$/ && ($Port = shift, last CASE);
/^-r$/ && ($Remote_Machine_Name = shift, last CASE);
/^-s$|^-service$/ && ($Service = shift, last CASE);
/^-sysv$/ && ($IS_SYSV = shift, last CASE);
/^-limit$/ && ($Limit = shift, last CASE);
/^-local$/ && ($Local = shift, last CASE);
/^-bytes$/ && ($Bytes = shift, last CASE);
/^-binary$/ && ($Bytes = $Bytes_Default, last CASE);
/^-proxy$/ && ($Proxy = 1, last CASE);
/^-c$|^-connect_only$/ && ($Connect_Only = 1, last CASE);
/^-firewall$/ && ($Firewall = 1, last CASE);
/^-firewall_cmd$/ && ($Firewall = 1, $Firewall_Command = shift, last CASE);
/^-fw_perl$/ && ($Firewall_Perl = shift, last CASE);
/^-pre_cmd$/ && ($Pre_Cmd = shift, last CASE);
/^-ksockets$|^-k$/ && ((&spit_ksockets), exit 0, last CASE);
/^-d$/ && ($Debug = 1, last CASE);
/^-q$/ && ($Quiet = 1, last CASE);
/^-l$/ && ($Log_File = shift, last CASE);
/^-h.*/ && ( (&help), exit 0, last CASE);
/^--$/ && (last LOOP); # -- means end of switches
/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
if ( /^-(..+)$/ ) { # split bundled switches:
local($y, $x) = ($1, '');
foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
last CASE;
}
/^-./ && ((print "$Usage\n$_ is not an option, Bye!\n"), exit 1, last CASE);
}
}
$Firewall_Command =~ s/%Firewall_Perl/$Firewall_Perl/g;
&Use_Ksockets();
# Start appending to log file.
&open_log_file();
# Make unbuffered filehandles
select(LOG); $| = 1; select(STDOUT);
select(STDOUT); $| = 1; select(STDOUT);
if ( $Connect_Only ) {
# if we are to just make a connection e.g. we are the firewall command
&connect_remote_to_stdio();
exit 0;
}
# Set up the domains we limit access to (if any).
@Access_Array = &domain_limits($Limit);
$Server = &Server($Port); # get the Ksockets server socket.
&die($Server) if &SocketError($Server);
&Log("\n$A_Line\n");
if ( $Proxy ) {
$Service = '-1'; # proxying service port and remote host
# determined on the fly.
} else {
&initialize_remote_host();
}
$SIG{'INT'} = 'do_shutdown'; # used for quitting. Doesn't work.
sub do_shutdown {
# shutdown($Server, 2) if $Server;
# close($Server) if $Server;
exit 0;
}
local($Connection);
local($Address, $date);
# Loop "forever" listening for connections.
for($Connection = 1; ; $Connection++) {
&Log(">> Listening for connection ${Connection} on port $Port ...\n");
$Address = ''; $C_port = ''; $Client = '';
($Client, $Address, $C_port) = &AcceptConnection($Server);
chop( $date = `date`);
local($con) = $Connection;
if($Address eq '' || &SocketError($Client)) {
&Log("$con: Accept failed for connection $con at $date.\n");
&Log("$con: Error msg: $Client\n");
&Log("$con: Skipping connection and sleeping a bit.\n");
sleep (1);
next;
}
local($access_ok) = &check_access(*Access_Array, $Address);
if ($access_ok) {
&Log("$con: $Address Passes test: $access_ok\n");
} else {
print $Client "$Denied\n";
close($Client);
&Log("$con: Date: $date, $Denied: $Address\n");
sleep(1);
next;
}
&Log("$con: Got connection on $date, forking off child...\n");
if (!fork) { # Fork off child for connection
unless (fork) { # Double fork to avoid zombies...
# setpgrp(0, $$); # Insulate ourselves from server
# # signals, etc.
setpgrp(0, 0); # POSIX...
close($Server);
&Log("$con: fork ok\n"); # we are child's child
&Log("$con: connected to: $Address on port $C_port\n");
$Global_Connection = $Connection;
# goto client portion
if ( $Proxy ) {
&proxy_connect($Client);
} else {
local($ok_to_connect);
$ok_to_connect = 1;
if ( $Pre_Cmd ne '' ) {
local($cmd) = $Pre_Cmd;
$cmd =~ s/%ADDR/$Address/g;
$cmd =~ s/%CPORT/$C_port/g;
$cmd =~ s/%SPORT/$Port/g;
&Log("$con: Pre_Cmd: $Pre_Cmd ->\n");
&Log("$con: Pre_Cmd: $cmd\n");
local($output);
$output = `$cmd`;
$ok_to_connect = 0 unless $? == 0;
&Log("$con: Pre_Cmd: ok: $ok_to_connect, output: $output\n");
}
if ( $ok_to_connect ) {
&tcp_connect($Client, $Remote_Machine, $Service);
}
}
close($Client);
exit 0;
}
exit 0; # this exit happens quickly...
}
wait; # ...so the 1st child is harvested quickly.
# The server no longer needs filehandle to connection
close($Client);
# on to the next connection ...
}
exit 0;
sub help {
if ( $ENV{'PAGER'} ne '' && open(PAGER, "|$ENV{'PAGER'}") ) {
print PAGER "$Usage";
close(PAGER);
} elsif ( open(LESS, "|less") ) {
print LESS "$Usage";
close(LESS);
} elsif ( open(MORE, "|more") ) { # open pipeline to "more"
print MORE "$Usage";
close(MORE);
} else { # wot no more?
print STDOUT "$Usage";
}
}
#========================== Connect Only Portion =========================
sub connect_remote_to_stdio { # this does a one shot connection
# of our stdin and stdout to remote host.
local($remote_host, $remote_port) = @_;
$remote_host = $Remote_Machine_Name unless $remote_host;
$remote_port = $Service unless $remote_port;
$Connect_Only = 1; # probably true already.
&tcp_connect('', $remote_host, $remote_port);
}
#========================== Proxy Portion =========================
sub proxy_connect {
local($client_FH) = @_;
local(@client_request, $error);
while (<$client_FH>) {
push(@client_request, $_);
last if /^\n|^\r\n/;
}
local($first_line) = $client_request[0];
$first_line =~ s/\r\n$//;
$first_line =~ s/\n$//;
local($method, $item) = split(/\s+/, $first_line, 2);
local($protocol, $host, $port, $the_rest) = &null(4);
local($new_first, $data) = &null(2);
local($gc) = '';
if ( defined ($Global_Connection) ) {
$gc = $Global_Connection;
} else {
$gc = '?';
}
if ( $item =~ m,^([^:]+)://([^/\s]+)([/\s].*)$, ) {
$protocol = $1;
$host = $2;
$the_rest = $3;
if ( $host =~ /^([^:]+):(\d+)$/ ) {
$host = $1;
$port = $2;
}
if ( $port eq '' ) {
if ( $protocol =~ /^http$/i ) {
$port = '80';
} elsif ( $protocol =~ /^gopher$/i ) {
$port = '70';
} else {
$error = "Error: $gc: proxy_connect: cannot determine port: \n\t\"$first_line\"\n";
&proxy_error($client_FH, $error);
return $error;
}
}
if ( $protocol =~ /^gopher$/i || $port == '70' ) {
$method = 'GOPHER';
}
} elsif ( $item =~ m,^([^:]+):(\d+)([/\s].*)$, ) {
$host = $1;
$port = $2;
$the_rest = $3; # might be able to do it...
} else {
$error = "Error: $gc: proxy_connect: cannot yet handle request: \n
\t\"$first_line\"\n";
&proxy_error($client_FH, $error);
return $error;
}
if ( $method =~ /GET|POST|HEAD|OPTIONS|PUT|DELETE|TRACE/ ) {
$new_first = "$method $the_rest";
$client_request[0] = $new_first."\n";
$data = join('', @client_request);
&Log("$gc: proxy_connect:method: $method:\n");
&Log("$gc: proxy_connect:from: \"$host\"\n");
&Log("$gc: proxy_connect:port: \"$port\"\n");
&Log("$gc: proxy_connect:request: \"$new_first\"\n");
&tcp_connect($client_FH, $host, $port, $data);
} elsif ( $method =~ /GOPHER/ ) {
$the_rest =~ s,\s+HTTP/[\d\.]+$,,;
$the_rest =~ s,^/\d*(\d.*)$,$1,;
$data = $the_rest."\n";
&Log("$gc: proxy_connect:method: $method:\n");
&Log("$gc: proxy_connect:from: \"$host\"\n");
&Log("$gc: proxy_connect:port: \"$port\"\n");
&Log("$gc: proxy_connect:request: \"$the_rest\"\n");
print $client_FH "HTTP/1.0 200 Connection established\n";
print $client_FH "Content-Type: text/gopher\n\n";
&tcp_connect($client_FH, $host, $port, $data);
} elsif ( $method =~ /CONNECT/ ) {
$Service = 'binary';
&Log("$gc: proxy_connect:method: $method:\n");
&Log("$gc: proxy_connect:from: \"$host\"\n");
&Log("$gc: proxy_connect:port: \"$port\"\n");
print $client_FH "HTTP/1.0 200 Connection established\n";
print $client_FH "Proxy-agent: $ProxyName/$Version_num\n\n";
local($oldenv) = $ENV{TCP_B_BINARY};
$ENV{TCP_B_BINARY} = 1;
&tcp_connect($client_FH, $host, $port);
$ENV{TCP_B_BINARY} = $oldenv;
} else {
$error = "Error: $gc: proxy_connect: cannot yet handle method: \n
\t\"$first_line\"\n";
&proxy_error($client_FH, $error);
return $error;
}
return '';
}
sub proxy_error {
local($handle, $error_msg) = @_;
local($text) = <<"END_OF_TEXT";
Error
Error
A $ProxyName error has occurred.
$error_msg
$ProxyName $Version_url
END_OF_TEXT
print $handle $text;
}
#========================== Client Portion =========================
sub tcp_connect { # child child handles actual connection
local($Client_FH, $remote_host, $remote_port, $start_data) = @_;
local($verbose, $local_ip, $remote_ip) = &null(3);
$start_data = '' if !defined($start_data);
$verbose = 1 if $Debug; # for extra logging
$verbose = 1 if $ENV{'TCP_B_VERBOSE'};
# local($Client_FH_Reader, $Client_FH_Writer);
# local($Remote_FH_Reader, $Remote_FH_Writer, $Remote_FH);
$Client_FH_Reader = $Client_FH; # general case is a socket.
$Client_FH_Writer = $Client_FH;
if ( $Connect_Only || $Client_FH eq '' ) {
$Client_FH_Reader = 'STDIN'; # special case stdio
$Client_FH_Writer = 'STDOUT';
}
local($gc) = '';
if ( defined ($Global_Connection) ) {
$gc = $Global_Connection;
} else {
$gc = 'ONCE';
}
if ( $Firewall ) {
($local_ip, $remote_ip, $Remote_FH_Reader, $Remote_FH_Writer) =
&FirewallConnect($remote_host, $remote_port, $Firewall_Command);
} else {
($Remote_FH, $remote_ip, $local_ip) =
&Connect($remote_host, $remote_port);
$Remote_FH_Reader = $Remote_FH; # general case is a socket.
$Remote_FH_Writer = $Remote_FH;
}
if ( ! $Firewall || $Firewall_Command =~ /^TCP:/ ) {
if ( !defined($remote_ip) || $remote_ip eq '' || &SocketError($Remote_FH_Reader) ) {
&die($Remote_FH_Reader);
}
}
&Log("$gc: tcp_connect:connect_ok: $local_ip ==> $remote_ip:$remote_port\n");
&Log("$gc: tcp_connect:Client_FH_Reader: $Client_FH_Reader\n") if $verbose;
&Log("$gc: tcp_connect:Client_FH_Writer: $Client_FH_Writer\n") if $verbose;
&Log("$gc: tcp_connect:Remote_FH_Reader: $Remote_FH_Reader\n") if $verbose;
&Log("$gc: tcp_connect:Remote_FH_Writer: $Remote_FH_Writer\n") if $verbose;
# Picture so far:
# processes: Joe Blow <-------------> Us <-----------> Remote Server
# filehandles: Client_FH Remote_FH
local($xfer_method, $from, $i_do, $nbytes) = &null(4);
if ($Service eq '23' ||
$Service eq 'telnet' ||
$Service eq 'binary' ||
$ENV{TCP_B_CHAR_AT_A_TIME} ne '') {
# Hack to do character at a time for telnet login.
# Man this is SLOW! Kinda like 2400 baud over ethernet ;-)
# Now (Sat Jun 6 00:11:53 PDT 1998) do larger blksize.
$xfer_method = 1 unless $xfer_method;
if ( $Bytes > 0 ) {
$xfer_method = $Bytes;
} else {
$xfer_method = $Bytes_Default;
}
if ( $xfer_method == 1 ) {
&Log("$gc: tcp_connect: character at a time transmission\n");
}
} else {
$xfer_method = '';
}
if ( $Bytes > 0 ) {
$xfer_method = $Bytes;
} elsif ( $ENV{TCP_B_BINARY} ne '' ) {
$xfer_method = $Bytes_Default;
}
if($child = fork) { # Handles Remote Server -----> reader
$i_do = "LocalClient <<== RemoteServer:$remote_port";
&Log("$gc: $i_do, pid: $$\n");
$SIG{'INT'} = 'dokill'; # used for killing
sub dokill {
local($sig) = 'INT';
&Log("$Global_Connection: killing ($sig) \"$child\" (I am $$)\n") if $Debug;
kill $sig, $child if $child;
exit 0;
}
if ( ! $xfer_method ) { # line at a time
while(<$Remote_FH_Reader>) {
# Send what Remote Server says to Joe Blow
&Log("$gc: S:$_") if $verbose;
print $Client_FH_Writer $_;
}
} else {
if ( $xfer_method == 1 ) { # getc
while(! eof($Remote_FH_Reader) ) {
# Send what Remote Server says to Joe Blow
if ( $xfer_method == 1 ) {
$from = getc($Remote_FH_Reader);
} else {
$nbytes = read($Remote_FH_Reader, $from, $xfer_method);
# $nbytes = sysread($Remote_FH_Reader, $from, $xfer_method);
}
&Log("$gc: S[$nbytes]:$from:") if $verbose;
print $Client_FH_Writer $from;
}
} else { # select + sysread + syswrite
&transfer($Remote_FH_Reader, $Client_FH_Writer, $xfer_method, 'R->C');
}
}
close $Remote_FH_Reader; close $Remote_FH_Writer;
close $Client_FH_Reader; close $Client_FH_Writer;
&short_sleep('0.15');
# sleep 1; # see if it makes a difference
&dokill();# kill our sibling when Remote Server quits.
} else { # Handles Original Client -----> Remote Server
$i_do = "LocalClient ==>> RemoteServer:$remote_port";
&Log("$gc: $i_do, pid: $$\n");
$SIG{'INT'} = 'client_read_shutdown';
sub client_read_shutdown {
&Log("$Global_Connection: client_read_shutdown: (I am $$)\n") if $Debug;
close($Remote_FH_Reader); close($Remote_FH_Writer);
close($Client_FH_Reader); close($Client_FH_Writer);
&Log("$Global_Connection: client_read_shutdown: closed $Client_FH_Reader (I am $$)\n") if $Debug;
exit 0;
}
if ( $start_data ne '' ) {
print $Remote_FH_Writer $start_data;
}
if ( ! $xfer_method ) { # line at a time
while (<$Client_FH_Reader>) {
# Send what Joe Blow types to Remote Server
&Log("$gc: C:$_") if $verbose;
print $Remote_FH_Writer $_;
}
} else {
if ( $xfer_method == 1 ) { # getc
while(! eof($Client_FH_Reader) ) {
# Send what Remote Server says to Joe Blow
if ( $xfer_method == 1 ) {
$from = getc($Client_FH_Reader);
} else {
$nbytes = read($Client_FH_Reader, $from, $xfer_method);
# $nbytes = sysread($Client_FH_Reader, $from, $xfer_method);
}
&Log("$gc: C[$nbytes]:$from:") if $verbose;
print $Remote_FH_Writer $from;
}
} else { # select + sysread + syswrite
&transfer($Client_FH_Reader, $Remote_FH_Writer, $xfer_method, 'C->R');
}
}
close $Client_FH_Writer; close $Client_FH_Reader;
close $Remote_FH_Writer; close $Remote_FH_Reader;
}
# Final entry in Ship's log.
&Log("$gc: Closing PID $$ ($i_do)\n");
&Log("$gc: $A_Line\n");
}
sub transfer {
local($in,$out,$blksize,$lab) = @_;
local($LineMode) = 0;
if ( ! $LineMode ) {
&select_transfer($in,$out,$blksize,$lab);
return;
}
while (<$in>) {
print $out $_;
}
}
sub select_transfer {
local($in,$out,$blksize,$lab) = @_;
&Log("$gc: select_transfer, $lab\n") if $verbose;
local($nf, $rchk, $len, $buf, $quit, $offset, $bytes, $written);
$RIN = $WIN = $EIN = '';
$ROUT = '';
vec($RIN,fileno($in),1) = 1;
vec($WIN,fileno($in),1) = 1;
$EIN = $RIN | $WIN;
LOOP:
while (1) {
$nf = 0;
while (! $nf ) {
&Log("$gc: $lab: select...\n") if $Debug;
($nf, $rchk) = &ready_to_read();
&Log("$gc: $lab: nf: $nf, " . &bitview($rchk) . "\n") if $Debug;
}
&Log("$gc: $lab: sysread...\n") if $Debug;
$len = sysread($in ,$buf, $blksize);
if ( !defined($len) ) {
next if $! =~ /^Interrupted/;
die "$lab: System read error: $!\n";
} elsif ($len == 0) {
local($quit) = 0;
if ( eof($in) ) {
$quit = 1;
&Log("$gc: $lab: input is EOF\n");
}
last if $quit;
}
if ( $Debug ) {
local($str) = substr($buf, 0, 12);
$str .= " ..." if $len > 13;
$str =~ s/\r\n//g;
$str =~ s/\n//g;
# $str = $buf;
if ( $ENV{TCP_B_ALLSTR} ne '' ) {
$str = $buf;
}
&Log("$gc: $lab: len($len) buf=\"$str\"\n");
}
$offset = 0;
$bytes += $len;
while ($len) {
&Log("$gc: $lab: syswrite...\n") if $Debug;
$written = syswrite($out, $buf, $len, $offset);
&Log("$gc: $lab: wrote $written/$len\n") if $Debug;
die "$lab: System write error: $!\n" unless defined $written;
$len -= $written;
$offset += $written;
}
}
close($in);
close($out);
}
sub ready_to_read {
local($nf);
$nf = select($ROUT=$RIN, undef, undef, undef);
# $nf = select($ROUT=$RIN, undef, undef, 1.0);
return ($nf, $ROUT);
}
sub bitview {
local($vec) = @_;
local($bits) = unpack("b*", $vec);
return $bits;
}
sub nap {
local($t) = @_;
select(undef,undef,undef, $t);
}
sub FirewallConnect {
local($host, $port, $firewall_cmd) = @_;
$firewall_cmd =~ s/%HOST/$host/g;
$firewall_cmd =~ s/%PORT/$port/g;
$local_ip = &Local_IP();
$remote_ip = &IP_From_Name($host);
if ( &SocketError($remote_ip) ) {
$remote_ip = "FirewallConnect:UNDETERMINED($host)";
}
local($read_fh) = ++$Firewall_Handles;
local($write_fh) = ++$Firewall_Handles;
local($gc) = '';
if ( defined ($Global_Connection) ) {
$gc = $Global_Connection;
} else {
$gc = '?';
}
if ( $firewall_cmd =~ /^TCP:/ ) {
local($rest) = $';
local($fw_host, $fw_port, $fw_send, $fw_skip, $fw_trim) = split(/:/, $rest, 5);
$fw_send = "%HOST %PORT" if !defined($fw_send) || $fw_send eq '';
$fw_trim = "" if !defined($fw_trim);
$fw_skip = 0 if !defined($fw_skip);
$fw_send =~ s/%HOST/$host/g;
$fw_send =~ s/%PORT/$port/g;
local($fw_socket);
($fw_socket, $remote_ip, $local_ip) =
&Connect($fw_host, $fw_port);
$read_fh = $fw_socket;
$write_fh = $fw_socket;
&Log("$gc: FirewallConnect: fw_host=\"$fw_host\", fw_port=\"$fw_port\", fw_send=\"$fw_send\", fw_trim=\"$fw_trim\"\n");
if ( ! &SocketError($fw_socket) ) {
local($i, $tmp);
for($i = 0; $i < length($fw_trim); $i++) {
$tmp = getc($fw_socket);
&Log("$gc: FirewallConnect:trim: \"$tmp\"\n") if $Debug;
}
print $fw_socket "$fw_send\n";
for($i = 0; $i < $fw_skip; $i++) {
$tmp = <$fw_socket>;
&Log("$gc: FirewallConnect:skip: $tmp") if $Debug;
}
}
} else {
&Log("$gc: FirewallConnect:doing: open2($firewall_cmd)\n");
&Log("$gc: FirewallConnect:read_fh: $read_fh\n") if $Debug;
&Log("$gc: FirewallConnect:write_fh: $write_fh\n") if $Debug;
&Use_open2;
&open2($read_fh, $write_fh, $firewall_cmd);
}
return ($local_ip, $remote_ip, $read_fh, $write_fh);
}
sub die {
local($msg) = @_;
if ( defined($Global_Connection) ) {
$msg = "$Global_Connection: $msg";
}
&Log("$msg\n") unless $Connect_Only;
die $msg;
exit 1;
}
sub Log {
print LOG @_ unless $Quiet;
}
sub short_sleep {
local($time) = $_[0];
select(undef, undef, undef, $time);
}
sub null {
local($n, $fill) = @_;
local(@array, $i);
if ( !defined($fill) ) {
$fill = '';
}
if ( $n =~ /^\d+$/ ) {
for ($i = 0; $i < $n ; $i++) {
push(@array, $fill);
}
return @array;
} else {
return $fill;
}
}
sub open_log_file {
if ( $Log_File ne $Log_File0 ) {
open(LOG, ">> $Log_File");
} elsif ( $Debug ) {
open(LOG, "| cat");
} elsif ($Connect_Only) {
$Quiet = 1;
open(LOG, ">/dev/null");
} else {
open(LOG, ">> $Log_File");
}
}
sub initialize_remote_host {
if ( $Remote_Machine_Name eq '' ) {
&die("No remote machine specified");
} else {
if ( $Firewall ) {
$Remote_Machine_IP = '';
$Remote_Machine = $Remote_Machine_Name; # might not be numerical
} elsif ( $Remote_Machine_Name !~ /^\d+/ ) {
$Remote_Machine_IP = &IP_From_Name($Remote_Machine_Name);
&die($Remote_Machine_IP) if &SocketError($Remote_Machine_IP);
$Remote_Machine = $Remote_Machine_IP;
} else {
$Remote_Machine_IP = $Remote_Machine_Name;
$Remote_Machine_Name = '';
$Remote_Machine = $Remote_Machine_IP;
}
}
&Log("Remote_Machine_IP: \"$Remote_Machine_IP\"\n");
local($passmach) = $Remote_Machine_IP;
if ( $Firewall && $Remote_Machine_IP eq '' ) {
$passmach = "$Remote_Machine_Name -via- $Firewall_Command";
}
&Log("Starting up: service=\"$Service\", port=\"$Port\", pass-to-machine=\"$passmach\"\n");
&Log("$A_Line\n\n");
}
sub initialize_variables {
$Version_num = "0.4";
$Version = "$Version_num Copyright (c) 1995-1998 by Karl J. Runge. ";
$Version_url =
"$Version_num Copyright © 1995-1998 by Karl J. Runge. runge\@karlrunge.com";
$Debug = '';
$Quiet = '';
$Denied = 'Permission denied.';
$Pre_Cmd = '';
$A_Line = '--------------------------------------------------------------';
$Port = '4001'; # default port to listen on.
$Service = '23'; # default service to connect client to.
$Limit = ''; # default IP patterns allowed.
$Proxy = ''; # whether or not to do proxying
$Connect_Only = ''; # whether or not to just do one connection.
$ProxyName = "${program}_proxy";
$Bytes = 0;
$Bytes_Default = 4096;
$Firewall = '';
$Firewall_Handles = 'FIREWALL0000';
$Firewall_Perl = "/dist/pkg/term/termperl";
$Firewall_Command = "%Firewall_Perl $0 -connect_only -q -r %HOST -s %PORT" ;
# File to find default machine
$Remote_Machine_File = "$ENV{'HOME'}/.machine";
# Default machine to pass connection to
$Remote_Machine_Name = '';
$Remote_Machine_IP = '';
$Remote_Machine = '';
# Place to log connections.
local($pid) = $$;
$Log_File = "/tmp/${program}_${pid}_log";
$Log_File0 = $Log_File;
local($machine_ip0);
if ( -f $Remote_Machine_File ) {
# might as well read file now...
chop($machine_ip0 = `head -1 $Remote_Machine_File`);
if ( $machine_ip0 ne '' ) {
$Remote_Machine_IP = $machine_ip0;
}
if ( $machine_ip0 !~ /^\d+\./ ) {
# hmmm probably FQDN not number...
$Remote_Machine_Name = $machine_ip0;
}
}
&AvoidThoseNastyWarnings if 0;
}
sub AvoidThoseNastyWarnings {
local($x) = '';
&client_read_shutdown if 0;
&do_shutdown if 0;
}
sub usage_statement {
local($x) = <<"EOU"; # Set to contain help message
$program: $Version
Listen on a port ($Port) and redirect connections to tcp
service ($Service) on another machine ($Remote_Machine_IP).
Usage:
$program
-p Local port to listen to.
-r Remote machine to connect to.
-s Remote port to connect to.
-l Place info in logfile
-limit xxx.xxx.xxx Limiting connecting IP number to pattern(s).
(use : as separator)
-d Debug reporting
-q Quiet about logging
-h -help Print this help
-bytes Try to read/write n bytes at a time, n=1
implies select or getc(). (default mode is one
line at a time, e.g. http, smtp, nntp)
-binary Use select + sysread + syswrite to transfer
data (default blksize: $Bytes_Default)
-proxy Run as a proxy server
-connect_only Do not be a server, just connect once, using
STDIN and STDOUT as "client".
-firewall Make connections using default firewall command.
-firewall_cmd Make connections using alternative firewall
command "cmd".
-sysv use = 0 or 1 depending if machine is sysv.
Notes:
If "service" or "port" is a standard service, the name may be used
instead of the number (e.g. smtp = 25).
Limit xxx.xxx.xxx limits access of incoming IP's number to those
matching that pattern (e.g. xxx.xxx.xxx.yyy is OK).
Separate multiple ones with `:'
Default logging to ($Log_File).
Default IP addr limiting to ($Limit).
File to look for default machine ($Remote_Machine_File).
Firewall command is:
$Firewall_Command
When supplying your own firewall command, the STDIO is hooked to it
and %HOST %PORT are expanded to the desired remote machine.
However if Firewall_Command matches:
TCP:fwhost:fwport:send_string:skip_lines:trim_string
you can use a TCP connection to a firewall machine (instead of
running a separate command). In this case a TCP socket is opened
to port "fwport" on machine "fwhost". The number of bytes in
"trim_string" is then read from the firewall host and discarded.
Then "send_string" plus a newline is sent to the firewall host,
with %HOST and %PORT expanded accordingly. If "send_string" is
empty, then "%HOST %PORT" is used. Then, the next "skip_lines" lines
from the connection are discarded. The TCP connection is then
handed over to the client.
E.g.: -firewall_cmd "TCP:myproxy.foo.com:3666::2:(to) "
This works for itelnet/telnet-passthru service.
The "trim_string" is basically a prompt, to which "%HOST %PORT"
is sent back. Then the number "skip_lines" are skipped, and
finally the connection proceeds back and forth as normal.
Environment used:
TCP_B_CHAR_AT_A_TIME use getc()
TCP_B_VERBOSE verbose
TCP_B_BINARY run in binary mode (?)
TCP_B_ALLSTR in binary xfer mode, print out all data to log
HOME used to fine ~/.machine
PAGER used for -help
Bugs:
Telnet login very slow [due to getc()]. (much better now with
select/sysread/syswrite)
Ftp will not work (multiple ports 20+21, 2nd cannot reach
original caller).
Tested on:
echo(7), daytime(13), chargen(19), telnet(23), mail(25), finger(79),
pop(110), news(119). ssh(22). Proxy: http.
EOU
return $x;
}
sub domain_limits {
local($limit_line) = @_;
local(@array);
local($pattern, $tmp) = &null(2);
if ($limit_line) {
&Log("Limiting to: $limit_line\n");
foreach $pattern (split(/:/, $limit_line)) {
$tmp = '^'."$pattern";
# $tmp =~ s,\.,\\s+,g; # when did this last work?
$tmp =~ s,\.,\\.,g;
&Log("$pattern => $tmp -- \n");
push(@array, $tmp);
}
&Log("\n");
}
return @array;
}
sub check_access {
local(*limits, $address) = @_;
local($test_ok) = '';
local($count) = '0';
return 0 if $address eq '';
foreach $pattern (@limits) {
$count++;
if ($address =~ /$pattern/ ) {
$test_ok = $pattern;
last;
}
}
$test_ok = 'NO_LIMITS_IMPOSED' if $count == 0;
return $test_ok;
}
#================================================================
package Ksockets;
#===========================================================================
# Ksockets v0.2: Karl's sockets. Copyright (c) 1996-2001 by Karl J. Runge
# Socket macros to perl's low level socket interface.
#===========================================================================
sub main'Use_Ksockets {
###################################################################
#
# Initialize Ksockets Package
#
# USAGE:
#
# &Use_Ksockets();
#
###################################################################
if ( defined($ksockets_initialized) ) {
return;
}
if (0) {
# List of functions in this package:
&main'Use_Ksockets;
&main'Server;
&main'Connect;
&main'AcceptConnection;
&main'Recv;
&main'Send;
&main'Ready;
&main'SocketError;
&main'IP_From_Name;
&main'SocketInfo;
&main'Local_IP;
&main'spit_ksockets;
&get_sock_type;
# List of variables referenced:
$main'Debug;
}
$pkg = 'Ksockets';
$Server_Handles = 'KSOCKETSSERVER00000';
$Connect_Handles = 'KSOCKETSCONNECT0000';
$Ksockets_Handle_String = 'KSOCKETS';
$AF_INET = 2; # choose INET family
local($is_svr4) = '';
if ( defined($main'IS_SYSV) ) {
if ( $main'IS_SYSV ) {
$is_svr4 = 1;
} else {
$is_svr4 = 0;
}
} else {
if ( -x "/bin/uname" || -x "/usr/bin/uname" ) {
# OK, this is quite a hack...
local($osname) = `uname -s`;
local($release) = `uname -r`;
if ( $osname =~ /sunos/i && $release !~ /^4\./ ) {
$is_svr4 = 1;
}
# add others ...
}
}
if ( ! $is_svr4 ) {
$SOCK_STREAM = 1; # BSD flavor
$SOCK_DGRAM = 2; # known to work on Linux
# SunOS 4.
} else {
$SOCK_STREAM = 2; # SVR4 flavor
$SOCK_DGRAM = 1; # known to work on solaris
}
# todo: SOCK_RAW SOCK_SEQPACKET SOCK_RDM
$Default_Proto = 'tcp';
$Default_Backlog = '8';
# template for packing socket address into binary.
$SockAddr = 'S n a4 x8';
if ( $main'Local ne '' ) {
$Hostname = $main'Local;
} else {
$Hostname = &this_host();
}
local($name,$aliases,$type,$len,$localaddr) =
gethostbyname($Hostname);
$Local_IP = join('.', unpack('C4',$localaddr));
$ksockets_initialized = 1;
} # end Use_Ksockets
sub main'Server {
###################################################################
#
# Open a listening socket on a port.
#
# USAGE:
#
# $file_handle = &Server($port, $backlog[OPT], $proto_in[OPT])
#
# Then use $file_handle in &AcceptConnection($file_handle) calls
# Test for errors via a call to: &SocketError($file_handle)
#
# e.g:
# $Server = &Server('8888');
# die "$Server" if &SocketError($Server);
# ($Client) = &AcceptConnection($Server);
# die "$Client" if &SocketError($Client);
# ...
###################################################################
local($port, $backlog, $proto_in) = @_;
local($name, $aliases, $proto);
if ( !defined($proto_in) || $proto_in eq '' ) {
$proto_in = $Default_Proto;
}
if ($port !~ /^\d+$/) {
# port could be "smtp" though not likely
($name, $aliases, $port, $proto) =
getservbyname($port, $proto_in);
}
($name, $aliases, $proto) = getprotobyname($proto_in);
$backlog = $Default_Backlog unless $backlog;
print STDERR "Server:port:$port\n" if $main'Debug;
# pack our address
local($us) = pack($SockAddr, $AF_INET, $port, "\0\0\0\0");
local($listen) = ++$Server_Handles;
# force filehandles into callers' package
local($package) = caller;
$listen =~ s/^[^']+$/$package'$&/;
local($old) = select($listen); $| = 1; select($old);
local($SOCK_TYPE) = &get_sock_type($proto_in);
if ( ! socket($listen, $AF_INET, $SOCK_TYPE, $proto) ) {
return "Error:$pkg:Server:socket($listen, $AF_INET, $SOCK_TYPE, $proto): \"$!\"";
}
if ( ! bind($listen, $us) ) {
return "Error:$pkg:Server:bind($listen, SOCKADDR): \"$!\"";
}
if ( $proto_in eq 'tcp' ) {
if ( ! listen($listen, $backlog) ) {
return "Error:$pkg:Server:listen($listen, $backlog): \"$!\"";
}
}
return $listen;
} # end Server
sub main'Connect {
###################################################################
#
# Make a connection to a remote host port.
#
# USAGE:
#
# ($file_handle, $host_ip, $Local_IP, $host_sockaddr, $local_sockaddr) =
# &Connect($host, $port, $proto_in[OPT])
#
# Then use $file_handle in to read and write from remote connection
#
# Test for errors via a call to: &SocketError($file_handle)
#
# Use $host_ip and $local_ip as IP address information.
# The $host_sockaddr and $local_sockaddr are packed socket addresses
# for us in connectionless sockets (e.g. 'udp')
#
# e.g:
# ($Remote) = &Connect('www.netscape.com', '80');
# die "$Remote" if &SocketError($Remote);
# ...
###################################################################
local($host, $port, $proto_in) = @_;
local($name, $aliases, $proto);
local($type,$len);
local($local_addr, $local_sockaddr); # , $local_ip);
local($host_addr, $host_sockaddr, $host_ip);
if ( !defined($proto_in) || $proto_in eq '' ) {
$proto_in = $Default_Proto;
}
if ($port !~ /^\d+$/) {
# port could be "smtp"
($name, $aliases, $port, $proto) =
getservbyname($port, $proto_in);
if ( $port eq '' ) {
return ("Error:$pkg:Connect:getservbyname($port, $proto_in): Empty port returned", '', '', '', '');
}
}
($name, $aliases, $proto) = getprotobyname($proto_in);
if ( !defined($proto) || $proto eq '' ) {
return ("Error:$pkg:Connect:getprotobyname($proto_in): Empty proto returned", '', '', '', '');
}
if ( $host =~ /^\d+/ ) {
$host_ip = $host;
$host_addr = pack('C4', split(/\./, $host, 4));
} else {
($name,$aliases,$type,$len,$host_addr) =
gethostbyname($host);
if ( !defined($host_addr) || $host_addr eq '' ) {
return ("Error:$pkg:Connect:gethostbyname($host): Empty host_addr returned", '', '', '', '');
}
$host_ip = join('.', unpack('C4', $host_addr));
}
$local_addr = pack('C4', split(/\./, $Local_IP, 4));
$local_sockaddr = pack($SockAddr, $AF_INET, 0, $local_addr);
$host_sockaddr = pack($SockAddr, $AF_INET, $port, $host_addr);
local($connection) = ++$Connect_Handles;
# force filehandles into callers' package
local($package) = caller;
$connection =~ s/^[^']+$/$package'$&/;
local($old) = select($connection); $| = 1; select($old);
local($SOCK_TYPE) = &get_sock_type($proto_in);
if ( ! socket($connection, $AF_INET, $SOCK_TYPE, $proto) ) {
return ("Error:$pkg:Connect:socket($connection, $AF_INET, $SOCK_TYPE, $proto): \"$!\"", '', '', '', '');
}
if ( ! bind($connection, $local_sockaddr) ) {
return ("Error:$pkg:Connect:bind($connection, $Local_IP): \"$!\"", '', '', '', '');
}
if ( $proto_in eq 'tcp' ) {
if ( ! connect($connection, $host_sockaddr) ) {
return ("Error:$pkg:Connect:connect($connection, $host_ip): \"$!\"", '', '', '', '');
}
}
return ($connection, $host_ip, $Local_IP, $host_sockaddr, $local_sockaddr);
} # end Connect
sub main'AcceptConnection {
###################################################################
#
# Wait for and accept a connection on a listening port.
#
# Listening port created with &Server();
#
# USAGE:
#
# ($file_handle, $address, $client_port) =
# &AcceptConnection($listen_file_handle))
#
# Then use $file_handle in to read and write from remote connection
# Test for errors via a call to: &SocketError($file_handle)
#
# e.g:
# ($OurService) = &Server('8888');
# die "$OurService" if &SocketError($OurService);
# ($Guest) = &AcceptConnection($OurService);
# die "$Guest" if &SocketError($Guest);
# ...
###################################################################
local($listen_socket) = @_;
local($real_socket) = ++$Server_Handles;
# force filehandles into callers' package
local($package) = caller;
$real_socket =~ s/^[^']+$/$package'$&/;
local($old) = select($real_socket); $| = 1; select($old);
local($address) = '';
local($fail) = '';
($address = accept($real_socket, $listen_socket)) ||
($fail = "Error:$pkg:AcceptConnection:accept($real_socket, $listen_socket): \"$!\"");
if ( $fail ne '' ) {
close($real_socket);
return ($fail, '', '');
}
local($af,$c_port,$inetaddr) = unpack($SockAddr,$address);
$address = join('.', unpack('C4',$inetaddr));
return ($real_socket, $address, $c_port);
} # end AcceptConnection
sub main'Ready {
###################################################################
#
# See if a socket handle is ready to be read or written to.
#
# USAGE:
#
# ($handle_ready, $time_left ) =
# &Ready($socket_handle, $time_out, $mode[OPT])
#
# Given handle will be checked for readiness up to $time_out seconds
# Default for $mode is 'read', but it could be 'write' or 'error'
#
# $handle_ready will be the integer result of the select() call,
# i.e. the number of 'ready' handles. Should be 0 (problem) or
# 1 (handle ready).
#
# If time_out is undef, it should block waiting for readiness.
#
# E.g.:
# ($ready) = &Ready($socket, '30');
# if ($ready) {
#
# } else {
#
# }
#
###################################################################
local($socket, $time_out, $mode) = @_;
local($handle_ready, $time_left, $in, $out) = ('', '', '','');
vec($in, fileno($socket), 1) = 1;
# note, the $out = $in stuff is not useful since they are
# reset every time.
if ( ! defined($mode) || $mode eq 'read' ) {
($handle_ready, $time_left) =
select($out = $in, undef, undef, $time_out);
} elsif ( $mode eq 'write' ) {
($handle_ready, $time_left) =
select(undef, $out = $in, undef, $time_out);
} elsif ( $mode eq 'error' ) {
($handle_ready, $time_left) =
select(undef, undef, $out = $in, $time_out);
} elsif ( $mode eq 'sleep' ) { # undoc'd floating pt sleep
($handle_ready, $time_left) =
select(undef, undef, undef, $time_out);
} else { # should handle error case better
$handle_ready = undef;
$time_left = 'Error:Ready:unknown mode';
}
return ($handle_ready, $time_left);
} # end Ready
sub main'Recv {
###################################################################
#
# Receive data from a socket.
#
# USAGE:
#
# ($data, $recv_address_info ) = &Recv($socket_handle, $size)
#
#
###################################################################
local($socket, $size) = @_;
local($recv_info, $buf) = ('', '');
$recv_info = recv($socket, $buf, $size, 0);
return ($buf, $recv_info);
} # end Recv
sub main'Send {
###################################################################
#
# Send data to a socket.
#
# USAGE:
#
# $nchars = &Send($socket_handle, $message, $TO[OPT])
#
# $nchars is number of characters sent.
# optional $TO is for 'udp' sockets. The Remote sockaddr
# returned on Connect() say.
#
#
###################################################################
local($socket, $message, $to) = @_;
local($send_info) = '';
if ( !defined($to) || $to eq '' ) {
$send_info = send($socket, $message, 0);
} else {
$send_info = send($socket, $message, 0, $to);
}
if ( !defined($send_info) ) {
$send_info = "Error:$pkg:Send:send($socket, $message, 0, $to): \"$!\"";
}
return $send_info;
} # end Send
sub main'SocketError {
###################################################################
#
# Test for error on a Ksocket command.
#
# USAGE:
#
# ($socket_file_handle, .... ) = &Ksocket_Command(...)
#
# Ksocket_Command can be:
# Server()
# Connect()
# AcceptConnection()
# IP_From_Name()
#
# $error = &SocketError($socket_file_handle)
#
# if ( $error ) {
#
# } else {
#
# }
#
###################################################################
local($msg) = @_;
if ( $msg =~ /^\s*$/ ) {
return 1;
}
if ( $msg =~ /^\s*ERROR/i ) {
return 1;
}
if ( $msg !~ /$Ksockets_Handle_String/ && $msg !~ /^\d+\.\d+\.\d+\.\d+$/ ) {
return 1;
}
return 0;
} # end SocketError
sub main'IP_From_Name {
###################################################################
#
# Translate a machine host name into IP number nnn.nnn.nnn.nnn
#
# USAGE:
#
# $ip_number = &IP_From_Name($name)
#
# e.g.
# $ip_number = &IP_From_Name('www.netscape.com');
# die "$ip_number" if &SocketError($ip_number);
# ...