view release on metacpan or  search on metacpan

contrib/portfw  view on Meta::CPAN

#!/usr/bin/perl -w

=pod

=head1 NAME

portfw - Port forwarder

=head1 SYNOPSYS

portfw [-p pidfile] [local_ip:]local_port[/proto] remote_ip[:remote_port]

=head1 DESCRIPTION

Forwards all incoming request from local_port to remote_port.  If
local_ip is not specified, all addresses on all interfaces are used.
If no remote_port is specified, then the same local_port is assumed
as the default.  If no /proto is specified, tcp is assumed.

=head1 AUTHOR

Rob Brown - bbb@cpan.org

$Id: portfw,v 1.7 2003/07/30 06:50:26 rob Exp $

=cut

use strict;
use Getopt::Long;
use IO::Multiplex::KQueue;
use IO::Socket;

my $pidfile;
GetOptions
  "pidfile=s" => \$pidfile,
  ;

my ($local_addr,$remote_addr)=@ARGV;
die "Missing local port\n" if !$local_addr;
die "Missing remote ip\n" if !$remote_addr;

my ($local_ip, $local_port, $proto,
    $remote_ip,$remote_port);
if ($local_addr =~ s%/(\w+)$%%) {
  $proto = $1;
} else {
  $proto = "tcp";
}
if ($local_addr =~ s%^([\d\.]+):%%) {
  $local_ip = $1;
} else {
  $local_ip = "0.0.0.0";
}
if ($local_addr =~ m%^(\d+)$%) {
  $local_port = $1;
} else {
  die "Invalid local port [$local_addr]\n";
}
if ($remote_addr =~ s%:(\d+)$%%) {
  $remote_port = $1;
} else {
  $remote_port = $local_port;
}
if ($remote_addr =~ m%^([\d\.]+)$%) {
  $remote_ip = $1;
} else {
  die "Invalid remote ip [$remote_addr]\n";
}

print STDERR "Forwarding $proto packets from $local_ip:$local_port to $remote_ip:$remote_port\n";

# Get ready to receive an incoming connection
my $listen = new IO::Socket::INET
  LocalAddr => $local_ip,
  LocalPort => $local_port,
  Proto     => $proto,
  ReuseAddr => 1,
  $proto eq "tcp"?(Listen => 10):(),
  or die "Could not bind local port $local_port/$proto: $!";

# Just test the remote connection once.
my $remote_connect = new IO::Socket::INET
  PeerAddr => $remote_ip,
  PeerPort => $remote_port,
  Proto    => $proto,
  or die "Could not connect to remote $remote_ip:$remote_port/$proto: $!";

if ($proto eq "tcp") {
  # Close the test tcp socket
  $remote_connect->close;
} elsif ($proto eq "udp") {
  # Keep this around for udp replies
} else {
  die "Unimplemented protocol $proto\n";
}

if ($pidfile) {
  if (my $pid = fork) {