Blame contrib/portfw

Packit 7ef13a
#!/usr/bin/perl -w
Packit 7ef13a
Packit 7ef13a
=pod
Packit 7ef13a
Packit 7ef13a
=head1 NAME
Packit 7ef13a
Packit 7ef13a
portfw - Port forwarder
Packit 7ef13a
Packit 7ef13a
=head1 SYNOPSYS
Packit 7ef13a
Packit 7ef13a
portfw [-p pidfile] [local_ip:]local_port[/proto] remote_ip[:remote_port]
Packit 7ef13a
Packit 7ef13a
=head1 DESCRIPTION
Packit 7ef13a
Packit 7ef13a
Forwards all incoming request from local_port to remote_port.  If
Packit 7ef13a
local_ip is not specified, all addresses on all interfaces are used.
Packit 7ef13a
If no remote_port is specified, then the same local_port is assumed
Packit 7ef13a
as the default.  If no /proto is specified, tcp is assumed.
Packit 7ef13a
Packit 7ef13a
=head1 AUTHOR
Packit 7ef13a
Packit 7ef13a
Rob Brown - bbb@cpan.org
Packit 7ef13a
Packit 7ef13a
$Id: portfw,v 1.7 2003/07/30 06:50:26 rob Exp $
Packit 7ef13a
Packit 7ef13a
=cut
Packit 7ef13a
Packit 7ef13a
use strict;
Packit 7ef13a
use Getopt::Long;
Packit 7ef13a
use IO::Multiplex;
Packit 7ef13a
use IO::Socket;
Packit 7ef13a
Packit 7ef13a
my $pidfile;
Packit 7ef13a
GetOptions
Packit 7ef13a
  "pidfile=s" => \$pidfile,
Packit 7ef13a
  ;
Packit 7ef13a
Packit 7ef13a
my ($local_addr,$remote_addr)=@ARGV;
Packit 7ef13a
die "Missing local port\n" if !$local_addr;
Packit 7ef13a
die "Missing remote ip\n" if !$remote_addr;
Packit 7ef13a
Packit 7ef13a
my ($local_ip, $local_port, $proto,
Packit 7ef13a
    $remote_ip,$remote_port);
Packit 7ef13a
if ($local_addr =~ s%/(\w+)$%%) {
Packit 7ef13a
  $proto = $1;
Packit 7ef13a
} else {
Packit 7ef13a
  $proto = "tcp";
Packit 7ef13a
}
Packit 7ef13a
if ($local_addr =~ s%^([\d\.]+):%%) {
Packit 7ef13a
  $local_ip = $1;
Packit 7ef13a
} else {
Packit 7ef13a
  $local_ip = "0.0.0.0";
Packit 7ef13a
}
Packit 7ef13a
if ($local_addr =~ m%^(\d+)$%) {
Packit 7ef13a
  $local_port = $1;
Packit 7ef13a
} else {
Packit 7ef13a
  die "Invalid local port [$local_addr]\n";
Packit 7ef13a
}
Packit 7ef13a
if ($remote_addr =~ s%:(\d+)$%%) {
Packit 7ef13a
  $remote_port = $1;
Packit 7ef13a
} else {
Packit 7ef13a
  $remote_port = $local_port;
Packit 7ef13a
}
Packit 7ef13a
if ($remote_addr =~ m%^([\d\.]+)$%) {
Packit 7ef13a
  $remote_ip = $1;
Packit 7ef13a
} else {
Packit 7ef13a
  die "Invalid remote ip [$remote_addr]\n";
Packit 7ef13a
}
Packit 7ef13a
Packit 7ef13a
print STDERR "Forwarding $proto packets from $local_ip:$local_port to $remote_ip:$remote_port\n";
Packit 7ef13a
Packit 7ef13a
# Get ready to receive an incoming connection
Packit 7ef13a
my $listen = new IO::Socket::INET
Packit 7ef13a
  LocalAddr => $local_ip,
Packit 7ef13a
  LocalPort => $local_port,
Packit 7ef13a
  Proto     => $proto,
Packit 7ef13a
  ReuseAddr => 1,
Packit 7ef13a
  $proto eq "tcp"?(Listen => 10):(),
Packit 7ef13a
  or die "Could not bind local port $local_port/$proto: $!";
Packit 7ef13a
Packit 7ef13a
# Just test the remote connection once.
Packit 7ef13a
my $remote_connect = new IO::Socket::INET
Packit 7ef13a
  PeerAddr => $remote_ip,
Packit 7ef13a
  PeerPort => $remote_port,
Packit 7ef13a
  Proto    => $proto,
Packit 7ef13a
  or die "Could not connect to remote $remote_ip:$remote_port/$proto: $!";
Packit 7ef13a
Packit 7ef13a
if ($proto eq "tcp") {
Packit 7ef13a
  # Close the test tcp socket
Packit 7ef13a
  $remote_connect->close;
Packit 7ef13a
} elsif ($proto eq "udp") {
Packit 7ef13a
  # Keep this around for udp replies
Packit 7ef13a
} else {
Packit 7ef13a
  die "Unimplemented protocol $proto\n";
Packit 7ef13a
}
Packit 7ef13a
Packit 7ef13a
if ($pidfile) {
Packit 7ef13a
  if (my $pid = fork) {
Packit 7ef13a
    open (PID, ">$pidfile") or die "WARNING: Cannot create $pidfile: $!\n";
Packit 7ef13a
    print PID "$pid\n";
Packit 7ef13a
    close PID;
Packit 7ef13a
    exit;
Packit 7ef13a
  } elsif (!defined $pid) {
Packit 7ef13a
    die "fork: $!\n";
Packit 7ef13a
  }
Packit 7ef13a
  $SIG{TERM} = sub {
Packit 7ef13a
    unlink $pidfile;
Packit 7ef13a
    exit;
Packit 7ef13a
  };
Packit 7ef13a
} else {
Packit 7ef13a
  exit if fork;
Packit 7ef13a
}
Packit 7ef13a
open STDIN,  "
Packit 7ef13a
open STDOUT, ">/dev/null";
Packit 7ef13a
open STDERR, ">/dev/null";
Packit 7ef13a
Packit 7ef13a
my $mux = new IO::Multiplex;
Packit 7ef13a
$mux->set_callback_object("My::Portfw");
Packit 7ef13a
if ($proto eq "tcp") {
Packit 7ef13a
  $mux->listen($listen);
Packit 7ef13a
} elsif ($proto eq "udp") {
Packit 7ef13a
  $My::Portfw::complement{"$listen"} = $remote_connect;
Packit 7ef13a
  $My::Portfw::complement{"$remote_connect"} = $listen;
Packit 7ef13a
  $mux->add($listen);
Packit 7ef13a
  $mux->add($remote_connect);
Packit 7ef13a
} else {
Packit 7ef13a
  die "Unimplemented proto [$proto]";
Packit 7ef13a
}
Packit 7ef13a
$mux->loop;
Packit 7ef13a
# Never reaches here
Packit 7ef13a
exit 1;
Packit 7ef13a
Packit 7ef13a
package My::Portfw;
Packit 7ef13a
use vars qw(%complement);
Packit 7ef13a
Packit 7ef13a
sub mux_connection {
Packit 7ef13a
  my $self = shift;
Packit 7ef13a
  my $mux = shift;
Packit 7ef13a
  my $fh = shift;
Packit 7ef13a
  my $remote_client = new IO::Socket::INET
Packit 7ef13a
    PeerAddr => $remote_ip,
Packit 7ef13a
    PeerPort => $remote_port,
Packit 7ef13a
    Proto    => $proto;
Packit 7ef13a
  if (!$remote_client) {
Packit 7ef13a
    warn "FAILED!\n";
Packit 7ef13a
    # Remote connection failed
Packit 7ef13a
    $fh->write("Server Down! $!\n");
Packit 7ef13a
    $fh->close;
Packit 7ef13a
    return;
Packit 7ef13a
  }
Packit 7ef13a
  $mux->add($remote_client);
Packit 7ef13a
  $complement{"$fh"} = $remote_client;
Packit 7ef13a
  $complement{"$remote_client"} = $fh;
Packit 7ef13a
  return 1;
Packit 7ef13a
}
Packit 7ef13a
Packit 7ef13a
sub mux_input {
Packit 7ef13a
  my $self = shift;
Packit 7ef13a
  my $mux  = shift;
Packit 7ef13a
  my $fh   = shift;
Packit 7ef13a
  my $data = shift;
Packit 7ef13a
  if (my $proxy = $complement{"$fh"}) {
Packit 7ef13a
    # Consume the packet by sending to its complement socket.
Packit 7ef13a
    $proxy->write($$data);
Packit 7ef13a
    $$data = "";
Packit 7ef13a
  } else {
Packit 7ef13a
    # Not sure what to do, close it.
Packit 7ef13a
    $$data = "";
Packit 7ef13a
    $fh->close;
Packit 7ef13a
  }
Packit 7ef13a
}
Packit 7ef13a
Packit 7ef13a
sub mux_eof {
Packit 7ef13a
  my $self = shift;
Packit 7ef13a
  my $mux  = shift;
Packit 7ef13a
  my $fh   = shift;
Packit 7ef13a
  my $data = shift;
Packit 7ef13a
  if (my $proxy = $complement{"$fh"}) {
Packit 7ef13a
    # Consume the packet by sending to its complement socket.
Packit 7ef13a
    $proxy->write($$data);
Packit 7ef13a
    $$data = "";
Packit 7ef13a
    # If this has been closed for writing,
Packit 7ef13a
    # then close the complement for writing too.
Packit 7ef13a
    $mux->shutdown($proxy, 1);
Packit 7ef13a
  }
Packit 7ef13a
}
Packit 7ef13a
Packit 7ef13a
sub mux_close {
Packit 7ef13a
  my $self = shift;
Packit 7ef13a
  my $mux  = shift;
Packit 7ef13a
  my $fh   = shift;
Packit 7ef13a
  delete $complement{"$fh"} if exists $complement{"$fh"};
Packit 7ef13a
}