#!/usr/bin/perl -w
#-d:DProf
#
# Copyright (C) 2000, 2001 Bob McElrath.
# See the file COPYING for redistribution and modification terms.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

package FilterProxy;
use vars qw($HOME $VERSION $CONFIG @MODULES $HOSTNAME $LISTEN_PORT $agent $client);

# Do some things to make Taint happy:
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};   # Make %ENV safer
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';# Set a reasonable path

# Place configuration here

my($NAME, $CONFIG_FILE);
BEGIN {
  chomp($HOSTNAME  = `hostname`);                  # change this for multi-homed hosts.
  $LISTEN_PORT     = 8888;                         # Is also a command-line option
  $VERSION         = "0.30";
  $NAME            = "FilterProxy \$Revision: 0.35 $VERSION \$";
  chomp($HOME      = "/usr/share/filterproxy");                       # change if necessary (needs absolute paths)
  if($HOME =~ m{([-_A-Za-z0-9./]+)}) {             # untaint $HOME
    $HOME = $1;
  }
  $CONFIG_FILE     = $ENV{FILTERPROXYCONF} || $HOME . "/FilterProxy.conf";  # should be an option
  push(@INC, $HOME . "/FilterProxy");              # add my home to perl's include path list
  use lib ".";                                     # Only this works with taint on...
}

# End configuration.  You shouldn't have to change anything below this line.
#=============================================================================#
# FIXME Uploaded data (forms) broken for large/streaming uploads (who cares?)
# FIXME Large compressable content will be downloaded in its entireity first -- possible
#       client timeout.  Should compress as a stream while feeding to client.

use strict;
no strict 'subs';
no strict 'refs';
use POSIX qw(:sys_wait_h :signal_h setsid setpgid setuid setgid); # part of perl
use sigtrap qw(stack-trace error-signals);
use Carp qw(cluck croak confess);                   # part of perl
use Config;                                         # part of perl
use File::stat;                                     # part of perl
use CGI;                                            # part of perl
use Getopt::Std;                                    # part of perl
use Data::Dumper;                                   # part of perl
$Data::Dumper::Indent = 1;
use HTTP::Daemon;                                   # in Bundle::LWP (libwww)
use HTTP::Status;                                   # in Bundle::LWP (perl-libwww-perl rpm)
use URI::Escape;                                    # URI module     (perl-URI)
use LWP::UserAgent;                                 # in Bundle::LWP
use LWP::MediaTypes;                                # in Bundle::LWP
#use LWP::Debug qw(+debug +trace +conns);
use Time::HiRes;                                    # grab this from CPAN
use HTML::Mason;                                    # grab this from CPAN

# Configuration saved to config file (This is only in case this info isn't
# already in the config file!)  Don't change this!  The config file overrides it!
$CONFIG = {};
$CONFIG->{filtering} = 1;    # on/off switch for the filter
$CONFIG->{info} = 1;         # log informational messages
$CONFIG->{timing} = 0;       # log timing information (how long it takes to run filters)
$CONFIG->{debug} = 0;        # log debugging messages
$CONFIG->{authenable} = 0;   # enable authentication of users by password
$CONFIG->{localhostonly} = 0;# accept connections from localhost only
$CONFIG->{logfile} = "/var/log/filterproxy/filterproxy.log";  # set to "" to disable logfile
$CONFIG->{timeout} = 300;    # wait 5 minutes before giving up on outgoing connections.
$CONFIG->{filters} = {};
$CONFIG->{http_proxy} = "";
$CONFIG->{http_proxy_username} = "";
$CONFIG->{http_proxy_password} = "";

# File scoped variables
my(%children) = ();     # keys are pids of my children
# $client;            # connection to the client
my($inreq);             # incoming request -- needs to be accessable to data_handler
my($clientprotocol);    # protocol client is using (0.9, 1.0, 1.01, 1.1)
my($send_response);     # We're going to grab the whole file, as opposed to passing it through in pieces.
my($data_handler_called);# boolean if data_handler was called for a particular response
my($received) = 0;      # bytes received
my($last_required) = 0; # cause main loop to read config first time around.
my(@filterable);        # list of mime-types that some filter can filter.
my($CRLF) = "\015\012"; # Terminates header.

# Subroutine prototypes:
sub logger;
sub read_config;
sub write_config;
sub daemonize;        # daemonizes me.
sub handler;          # Handles all incoming requests
sub data_handler;     # Callback when data is received
sub handle_proxy;     # Handles proxy requests
sub handle_filtering; # Takes care of filtering
sub handle_server;    # Handles normal file requests

# Process options
my(%options);
getopts('nhkf:p:', \%options);
if($options{'k'}) {  # kill running FilterProxy.
  print "Please use '/etc/init.d/filterproxy stop'";
  exit(0);
}
if($options{'f'}) {
  $CONFIG_FILE = $options{'f'};
}
if($options{'p'}) {
  $LISTEN_PORT = $options{'p'};
}
if($options{'h'} || $ARGV[0]) { # print usage
  print <<END_USAGE;
    Options recognized by FilterProxy:
      -h          Print this help message
      -f <file>   Specify an alternate config file 
                    (default is $CONFIG_FILE)
      -p <port>   Specify the port to which FilterProxy will bind 
                    (default is $LISTEN_PORT)
      -n          Do not daemonize: stay connected to the terminal from which
                    it was started and print debugging messages.
END_USAGE
  exit(1);
}

# Read in config file
require $CONFIG_FILE;

# Load FilterProxy modules
my($file);
foreach $file (<$HOME/FilterProxy/*>) {
    next unless($file =~ s/.*\/([^\/]+)\.pm/$1/);
    if($CONFIG->{debug}) {
        eval "use $file;";
    } else {
        local $SIG{'__DIE__'} = sub{};  # Supress warnings, errors (catch them in $@ below.
        local $SIG{'__WARN__'} = sub{};
        eval "use $file;";
    }
    if(!$@) {
        print "Loaded module: " . $MODULES[$#MODULES] . "\n"; # Assume modules behave and add themselves
    } else {                                                  # at the end of the list.
        @_ = split("\n", $@);
        $_ = join("\n\t", @_); # indent the error messages.
        print "Module $file not loaded because: \n\t$_";
    }
}

if(!grep(/Header/, @MODULES) || !(defined $FilterProxy::Header::CONFIG)) {
    die "ERROR: Header module is missing ($HOME/FilterProxy/Header.pm).  \n\t"
      . "FilterProxy is unable to function without it.\n";
}

# Open log file
if($CONFIG->{logfile} !~ /^\//) {
  $CONFIG->{logfile} = $HOME . "/" . $CONFIG->{logfile};
}
open(LOGFILE, ">>" . $CONFIG->{logfile}) || die "unable to open logfile ", $CONFIG->{logfile}, ".\n";
autoflush LOGFILE 1;

# Initialize the daemon.
if($CONFIG->{localhostonly}) { $HOSTNAME = "localhost"; }
my $daemon = new HTTP::Daemon LocalAddr => $HOSTNAME, LocalPort => $LISTEN_PORT,
                              Reuse     =>  1, Listen => 40
   or croak "HTTP::Daemon failed to initialize: $!\n"
      . "Is $HOSTNAME:$LISTEN_PORT correct?";

# Initialize agent.
my($env_proxy) = 0; # determine if we should read proxy environment variables
if(defined $ENV{http_proxy} && $ENV{http_proxy} =~ /http:\/\/.*$HOSTNAME\:$LISTEN_PORT/) { 
    $env_proxy = 0; 
} else { $env_proxy = 1; }

$agent  =   new LWP::UserAgent(
                agent => undef, # "FilterProxy $VERSION" Preserve the request's User-Agent header.
                timeout => $CONFIG->{timeout},
                protocols_allowed => ['http','https','ftp'],
                protocols_forbidden => ['file','mailto'],
                requests_redirectable => [], # We want to pass all redirects back to browser.
                parse_head => 0,             # don't parse the <head> section of HTML documents
                env_proxy => $env_proxy,     # we will override env var http_proxy with CONFIG below
                keep_alive => 10,            # keep a connection cache with 10 hosts.
            );
if($CONFIG->{http_proxy}) { 
    $agent->proxy('http', $CONFIG->{http_proxy}); 
}
$agent->no_proxy('localhost',`hostname`); # FIXME will this fix fork-bomb?

# Initialize HTML::Mason
my($interp) = new HTML::Mason::Interp(comp_root => "$HOME/html",
                                      data_dir => "$HOME/Mason", code_cache_max_size => 1024*1024);
my($compiler) = $interp->compiler;
$compiler->allow_globals('$MODULECONFIG', '$SITECONFIG', '$SITE', 
    '$VERSION', '$MESSAGE', '$MODULES', '$AUTH_TYPE', '$CONTENT_LENGTH', '$CONTENT_TYPE', 
    '$GATEWAY_INTERFACE', '$PATH_TRANSLATED', '$PATH_INFO', '$PATH_TRANSLATED', '$QUERY_STRING', 
    '$REMOTE_PORT', '$REMOTE_ADDR', '$REMOTE_HOST', '$REMOTE_ADDR',
    '$REMOTE_USER', '$REQUEST_METHOD', '$SCRIPT_NAME', '$SERVER_NAME', '$SERVER_PORT', 
    '$SERVER_PROTOCOL', '$SERVER_SOFTWARE', '$CGI', '$r', '$CONFIG'); 
# CGI parameters.  (FIXME there are more: HTTP headers)

# perhaps unnecessary, but helpful...
if($CONFIG->{'first_time'}) {
  print "Now go to http://$HOSTNAME:$LISTEN_PORT/ to configure me!\n";
  $CONFIG->{first_time} = 0;
  &write_config;
} else {
  warn "Proxy on ", $daemon->url, " initialized\n";
}

# disassociate from controlling tty, etc, etc.
if(!$options{'n'}) {
  &daemonize; 
} else {
  STDOUT->autoflush(1); # autoflush stdout
  STDERR->autoflush(1); # autoflush stderr
  $0 = "FilterProxy";
#  if(open(PIDFILE, ">/var/run/filterproxy/filterproxy.pid")) {
#    print PIDFILE $$;
#    close(PIDFILE);
#  } else {
#    logger(ERROR, "Unable to open pid file! ($!)\n"); # so I can kill myself easily
#  }
}

# Make deaths give line numbers, and wait for children 
sub prefix {
    my $now = localtime;
    join "", map { "[$$ $now] $_\n" } split /\n/, join "", @_;
}
$SIG{__WARN__} = sub { logger PERL, "[Perl WARNING] ", @_; cluck prefix @_; };
$SIG{__DIE__} = sub { die @_ if $^S; logger PERL, "[Perl ERROR] ", @_; confess prefix @_; };

# Zombies are bad.
sub REAPER {
  my($child);
  while ($child = waitpid(-1, &WNOHANG)) {
    if(defined $child && defined $children{$child}) {
      delete $children{$child};
    }
  }
#  unless(defined $child) {
#    logger(ERROR, "\$child=$child or \$children{\$child}=$children{$child} is undef in SIGCHLD handler!\n");
#  }
  if($SIG{"CHLD"} != \&REAPER) {
    $SIG{"CHLD"} = \&REAPER;  # still loathe sysV
  }
  if($child == -1) {
    logger(DEBUG, "REAPER: Error in waitpid, $!\n");
  }
}

sub HUNTSMAN {                      # signal handler for SIGINT
  local($SIG{"CHLD"}) = 'IGNORE';   # we're going to kill our children
  if(keys %children) {
    kill 'INT' => keys %children;
  }
#  open(PIDFILE, ">/var/run/filterproxy/filterproxy.pid");
#  print PIDFILE "";
#  close(PIDFILE);
  logger(INFO, "Received signal SIGINT/SIGTERM/QUIT, exiting...");
  exit;                           # clean up with dignity
}

#$SIG {"CHLD"} = \&REAPER;  # TODO This is disabled because signal handling in perl is not
#                             re-entrant, so many children exiting in a short period of
#                             time causes a SEGV in &REAPER.  If perl's signal handling
#                             gets better, I will re-enable it.
$SIG {"INT"} = \&HUNTSMAN;
$SIG {"QUIT"} = \&HUNTSMAN;
$SIG {"HUP"} = \&read_config; # force config file reload (shouldn't ever be needed)
$SIG {"TERM"} = \&HUNTSMAN;
$SIG {"PIPE"} = 'IGNORE';
$SIG {"USR1"} = sub {
  logger(DEBUG, "Rugrats follow: \n");
  logger(DEBUG, "\tPID\thost\n");
  foreach my $child (keys %children) {
    my($key, $value);
    $key = defined $child?$child:"undef!";
    $value = defined $children{$child}?$children{$child}:"undef!";
    logger(DEBUG, "\t$key\t$value\n");
  }
};

print LOGFILE "\n\n[#######] FilterProxy started (pid $$). [#######]\n";
# And loop forever.
while (my $client = $daemon -> accept) {
  &read_config;
# Check on da kiddies
  while ((my $child = waitpid (-1, &WNOHANG)) > 0) { 
    if(defined $child && defined $children{$child}) {
      logger(DEBUG, "Deleting child: $child, from $children{$child}\n");
      delete $children{$child};
    } else {
      logger(DEBUG, "Child died that I don't own? (pid $child)\n");
    }
  }
  foreach my $child (keys %children) { # should find dead children that have not been reaped.
    unless(kill 0 => $child) {
      logger(DEBUG, "Child died unexpectedly: pid $child connected to $children{$child}.\n");
      delete $children{$child}; # clean up after dead children
    }
  }
  if(!defined $client) { logger(ERROR, "Client died because: ", $daemon->reason); next; }
  else { 
    my($peername) = getpeername($client);
    if(!defined $peername) { 
        logger(WARNING, "getpeername returned an error");
        logger(WARNING, "\$client is " . (defined $client->connected)?("connected to " . $client->connected):"not connected");
        next;
    }
    my($port, $iaddr, $name);
    ($port, $iaddr) = sockaddr_in($peername);
    $name = gethostbyaddr($iaddr, AF_INET);
    $name = inet_ntoa($iaddr) unless defined($name);
    defined(my $pid = fork) or die "Exiting: Can't fork: $!";
    if($pid) { # I am parent
      $children{$pid} = "$name:$port";
      undef($client);
    } else { # I am child
      $SIG{"INT"} = 'DEFAULT';
#      $SIG{"CHLD"} = 'IGNORE';
      $SIG{"QUIT"} = 'DEFAULT';
      $SIG{"TERM"} = 'DEFAULT';
      $client->autoflush(1);
      $0 = "FilterProxy ($name:$port)";
      handler $client;                   # doesn't return, exits when done.
    }
  }
}

logger(ERROR, "Exiting outside main loop (BUG!)\n");
# That's all folks.
exit 0;

# Blatently ripped from http://www.webreference.com/perl/tutorial/9/3.html, also part of ther perlipc man page...
sub daemonize {
  chdir '/'                  or die "Can't chdir to /: $!";
  defined(my $pid = fork)    or die "Can't fork: $!";
  exit if $pid;
  $0 = "FilterProxy";
  setsid                     or die "Can't start a new session: $!";
  setpgrp;           # make myself group leader (so children die when I die)
  open STDIN, '/dev/null'    or die "Can't read /dev/null: $!";
  open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
  open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
  umask 0;
#  if(open(PIDFILE, ">/var/run/filterproxy/filterproxy.pid")) {
#    print PIDFILE $$;
#    close(PIDFILE);
#  } else {
#    logger(ERROR, "Unable to open pid file! ($!)\n"); # so I can kill myself easily
#  }
}

sub logger {
  my($level) = shift;
  if($level eq DEBUG)  { return unless $CONFIG->{debug}; }
  elsif($level eq TIMING) { return unless $CONFIG->{timing}; }
  elsif($level eq INFO)   { return unless $CONFIG->{info}; }
  elsif($level eq ERROR)  { @_ = ("[ERROR] ", @_); }
  elsif($level eq PERL)   { } # something from perl, (warn/die) must print it.
  if($_[$#_] !~ /\n$/) { push @_, "\n"; }
  my $now = localtime;
  if(defined LOGFILE) {
    print LOGFILE "[$$ $now] ", @_;
  }
  print "[$$ $now] ", @_; # doesn't work when daemonized, cuz STDOUT -> /dev/null
}

sub read_config {
  # Reconfigure if the config file changed.
  my $mod = (stat $CONFIG_FILE)->mtime || 0;
  if ($mod > $last_required) {
    delete $INC {$CONFIG_FILE}; # tell perl we haven't already require'd it.
    eval { require $CONFIG_FILE; };
    if($@) {
      logger(ERROR, "Syntax error in config file.  FIX IT!\n");
      return;
    } else {
      require $CONFIG_FILE;
    }
    $last_required = $mod;
    my($module); # make a list of mime-types that some filter can filter.
    @filterable = ();
    foreach $module (@MODULES) {
      unless(defined $module) { logger(DEBUG, "module undefined"); }
      unless(defined ${"FilterProxy::" . $module . "::CONFIG"}) { 
        logger(DEBUG, "\$FilterProxy::", $module, "::CONFIG undefined"); 
      }
      unless(defined ${"FilterProxy::" . $module . "::CONFIG"}->{mime_types}) { 
        logger(DEBUG, "\$FilterProxy::", $module, "::CONFIG->mime_types undefined"); 
      }
      push @filterable, @{${"FilterProxy::" . $module . "::CONFIG"}->{mime_types}};
      my(%filterable); # uniqueify list.
      foreach my $mime_type (@filterable) { 
        if($mime_type) { $filterable{$mime_type} = 1; } # ignore blank mime_type (i.e. header)
      }
      @filterable = sort keys %filterable;
    }
  }
}

sub write_config {
  my($config, $module);
  open(CONF, ">$CONFIG_FILE") || die "unable to open config file.\n";
  print CONF "# FilterProxy Configuration file.\n";
  print CONF "#\n";
  print CONF "# Be aware that FilterProxy will automatically rewrite this file.\n";
  print CONF "# It will also automatically reload this file if it detects that it\n";
  print CONF "# has been modified, so there is no need to kill FilterProxy when\n";
  print CONF "# editing by hand.\n";
  print CONF "#\n";
  print CONF "# This is a normal perl file, and will be eval'ed by FilterProxy\n";
  print CONF "# to load it's configuration.  I recommend that initially, you use\n";
  print CONF "# the forms interface to add stuff, and then look at this file to\n";
  print CONF "# see its structure.\n";

  foreach $module ("FilterProxy", map("FilterProxy::" . $_, @MODULES)) {
    $config = $module . "::CONFIG";
    print CONF "\n" . Data::Dumper->Dump([$$config], ["$config"]);
  }
  print CONF "1;\n";
  close CONF;
}

sub do_authentication {
  my($inreq, $client) = @_;
  return (do_host_authentication($inreq, $client) && # host first so we don't ask for a password
      do_password_authentication($inreq, $client));  # when localhostonly is enabled.
}

sub do_host_authentication  {
  my($inreq, $client) = @_;

  return 1 unless $CONFIG->{localhostonly};

  logger(DEBUG, "do_host_authentication: " .
       $client->peerhost() . " connecting to ".
       $client->sockhost());

  if ($client->peerhost() eq $client->sockhost())  {
      return 1;
  } else {
      logger(INFO, "Failed host authentication from " .
           $client->peerhost());
      $client->send_error(RC_FORBIDDEN);
      return 0;
  }
}

# FIXME This function sucks.  Let handle_server serve files.  But that requires
# handle_server to be rewritten.  :(
sub do_password_authentication {    
  my($req, $client) = @_;
  my($message, $content) = ("", "");
  my($user, $password);

  return 1 unless $CONFIG->{authenable};

  eval {
    my $authorization;
    if ($req->authorization && $req->header('Host') =~ /([^:]+)(:([0-9]+))?/
        && defined((gethostbyname($1))[1]) && defined((gethostbyname($HOSTNAME))[1])
            && (gethostbyname($1))[1] eq (gethostbyname($HOSTNAME))[1] 
            && ((defined $2)?$3:80) == $LISTEN_PORT) {
      $authorization = $req->authorization;
    } elsif($req->proxy_authorization) {
      $authorization = $req->proxy_authorization;
    } else {
      die ($message="Need authorization");
    }
    die ($message="Unknown authorization method") unless($authorization =~ /Basic ([A-Za-z0-9]+)/);
    $_ = $1;
    tr#A-Za-z0-9+/##cd;                   # remove non-base64 chars
    tr#A-Za-z0-9+/# -_#;                  # convert to uuencoded format
    my $len = pack("c", 32 + 0.75*length);   # compute length byte
    ($user, $password) = split(/:/, unpack("u", $len . $_));
    die ($message="Authentication failed (unknown user: '$user')") unless(defined $CONFIG->{users}->{$user});
    die ($message="Authentication failed (bad password)") unless($CONFIG->{users}->{$user} eq $password);
    logger(DEBUG, "Authentication for user $user accepted.\n");
  };
  if($@) {
    my($res); 
    if($req->uri =~ /^\//) { # browser is not configured to use proxy
      logger(DEBUG, "Sending WWW Authorization response beause $message\n");
      $res = new HTTP::Response(401, "FilterProxy Authorization Required");
      $res->header('WWW-Authenticate' => 'BASIC realm="FilterProxy"');
    } else {
      logger(DEBUG, "Sending Proxy Authorization response beause $message\n");
      $res = new HTTP::Response(407, "FilterProxy Authorization Required");
      $res->header('Proxy-Authenticate' => 'BASIC realm="FilterProxy"');
    }
    local(*FILE);
    my($stat) = stat "$HOME/html/Auth.html";
    my($size) = $stat->size;
    sysopen(FILE, "$HOME/html/Auth.html", 0);
    read FILE, $content, $size;
    close(FILE);
    $content =~ s/##MSG##/$message/; # this is bad find a way to use handle_server
    $res->content($content);
    $res->header('Content-Type' => "text/html");
    &handle_filtering($inreq, $res, 10); # Shouldn't depend on presence of content.
    $res->header("Connection" => "close");
    $res->remove_header("Keep-Alive");
    $client->send_status_line($res->code, $res->message);
    print $client $res->headers_as_string("$CRLF") . "$CRLF";
    if($clientprotocol == 1.1) {
      if(defined $res->content) {
        printf $client "%x%s%s%s", length $res->content, $CRLF, $res->content, $CRLF;
      }
      print $client "0$CRLF$CRLF";
    } else {
      if($clientprotocol == 1.0) { 
        $client->force_last_request;
      }
      print $client $res->content;
    }
    $client->force_last_request;
    return 0;
  }
  return 1; # success
}

sub handler {
  $client = shift;                      # connection to the client
  $received = 0;
  my($key,$val);
  my($requests) = 0;
  my($start, $end);
  my($port, $iaddr) = sockaddr_in(getpeername($client));
  my($name) = gethostbyaddr($iaddr, AF_INET);
  $name = inet_ntoa($iaddr) unless defined($name);
  $client->timeout(1800);               # If we don't see a request within 30 minutes, bail.
  logger(INFO, "New proxy connection accepted from $name:$port");
  while($client) {
    $inreq = $client->get_request(0);   # 1=only read headers. 0=read whole request (calls data_handler)
    if(!defined $inreq) { 
      logger(INFO, "Exiting for client $name:$port ($requests requests processed) {", $client->reason, "}\n");
      exit(0);
    }
    &read_config;
    # Determine which protocol the client is using
    if($client->proto_ge(1.1)) { 
      $clientprotocol = 1.1; 
    }
    elsif($client->proto_ge(1.0)) { 
      if($inreq->header("User-Agent") =~ /^Mozilla\/4/
        || (defined $inreq->header('Proxy-Connection') 
            && $inreq->header('Proxy-Connection') =~ /\bkeep-alive\b/i)) {
        $clientprotocol = 1.01;
        # This is a hack for Netscape's Proxy-Connection headers (HTTP::Daemon doesn't recognize them)
        ${*$client}{'httpd_nomore'} = 0;
      } else {
        $clientprotocol = 1.0;
      }
    }
    elsif($client->proto_ge(0.9)) { 
      $clientprotocol = 0.9; 
    }
    next unless &do_authentication($inreq, $client);
    $start = Time::HiRes::time;
    $requests++;
# Baaad, baaaad boy.  But both FilterProxy.pl and Header modify some headers.  What to do?
    if($FilterProxy::Header::CONFIG->{dump_headers}) {
        logger(DEBUG, "  Got incoming header from client:\n", $inreq->headers_as_string);
    }
    # Server mode -- serve up configuration pages.
    if($inreq->header('host') =~ /([^:]+)(:([0-9]+))?/) {
        my($hostname) = $1;
        my($port) = (defined $2)?$3:80;
        if(defined((gethostbyname($hostname))[1]) && defined((gethostbyname($HOSTNAME))[1])
            && (gethostbyname($hostname))[1] eq (gethostbyname($HOSTNAME))[1] && $port == $LISTEN_PORT) {
            &handle_server($inreq, $client);
        } else {
            &handle_proxy($inreq, $client);
        }
    } else {
        &handle_proxy($inreq, $client);
    }
    $end = Time::HiRes::time;
    logger(TIMING, "Request took ", sprintf("%0.5f", $end-$start), " seconds total.\n");
  }
  # Last request, make sure read buffer is empty
  my($rdbuf) = $client->read_buffer;
  if(defined $rdbuf && length $rdbuf > 0) {
    logger(DEBUG, "Read buffer is not empty!  Contains: \n$rdbuf\n");
    $client->read_buffer(""); # empty the buffer
  }
}

sub data_handler { # this is only called on success.
  my($data, $res, $protocol) = @_;
  if(!defined $client->connected()) {
      logger(DEBUG, "Client aborted download");
      die("Client aborted download");  # Causes LWP to abort its download too.
  }
  if($received == 0) { # if this is the first data block, do headers
    if($inreq->method ne 'HEAD' && # no content for HEAD requests.
        (!defined $res->content_length || grep {$res->content_type =~ $_} @filterable)) {
      $send_response = 1;   # no content-length, server will close connection to signal end.
    } else { # unfilterable, stream content directly to client.
      $send_response = 0;
      &handle_filtering($inreq, $res, 10);       # Header manipulation, can't modify content.
      $client->send_status_line($res->code, $res->message);
      print $client $res->headers_as_string("$CRLF") . "$CRLF";
    }
    $data_handler_called = 1;
  }
  $received += length $data;
  if($send_response) { # will filter and send response in &handle_proxy
    $res->add_content($data);   # stow data, filter at end
  } else { # stream directly to client
    if($received > 0) {
      if($clientprotocol == 1.1) {
        printf $client "%x%s%s%s", length $data, $CRLF, $data, $CRLF;
      } else {
        print $client $data;
      }
    }
  }
  return "";
}

# Handle one proxy request.
sub handle_proxy {
  my($origreq) = shift;
  my($req) = $origreq->clone;
  $req->protocol($origreq->protocol());
  logger(INFO, $req->protocol() . " proxy request for ", $req->uri, " received.\n");

  &handle_filtering($inreq, $req, -10); # will modify $req
  # uploaded content
  if(defined $req->content_length && $req->content_length > 0) {
    &handle_filtering($inreq, $req, -9, -8, -7, -6, -5, -4, -3, -2, -1);
    $req->content_length(length ${$req->content_ref}); # Baaad.  Should be in Header.
  }
  $received = 0;
  $send_response = 0; # set by data_handler if it sends the response (unfilterable content)
  $data_handler_called = 0;
  logger(DEBUG, "Sending request for ", $req->uri, "\n");
  # Send the request.
  my $res = $agent->request($req, \&data_handler);
  chomp(my($mess) = $res->message); # Why is HTTP::Message giving me this with a newline in it?!?!?
  logger(INFO, "[", $res->code, " ", $mess, "] for ", $req->uri, 
      ($res->content||$res->code == 200)
        ?join("", " (", $res->content_type, " ", 
          ($res->content_length?$res->content_length:"unspecified"), " bytes)\n")
        :""
      );
  if((!defined $res->content_type || !$res->content_type) 
    && defined $res->content_ref && defined ${$res->content_ref} && length ${$res->content_ref} > 0) {
    logger(INFO, "Server sent content (length ", length ${$res->content_ref}, 
      ") but did not send the Content-Type header!  I can't filter this! (Server is misconfigured)\n");
    #    $res->header('Content-Type' => 'text/html');  # What would be better here?
  } 
  # data_handler never called.  If there is content, set $send_response
  if(!$res->is_success && defined $res->content_ref && length ${$res->content_ref} > 0) {
    $send_response = 1;
  }
  # determine if we should send a response (data_handler never called)
  unless($data_handler_called) {
    if($res->is_error) {
# FIXME
      if($mess =~ s/(\([^\)]*\))$//) { # Dump bogus error message from IO::Socket (always "(Timeout)")
          logger(DEBUG, "Stripping bogus error message from ", $res->code, " response: '$1'\n");
          logger(DEBUG, "    (Is this a perl 5.6 or libwww bug?)\n");
          $res->message($mess);  # Reset it so the new message ends up in the HTML error message.
      }
      unless(defined $res->content_ref && length ${$res->content_ref} > 0) {
        $res->content($res->error_as_HTML);
        $res->header("Content-Type" => "text/html");
      }
    } elsif($res->is_redirect) { # we have a redirect w/o content (nothing to do...)
      unless($res->code == 304) { # 304 is "Not Modified" (cache redirect)
        logger(DEBUG, "Redirect from ", $req->uri, " to ", $res->header("Location"), "\n");
      }
    } elsif(!$res->is_success) { # if is_success here, then content was not filtered.
      logger(DEBUG, "(Unhandled response!) What kind of response is [", $res->code, " ", $mess, "]\n");
      $client->force_last_request; # close connection to make sure the response is terminated.
    } else { # data_handler passed request and $send_response=0
      # SUCCESS, but no content, method is not HEAD, and content-type is set.  (HUH?)
      # Pass the client an empty response
      if($res->content_type && !$res->content_length) {
        logger(ERROR, "FOUND EMPTY RESPONSE!  (server is misconfigured)\n");
      }
      if(defined $res->content_length && $received ne $res->content_length) {
        logger(DEBUG, "haven't received whole file!: $received/", $res->content_length, "/", length $res->content);
      }
      $client->force_last_request; # close connection to make sure the response is terminated.
    }
    $send_response = 1;
  }
  # terminate the response
  if($send_response) {
    # Filter it.
#    $res->protocol($inreq->protocol()); # in Header.
    if(defined $res->content_type && length ${$res->content_ref} > 0
        && scalar(grep {$res->content_type =~ $_} @filterable) && $CONFIG->{filtering}
        && !$res->is_redirect) {
      &handle_filtering($inreq, $res, 1, 2, 3, 4, 5, 6, 7, 8, 9); # only 1-9 care about content.
    }
    &handle_filtering($inreq, $res, 10); # Shouldn't depend on presence of content.
    # Send it.  (we don't use HTTP::Daemon::send_response because it doesn't know about 
    #            Netscape 4's Proxy-Connection headers)
    $client->send_status_line($res->code, $mess, $res->protocol);
    print $client $res->headers_as_string("$CRLF") . "$CRLF";
    # FIXME This could be done better...Modules must be able to process in chunks though.
    if(defined $res->content_ref && ${$res->content_ref}) {
      if($clientprotocol == 1.1) {
        printf $client "%x%s%s%s", length ${$res->content_ref}, $CRLF, ${$res->content_ref}, $CRLF;
      } else {
        print $client ${$res->content_ref};
      }
      # note: exactly one chunk per file.
    }
  }
  # terminate the response
  if($res->code >= 200 && $res->code != 204              # codes that don't get a message-body
     && $res->code != 304 && $inreq->method ne 'HEAD') { # HEAD doesn't get a message-body
    if($clientprotocol == 1.1) {
      print $client "0$CRLF$CRLF";
    } else {
      if($clientprotocol == 1.01) { 
#        Nothing to do...netscape waits for the next request immediately following the file.
      } else { # client is 0.9 or 1.0 (non-netscape)
        $client->force_last_request;
      }
    }
  }
  undef($res); # kill the response and all its data.
}

sub handle_filtering {
  my($req) = shift;  # mostly to grab the URI, These two arguments are the same if @orders < 0
  my($res) = shift;  # This is what will be modified.  $req won't be touched.
  my(@orders) = @_;
  my(%filterconfig);
  my(%nofilters); # filters we *don't* want to apply (negatively selected)
  my($regexp, $filter, $nofilter, $mime_type);
  my($start, $stop);
  $start = Time::HiRes::time();
REGEXP: 
  foreach $regexp (keys(%{$CONFIG->{filters}})) {
    next REGEXP unless ($req->uri =~ $regexp);
FILTER:   
    foreach $filter (keys(%{$CONFIG->{filters}->{$regexp}})) {
      if($filter =~ /^-(.*)$/) {
        $nofilters{$1} = $regexp;
        next FILTER;
      }
      if(!grep(/$filter/, @MODULES)) {
          logger(ERROR, "Module $filter is in use but was not loaded!\n");
          next FILTER;
      }
      # bail unless this filter filters this content type, or we're filtering headers.
      next FILTER unless (scalar(grep {-10 eq $_ || 10 eq $_} @orders)
        || defined $res->content_type 
        && scalar(grep {$res->content_type =~ $_} @{${"FilterProxy::" . $filter . "::CONFIG"}->{mime_types}}));
      next FILTER unless defined &{"FilterProxy::" . $filter . "::filter"};
      # prepend the order here so that sort (below) will put things in order.
      my(@filterorders);
      if(ref(${"FilterProxy::" . $filter . "::CONFIG"}->{order}) eq "ARRAY") {
        @filterorders = @{${"FilterProxy::" . $filter . "::CONFIG"}->{order}};
      } elsif (!ref(${"FilterProxy::" . $filter . "::CONFIG"}->{order})) { 
        push @filterorders, ${"FilterProxy::" . $filter . "::CONFIG"}->{order};
      }
      foreach my $order (@filterorders) {
        if(scalar(grep {$order eq $_} @orders)) {
          push @{$filterconfig{$order . $filter}}, $CONFIG->{filters}->{$regexp}->{$filter};
          logger(DEBUG, "Going to apply filter $filter order $order for ", $req->uri, ", matching /$regexp/.\n");
        }
      }
    }
  }
  foreach $nofilter (keys %nofilters) {
    foreach $filter (keys %filterconfig) {
      if($filter =~ /^([-0-9]+)$nofilter$/) {
        logger(DEBUG, "Deleting filter $nofilter for order $1 matching $nofilters{$nofilter}\n");
        delete $filterconfig{$filter};
      }
    }
  }
  foreach $filter (sort {($a =~ /^-?([0-9]+)/)[0] <=> ($b =~ /^-?([0-9]+)/)[0]} keys %filterconfig) {
    my ($fstart, $fstop);
    my ($basefilter) = $filter;
    my ($order) = $filter;
    if($filter =~ /^([-0-9]+)(\w+)/) {
      $order = $1;
      $basefilter = $2;
    } else { logger("ERROR: What kind of filter is $filter?"); }
    
    unless(abs($order) eq 10) { $fstart = Time::HiRes::time(); }
    &{"FilterProxy::" . $basefilter . "::filter"}($req, $res, $filterconfig{$filter}, $order); 
    unless(abs($order) eq 10) { 
      $fstop = Time::HiRes::time();
      logger(TIMING, "  $basefilter took ", sprintf("%0.5f", $fstop-$fstart), " seconds.");
    }
  }
  $stop = Time::HiRes::time();
  logger(TIMING, "Filtering took ", sprintf("%0.5f", $stop-$start), " seconds total (orders: ", 
    join(',',@orders), ").\n");
}

sub handle_server {
  my($origreq, $client) = @_;
  my($req) = $origreq->clone;
  $req->protocol($origreq->protocol());  # Doesn't get copied?
  my($query, $query_string); # GET+POST parameters, and pure GET parameters.

  &handle_filtering($inreq, $req, -10); # Shouldn't depend on presence of content.
  if($req->uri =~ /.*?\?(.*)$/) { # join get-style parameters with post-style parameters.
    if($req->content) { $query = $req->content . "&$1"; }
    else { $query = $1; }
    $query_string=$1;
  } else {
    $query = $req->content_ref?$req->content:"";
  }
  logger(DEBUG, "Got ", $req->method, " request with parameters: ", $query);
  my($cgi) = new CGI($query);
  my($file);
  my($message) = "";
  my($module, $fullmodule, @mods);
  my($stat, $size, $mtime);
  my($SITECONFIG, $MODULECONFIG, $SITE);
  local(*FILE);
  my($res) = new HTTP::Response(RC_OK); # need no-cache
  $res->protocol($req->protocol());

  logger(INFO, "Serving request for ", $req->uri);
  $res->server("$HOSTNAME:$LISTEN_PORT");
  $res->date(time);
  if($req->uri =~ /(^http:\/\/[^\/]+)?\/(.*?)(\?.*)?$/i) {
    $file = "$2";
    if(-d "$HOME/html/$file") { # if $file is a directory, serve index.html, just like a regular web server
      $file .= "/index.html";
    }
    if(-f "$HOME/html/$file") {
      guess_media_type("$HOME/html/$file", $res); # sets content-type
      $stat = stat "$HOME/html/$file";
      ($size, $mtime) = ($stat->size, $stat->mtime);
      $res->last_modified($mtime) if $mtime;
      if($res->content_type =~ /text\/html/ || $req->uri =~ /\.html$/) { # pass the mofo through HTML::Mason
        if($file =~ /^([a-zA-Z]+)(\/|\.)?.*?\.html$/) { # put module html in its
            $module = $1;                               # own directory, with the name of the module
        } else {
          logger(DEBUG, "Unable to determine module for request!");
          undef $module;
        }
        if(defined $module) {
          my(@mods) = grep {/$module$/} (map("FilterProxy::" . $_, @MODULES), "FilterProxy");
          if($#mods == 0 && defined $mods[0]) {
            $fullmodule = $mods[0];
            $MODULECONFIG = ${$fullmodule . "::CONFIG"};
            if($module !~ /FilterProxy/ && $cgi->param('site') && 
                defined $CONFIG->{filters}->{$cgi->param('site')}) { 
              if(!defined $CONFIG->{filters}->{$cgi->param('site')}->{$module}) {
                $CONFIG->{filters}->{$cgi->param('site')}->{$module} = {}; 
              }
              print "Using siteconfig for site " . $cgi->param('site') . "\n";
              $SITECONFIG = $CONFIG->{filters}->{$cgi->param('site')}->{$module}; 
              $SITE = $cgi->param('site');
            } else {
              $SITECONFIG = undef;
              $SITE = undef;
            }
            $message = &{$fullmodule . "::Config"}($req, $cgi, $SITECONFIG);
            &write_config(); # save changes.
          } else {
            logger(DEBUG, "ERROR: Unrecognized module: $module");
            $module = "";
            $fullmodule = "";
            $MODULECONFIG = "";
          }
        }
        my($content, $error) = ("", "");
        my($remote_port, $remote_addr) = sockaddr_in(getpeername($client));

# Globals for HTML::Mason
        $interp->out_method($res->content_ref);
        $interp->set_global(MESSAGE => defined $message?$message:"");
        $interp->set_global(SITE => $SITE);
        $interp->set_global(VERSION => defined $module?(defined ${$fullmodule . "::VERSION"}?${$fullmodule . "::VERSION"}:""):$VERSION);
# Objects and hash refs:
        $interp->set_global(r => $req);
        $interp->set_global(CGI => $cgi);     # FIXME how to handle this?  Try to make html environment
        $interp->set_global(MODULECONFIG => $MODULECONFIG);  # look like CGI/1.1?  Or Mason?
        $interp->set_global(SITECONFIG => $SITECONFIG); 
        $interp->set_global(CONFIG => $CONFIG);
# The one list ref:
        $interp->set_global(MODULES => \@MODULES); # properly, this should be in FilterProxy::Config
# These are CGI/1.1 parameters.
        $interp->set_global(AUTH_TYPE => "");
        $interp->set_global(CONTENT_LENGTH => defined $req->content_length?$req->content_length:0);
        $interp->set_global(CONTENT_TYPE => defined $req->content_type?$req->content_type:"");
        $interp->set_global(GATEWAY_INTERFACE => "CGI/1.1");
        $interp->set_global(PATH_INFO => $file);
        $interp->set_global(PATH_TRANSLATED => "$HOME/html/$file");
        $interp->set_global(QUERY_STRING => defined $query_string?$query_string:"");
        $interp->set_global(REMOTE_PORT => $remote_port);
        $interp->set_global(REMOTE_HOST => gethostbyaddr($remote_addr, AF_INET));
        $interp->set_global(REMOTE_ADDR => inet_ntoa($remote_addr));
        $interp->set_global(REMOTE_USER => ""); # should be AUTH userid.
        $interp->set_global(REQUEST_METHOD => $req->method);
        $interp->set_global(SCRIPT_NAME => "$HOME/html/$file");
        $interp->set_global(SERVER_NAME => $HOSTNAME);
        $interp->set_global(SERVER_PORT => $LISTEN_PORT);
        $interp->set_global(SERVER_PROTOCOL => "HTTP:/1.1");
        $interp->set_global(SERVER_SOFTWARE => $NAME);
        $req->headers->scan(sub {  # add HTTP headers to CGI environment
          my($param_name) = shift;
          $param_name =~ tr/a-z\-/A-Z_/;
          $param_name = "HTTP_" . $param_name;
          $interp->set_global($param_name => shift);
        });
        
        my($component) =
	    eval { $interp->make_component(comp_file=>"$HOME/html/$file");
	       };
        if($@) { $client->send_error(RC_INTERNAL_SERVER_ERROR); logger(ERROR, "HTML::Mason::Parser error: $@"); return; }
        $error = $interp->exec($component);
        if($error) { $client->send_error(RC_INTERNAL_SERVER_ERROR); logger(ERROR, "HTML::Mason::Interp error: $error"); return; }
        $res->header('Pragma' => 'no-cache');
        $res->content_length(length(${$res->content_ref}));
      } else {
        if(defined $req->if_modified_since && ($req->if_modified_since >= (@{stat("$HOME/html/$file")})[9])) {
          $res->code(304);
          $res->message("Not Modified");
          $res->content(undef);
        } else {
          $res->content_length($size) if $size;
          sysopen(FILE, "$HOME/html/$file", 0) || $client->send_error(RC_FORBIDDEN);
          $res->content(undef);
        }
      }
    } else { $client->send_error(RC_NOT_FOUND); return; }
  } else { $client->send_error(RC_BAD_REQUEST); return; }

  &handle_filtering($inreq, $res, 10); # Shouldn't depend on presence of content.
  $client->send_status_line($res->code, $res->message);
  print $client $res->headers_as_string("$CRLF") . "$CRLF";
  if($clientprotocol==1.1) {
    if(defined $res->content) {
      printf $client "%x%s", length ${$res->content_ref}, $CRLF;
      print $client ${$res->content_ref};
      print $client $CRLF . "0$CRLF$CRLF";
    } else { 
      unless($res->code >= 300 && $res->code < 400) { # no content.
        printf $client "%x%s", $size, $CRLF;
        $client->send_file(\*FILE);
        close(FILE);
        print $client $CRLF . "0$CRLF$CRLF";
      }
    }
  } else {
    if(defined $res->content) {
      print $client ${$res->content_ref};
    } else {
      unless ($res->code >= 300 && $res->code < 400) { # no content.
        $client->send_file(\*FILE);
        close(FILE);
      }
    }
    unless($clientprotocol == 1.01) { # client is 0.9 or 1.0 (non-netscape)
      $client->force_last_request();
    }
  }
  undef($res);
}

sub Config { 
# takes request, cgi, returns HTML message.
  my($req, $cgi, $config) = @_;
  my($site, $users);
  my($module);
  my($message) = ""; # html message describing success/failure for the client.

  if($cgi->param()) {
    logger(DEBUG, "parameters: ", join(" ", $cgi->param()), "\n");
    if(defined $cgi->param('logfile') && defined $cgi->param('timeout')) {
      if(defined $cgi->param('filtering')) { $CONFIG->{filtering} = 1; }
      else { $CONFIG->{filtering} = 0; }
      if(defined $cgi->param('debug')) { $CONFIG->{debug} = 1; }
      else { $CONFIG->{debug} = 0; }
      if(defined $cgi->param('info')) { $CONFIG->{info} = 1; }
      else { $CONFIG->{info} = 0; }
      if(defined $cgi->param('timing')) { $CONFIG->{timing} = 1; }
      else { $CONFIG->{timing} = 0; }
      if(defined $cgi->param('localhostonly')) { $CONFIG->{localhostonly} = 1; }
      else { $CONFIG->{localhostonly} = 0; }
      if(defined $cgi->param('authenable') && keys %{$CONFIG->{users}}) { $CONFIG->{authenable} = 1; } 
      else { $CONFIG->{authenable} = 0; }
      if(defined $cgi->param('timeout')) {
        $CONFIG->{timeout} = $cgi->param('timeout');
        $agent->timeout($CONFIG->{timeout});
      }
      if(defined $cgi->param('logfile')) {
        $CONFIG->{logfile} = $cgi->param('logfile');
      }
      if(defined $cgi->param('http_proxy') && $CONFIG->{http_proxy} ne $cgi->param('http_proxy')) { 
        $CONFIG->{http_proxy} = $cgi->param('http_proxy');
        $agent->proxy('http', $CONFIG->{http_proxy}); 
      }
      if(defined $cgi->param('http_proxy_username') && $CONFIG->{http_proxy_username} ne $cgi->param('http_proxy_username')) {
        $CONFIG->{http_proxy_username} = $cgi->param('http_proxy_username');
        $agent->{'http_proxy_username'} = $CONFIG->{http_proxy_username}; 
      }
      if(defined $cgi->param('http_proxy_password') && $CONFIG->{http_proxy_password} ne $cgi->param('http_proxy_password')) {
        $CONFIG->{http_proxy_password} = $cgi->param('http_proxy_password');
        $agent->{'http_proxy_password'} = $CONFIG->{http_proxy_password}; 
      }
    }
    if($cgi->param("add") || (defined $cgi->param("add.x")) || (defined $cgi->param("add.y"))) {
      if($cgi->param('url') and ($cgi->param('url') !~ $cgi->param('newsite'))) {
        $message = "<center><font color=red><h3>Your selected URL regexp, \"" . 
            $cgi->param('newsite') . "\"does not match the URL you selected." . 
            "</font></center>\n";
      } else {
        logger(DEBUG, "site: ", $cgi->param('site'), "\n");
        logger(DEBUG, "module: ", $cgi->param('module'), "\n");
        if(!defined $CONFIG->{filters}->{$cgi->param('site')}) {
          $CONFIG->{filters}->{$cgi->param('site')} = {};
        }
        if(defined $CONFIG->{filters}->{$cgi->param('site')}->{"-" .  $cgi->param('module')}) {
          delete $CONFIG->{filters}->{$cgi->param('site')}->{"-" .  $cgi->param('module')};
        }
        if(!defined $CONFIG->{filters}->{$cgi->param('site')}->{$cgi->param('module')}) {
          $CONFIG->{filters}->{$cgi->param('site')}->{$cgi->param('module')} = {};
        }
        $message = "<center><font color=blue>Filter module " . 
            $cgi->param('module') . " successfully added for site regexp " . 
            $cgi->param('site') . ".</font></center>\n";
      }
    }
    if($cgi->param('delete') || $cgi->param('delete.x') || $cgi->param('delete.y')) {
      if($cgi->param('module') && $cgi->param('site')) {
        logger(DEBUG, "Deleting module ", join(",", $cgi->param('module')), " from site ", 
          join(",", $cgi->param('site')));
        if($cgi->param('module') eq "Header" && $cgi->param('site') eq ".*") {
            $message .= "<font color=red><h1>WARNING</h1> You have disabled the header "
                      . "module for all sites.  FilterProxy may not work properly, since "
                      . "it depends on Header to formulate proper HTTP responses.</font>";
        } else {
            $message .= "<center><font color=blue>Filter module " . $cgi->param('module') . 
                " successfully removed for site regexp " . $cgi->param('site') . ".</font></center>";
        }
        logger(DEBUG, Data::Dumper->Dump([$CONFIG->{filters}->{$cgi->param('site')}], 
          [qw($CONFIG->{filters}->{$cgi->param('site')})]));
        if(defined $CONFIG->{'filters'}->{$cgi->param('site')}->{$cgi->param('module')}) {
          delete $CONFIG->{filters}->{$cgi->param('site')}->{$cgi->param('module')};
        } else {
          $CONFIG->{filters}->{$cgi->param('site')}->{"-" .  $cgi->param('module')} = {};
        }
        my(@keys) = keys %{$CONFIG->{filters}->{$cgi->param('site')}}; # check that there are filters left.  
        if($#keys == -1) { # Else delete site.
          delete $CONFIG->{filters}->{$cgi->param('site')};
        }
        logger(DEBUG, Data::Dumper->Dump([$CONFIG->{filters}->{$cgi->param('site')}], 
          [qw($CONFIG->{filters}->{$cgi->param('site')})]));
      } elsif($cgi->param('site')) {
        logger(DEBUG, "Deleting site ", $cgi->param('site'), "\n");
        delete $CONFIG->{filters}->{$cgi->param('site')};
        $message .= "<center><font color=blue>Site regexp " . $cgi->param('site') . 
            " removed.</font></center>";
      }
    }
    # From FilterProxy.Admin.html
    if($cgi->param('userdelete') || $cgi->param('userdelete.x') || $cgi->param('userdelete.y')) {
      delete $CONFIG->{users}->{$cgi->param('user')};
        $message = "<center><font color=blue>User " . $cgi->param('user')
            . " successfully deleted.</font></center>";
      if(scalar keys %{$CONFIG->{users}} == 0) {
        $message = "<center><font color=red>Warning: Authentication disabled since there are no users!"
            . "</font></center>";
        $CONFIG->{authenable} = 0; # With no users, the proxy won't allow ANY requests!
      }
    }
    if($cgi->param('useradd') || $cgi->param('useradd.x') || $cgi->param('useradd.y')) {
      if($cgi->param('password1') eq $cgi->param('password2')) {
        $CONFIG->{users}->{$cgi->param('user')} = $cgi->param('password1');
        $message = "<center><font color=blue>User " . $cgi->param('user') 
            . " successfully added.</font></center>";
      } else {
        $message = "<center><font color=red>passwords don't match, try again.</font></center>";
      }
    }
  }
  return $message;
}

1;

__END__