#!/usr/bin/perl
# Time-stamp: "2005-08-19 01:17:45 ADT"
#
# desc{    black-hole proxy server    }    sburke@cpan.org
#

use strict;
use IO::Socket qw(:DEFAULT :crlf);
use constant MY_PORT => 9123;
use constant DEBUG => 0;

my $image_type = 'image/gif';
my $image = "$ENV{'HOME'}/public_html/null.gif";

{
    if(open(IN, "<$image")) {
	binmode(IN);
	local $/;
	$image = join '',
	  "HTTP/1.0 200 OK", CRLF,
	  "Content-Type: ", $image_type, CRLF, CRLF,
	  <IN>;
	close(IN);
    } else {
        # Default image:
	$image = join '',
	  "HTTP/1.0 200 OK", CRLF,
	  "Content-Type: ", $image_type, CRLF, CRLF,
	  # 8x8 image: box with a border.
          "\x47\x49\x46\x38\x37\x61\x08\x00\x08\x00\xb3",
          "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
          "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
          "\x40\x40\x40", # Inside box color
          "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
          "\x00\x00\x00\x00\x00\x00\x00\x00\x00",
          "\x00\x00\x00", # Outside border color
          # Actual gif data:
          "\x2c\x00\x00\x00\x00\x08\x00\x08\x00\x00\x04\x0e\xf0\xc9\x49",
          "\xeb\x3c\xf8\xd0\xac\x6f\xde\x9f\x25\x52\x11\x00\x3b",
        ;
    }
}
#-----------------------------------------------------------------------------

my $quit = 0;
$SIG{'INT'} = sub {$quit = 1};

my $sock = IO::Socket::INET->new(
  Listen => 20,        LocalPort => shift(@ARGV)|| MY_PORT,
  Timeout => 60 * 60,  Reuse => 1,
) or die "Can't create listening socket: $!\n";

DEBUG and warn "Waiting for connections...\n";

my($session, $peer, $port);
while(!$quit) {
  next unless my $session = $sock->accept;
  if(DEBUG) {
    $peer = gethostbyaddr($session->peeraddr, AF_INET)
     || $session->peerhost;
    $port = $session->peerport;
    warn "Connection from [$peer,$port] at ", scalar(localtime), "\n";
  }

  #select($session);
  #++$|;
  #select(STDOUT);
  
  print $session $image;
  close($session);
  DEBUG and print " (Closed)\n";
}

DEBUG and print STDERR "Byebye\n";
close($sock);
exit 0;