#!/usr/bin/perl
##################################################
# relay -- Mike Schilli, 2001 (m@perlmeister.com)
#
# relay localport relayhost relayport
##################################################
use warnings;
use strict;

use HTTP::Daemon;
use LWP::UserAgent;
use URI::URL;
use Pod::Usage;
use Getopt::Std;

my $VERSION = "1.0";
our $CVSVERSION = '$Revision: 1.4 $';

getopts('h', \my %opts);

pod2usage(-verbose => 2) if $opts{h};

my($localport, $relayhost, $relayport) = @ARGV;

usage("Wrong argument count") if not defined $relayport;
usage("Port needs to be a number") if 
    $localport !~ /^\d+$/ or
    $relayport !~ /^\d+$/;

# If Browser disconnects suddenly
$SIG{PIPE} = 'IGNORE';

my $srv = HTTP::Daemon->new( LocalPort => $localport, Reuse => 1 );
die "Can't start server ($@)" unless defined $srv;
print "Server listening at port $localport\n";

my $ua = LWP::UserAgent->new;

while (my $conn = $srv->accept) {
    while (my $request = $conn->get_request) {
        my $uri = URI::URL->new($request->uri());
        $uri->host($relayhost);
        $uri->port($relayport);
        $request->uri($uri);
        $ua->agent($request->header("User-Agent"));
        my $resp = $ua->simple_request($request);
        $conn->send_response($resp);
    }
    $conn->close;
}

##################################################
sub usage {
##################################################
    my ($message) = @_;

    use File::Basename;
    my $base = basename($0);
    print "$base: $message\n";
    pod2usage();
    exit 1;
}

__END__

=head1 NAME

    relay - Start a relaying HTTP server, forwarding requests

=head1 DOWNLOAD

_SRC_HERE_

=head1 SYNOPSIS

    relay localport relayhost relayport

    localport: Port for the relay server to listen on
    relayhost: Host to forward requests to
    releayport: Port to forward requests to

=head1 DESCRIPTION

This relay server is a proxy, listening to a port on the local
host and forwarding all incoming requests to a different host
on a different port. This is useful for simulating a server
running under a different domain that it's actually running on.
It's also called "Poor man's DNS entry", because you can use this
without waking up the sysadm dogs and ask them to create a DNS
CNAME for you.

=head1 EXAMPLES

To start a relay server on the local host, listening to port 8000 and
forwarding requests to www.other.com:80, use this:

    relay 8000 www.other.com 80

This way, if you go to http://localhost:8000 with a browser, it'll
effectively to http://www.other.com. Be aware that there's no 
redirection going on -- you browser will still display
http://localhost:8000, while you're operating on http://www.other.com.

=head1 LEGALESE

Copyright 2002 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2001, Mike Schilli <m@perlmeister.com>