Полезная информация

Perl Cookbook

Perl CookbookSearch this book
Previous: 17.17. Program: backsniffChapter 17
Next: 18. Internet Services

17.18. Program: fwdport

Imagine that you're nestled deep inside a protective firewall. Somewhere in the outside world is a server that you'd like access to, but only processes on the firewall can reach it. You don't want to login to the firewall machine each time to access that service.

For example, this might arise if your company's ISP provides a news-reading service that seems to come from your main firewall machine, but rejects any NNTP connections from any other address. As the administrator of the firewall, you don't want dozens of people logging on to it, but you would like to let them read and post news from their own workstations.

The program in Example 17.8, fwdport, solves this problem in a generic fashion. You may run as many of these as you like, one per outside service. Sitting on the firewall, it can talk to both worlds. When someone wants to access the outside service, they contact this proxy, which connects on their behalf to the external service. To that outside service, the connection is coming from your firewall, so it lets it in. Then your proxy forks off twin processes, one only reading data from the external server and writing that data back to the internal client, the other only reading data from the internal client and writing that data back to the external server.

For example, you might invoke it this way:

% fwdport -s nntp -l fw.oursite.com -r news.bigorg.com

That means that the program will act as the server for the NNTP service, listening for local connections on the NNTP port on the host fw.oursite.com. When one comes in, it contacts news.bigorg.com (on the same port), and then ferries data between the remote server and local client.

Here's another example:

% fwdport -l myname:9191 -r news.bigorg.com:nntp

This time we listen for local connections on port 9191 of the host myname, and patch those connecting clients to the remote server news.bigorg.com on its NNTP port.

In a way, fwdport acts as both a server and a client. It's a server from the perspective of inside the firewall and a client from the perspective of the remote server outside. The program summarizes this chapter well because it demonstrates just about everything we've covered here. It has server activity, client activity, collecting of zombie children, forking and process management, plus much more thrown in.

Example 17.8: fwdport

#!/usr/bin/perl -w
# fwdport -- act as proxy forwarder for dedicated services

use strict;                 # require declarations
use Getopt::Long;           # for option processing
use Net::hostent;           # by-name interface for host info
use IO::Socket;             # for creating server and client sockets
use POSIX ":sys_wait_h";    # for reaping our dead children

my (
    %Children,              # hash of outstanding child processes
    $REMOTE,                # whom we connect to on the outside
    $LOCAL,                 # where we listen to on the inside
    $SERVICE,               # our service name or port number
    $proxy_server,          # the socket we accept() from
    $ME,                    # basename of this program

($ME = $0) =~ s,.*/,,;      # retain just basename of script name

check_args();               # processing switches
start_proxy();              # launch our own server
service_clients();          # wait for incoming
die "NOT REACHED";          # you can't get here from there

# process command line switches using the extended
# version of the getopts library.
sub check_args { 
        "remote=s"    => \$REMOTE,
        "local=s"     => \$LOCAL,
        "service=s"   => \$SERVICE,
    ) or die <<EOUSAGE;
    usage: $0 [ --remote host ] [ --local interface ] [ --service service ]   
    die "Need remote"                   unless $REMOTE;
    die "Need local or service"         unless $LOCAL || $SERVICE;

# begin our server 
sub start_proxy {
    my @proxy_server_config = (
      Proto     => 'tcp',
      Reuse     => 1,
      Listen    => SOMAXCONN,
    push @proxy_server_config, LocalPort => $SERVICE if $SERVICE;
    push @proxy_server_config, LocalAddr => $LOCAL   if $LOCAL;
    $proxy_server = IO::Socket::INET->new(@proxy_server_config)
                    or die "can't create proxy server: $@";
    print "[Proxy server on ", ($LOCAL || $SERVICE), " initialized.]\n";

sub service_clients { 
    my (
        $local_client,              # someone internal wanting out
        $lc_info,                   # local client's name/port information
        $remote_server,             # the socket for escaping out
        @rs_config,                 # temp array for remote socket options
        $rs_info,                   # remote server's name/port information
        $kidpid,                    # spawned child for each connection

    $SIG{CHLD} = \&REAPER;          # harvest the moribund


    # an accepted connection here means someone inside wants out
    while ($local_client = $proxy_server->accept()) {
        $lc_info = peerinfo($local_client);
        set_state("servicing local $lc_info");
        printf "[Connect from $lc_info]\n";

        @rs_config = (
            Proto     => 'tcp',
            PeerAddr  => $REMOTE,
        push(@rs_config, PeerPort => $SERVICE) if $SERVICE;

        print "[Connecting to $REMOTE...";
        set_state("connecting to $REMOTE");                 # see below
        $remote_server = IO::Socket::INET->new(@rs_config)
                         or die "remote server: $@";
        print "done]\n";

        $rs_info = peerinfo($remote_server);
        set_state("connected to $rs_info");

        $kidpid = fork();
        die "Cannot fork" unless defined $kidpid;
        if ($kidpid) {
            $Children{$kidpid} = time();            # remember his start time
            close $remote_server;                   # no use to master
            close $local_client;                    # likewise
            next;                                   # go get another client

        # at this point, we are the forked child process dedicated
        # to the incoming client.  but we want a twin to make i/o
        # easier.

        close $proxy_server;                        # no use to slave

        $kidpid = fork(); 
        die "Cannot fork" unless defined $kidpid;

        # now each twin sits around and ferries lines of data.
        # see how simple the algorithm is when you can have
        # multiple threads of control?

        # this is the fork's parent, the master's child
        if ($kidpid) {              
            set_state("$rs_info --> $lc_info");
            select($local_client); $| = 1;
            print while <$remote_server>;
            kill('TERM', $kidpid);      # kill my twin cause we're done
        # this is the fork's child, the master's grandchild
        else {                      
            set_state("$rs_info <-- $lc_info");
            select($remote_server); $| = 1;
            print while <$local_client>;
            kill('TERM', getppid());    # kill my twin cause we're done
        exit;                           # whoever's still alive bites it
    } continue {

# helper function to produce a nice string in the form HOST:PORT
sub peerinfo {
    my $sock = shift;
    my $hostinfo = gethostbyaddr($sock->peeraddr);
    return sprintf("%s:%s", 
                    $hostinfo->name || $sock->peerhost, 

# reset our $0, which on some systems make "ps" report
# something interesting: the string we set $0 to!
sub set_state { $0 = "$ME [@_]" } 

# helper function to call set_state
sub accepting {
    set_state("accepting proxy for " . ($REMOTE || $SERVICE));

# somebody just died.  keep harvesting the dead until 
# we run out of them.  check how long they ran.
sub REAPER { 
    my $child;
    my $start;
    while (($child = waitpid(-1,WNOHANG)) > 0) {
        if ($start = $Children{$child}) {
            my $runtime = time() - $start;
            printf "Child $child ran %dm%ss\n", 
                $runtime / 60, $runtime % 60;
            delete $Children{$child};
        } else {
            print "Bizarre kid $child exited $?\n";
    # If I had to choose between System V and 4.2, I'd resign. --Peter Honeyman
    $SIG{CHLD} = \&REAPER; 

See Also

Getopt::Long (3), Net::hostent (3), IO::Socket (3), POSIX (3), Recipe 16.19, Recipe 17.10

Previous: 17.17. Program: backsniffPerl CookbookNext: 18. Internet Services
17.17. Program: backsniffBook Index18. Internet Services