#!/usr/bin/perl -T

########################################################################
#
# pft (Privoxy-Filter-Test) is a web interface controlled
# program to quickly create or debug Privoxy filters.
#
# Directly required Perl modules:
#
# HTTP-Server-Simple
# HTTP-Lite
# Text-Diff-HTML
#
# $Id: pft.pl,v 1.54 2010/03/28 18:08:14 fk Exp $
#
# Copyright (c) 2006-2009 Fabian Keil <fk@fabiankeil.de>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
############################################################################

# Known bugs:
#
# - The Content-Encoding of the internal server
#   is almost guaranteed to be wrong.
#
# - Many errors cause the forked process to die()
#   in which case the user gets no response.
#
# - The default for local-server should depend on web-interface-ip 
#
# - No difference is detected if one of the files doesn't exist
#
# - Needs proper logging support
#
# - The HTML produced by Text::Diff uses incorrect
#   entities.
#
# - The generated HTML isn't formatted properly.
#
# - Next to no comments and no documentation either.
#
# - --privoxy-config-file is ignored if --privoxy-dir is set.

use warnings;
use strict;
use Text::Diff;
use HTTP::Lite;
use HTTP::Server::Simple;
package PrivoxyFilterTest;
use base qw(HTTP::Server::Simple::CGI);
use Getopt::Long;

use constant {
    PFT_VERSION                => 'Privoxy-Filter-Test 0.6',

    SUPPRESS_TITLE             => 1,
    WORKING_DIR                => '/usr/local/var/pft',
    PRIVOXY_DIR                => '/usr/local/etc/privoxy',
    PRIVOXY_CONFIG_FILE        => 'config',
    FILTER_FILE_TO_APPEND_TO   => 'fk.filter',
    FILTER_SAVING_ALLOWED      => 1,
    FETCHED_FILE               => 'file-fetched.html',
    RECIEVED_FILE              => "file-recieved.html",
    PREFIX_ORIGINAL            => 'original-',
    PREFIX_FILTERED            => 'filtered-',
    DIFF_FILE                  => 'diff.html',
    PRIVOXY                    => '127.0.0.1:8118',
    LOCAL_SERVER               => '127.0.0.1:8080/?deliver=',
    WEB_INTERFACE_IP           => '127.0.0.1',
    WEB_INTERFACE_PORT         => '8080',
    FORM_METHOD                => 'POST',
    FETCH_WITH_PRIVOXY         => 1,
    DEBUG                      => 1,
    FETCH_WITH_CURL            => 0,
    CURL_MAXTIME               => 0,
    CURL                       => '/usr/local/bin/curl',
    LOG_TO_FILE                => 0,
    LOGFILE                    => '/usr/local/var/log/pft.log',
    PRIVOXY_CGI_URL            => 'http://config.privoxy.org/',
    STRICT_URL_CHECK           => 1,
    POLIPO_HACK                => 1,
};


sub fetch_freshfile($$$) {
############################################################################
# Fetches clean document over HTTP. Either with an external curl
# binary or with new HTTP::Lite. Curl support was added because
# for some reason or another HTTP::Lite behaves weird in FreeBSD jails.
############################################################################
    our $privoxy;
    our $working_dir;
    our $fetch_with_privoxy;
    our $fetch_with_curl;
    our $curl;
    our $curl_maxtime;
    my $freshfile = $working_dir . "/" . shift;
    my $request = shift;
    my $disable_filtering = shift;

    my ($http, $req, $body);

    if (!is_invalid_url($request)) {
	if ($fetch_with_curl) {
	    $request =~ /(.*)/;
	    $request = $1;
	    my $command = $curl . " -x " . $privoxy . " --user-agent \"" .
		PFT_VERSION . "\"" . " -s \"$request\" -o $freshfile";
	    $command .= " --header \"X-Filter: No\"" if $disable_filtering;
            $command .= " --max-time " . $curl_maxtime if $curl_maxtime;
	    $command .= ' -H "Cache-Control: no-cache"' if POLIPO_HACK;
	    undef %ENV;
	    log_message("Requesting $request with\n$command");
	    system ("$command");
	} else {
	    log_message("Requesting $request myself");
	    $http = new HTTP::Lite;
	    $http->add_req_header("User-Agent", PFT_VERSION);

	    $http->add_req_header("Cache-Control", "no-cache") if POLIPO_HACK;

	    if ($fetch_with_privoxy) {
		$http->proxy ( $privoxy );
		$http->add_req_header("X-Filter", "No") if $disable_filtering;
	    }     

	    $req = $http->request( $request )
	      or $body = "Unable to get document: $!";

	    $body = $http->body() || "" if $req;

	    #$body = "Request for original file failed ($req): ".$http->status_message()
	    #  if $req ne "200";
	    open( FRESHFILE, ">$freshfile" ) || die "Writing $freshfile failed";
	    print FRESHFILE $body;
	    close(FRESHFILE);
	}
    } else {
	    log_message("Some sucker requested $request.");
    	    open( FRESHFILE, ">$freshfile" ) || die "Writing $freshfile failed";
	    print FRESHFILE "Important message from Mr. T: Invalid URL, sucker.\n";
	    close(FRESHFILE);
    }
}

sub fetch_modifiedfile($$) {
############################################################################
# Acts like fetch_freshfile but refetches the filtered file. 
############################################################################
    our $privoxy;
    our $working_dir;
    our $local_server;
    our $fetch_with_privoxy;
    our $fetch_with_curl;
    our $curl;
    our $curl_maxtime;
    my $freshfile = shift;
    my $modifiedfile = $working_dir . "/" . shift;
    my ($http, $req, $body);
    my $request = "http://" . $local_server. $freshfile;

    if ($fetch_with_curl) {
        my $command = $curl . " -x " . $privoxy . " --max-time 60 -s \"$request\" -o $modifiedfile";
        undef %ENV;
        log_message("Requesting $request with\n$command");
        system ($command);

    } else {

        log_message("Requesting $request myself");

    	$http = new HTTP::Lite;
	$http->add_req_header("User-Agent", PFT_VERSION);
	$http->proxy( $privoxy );

	$req = $http->request( $request )
	    or die "Unable to get document: $!";

        if ($req ne "200") {
            log_message("Request for modified file failed ($req): " . $http->status_message())
        }

	$body = $http->body() || "" if $req;

        open( MODIFIEDFILE, ">$modifiedfile" ) || die "Writing $modifiedfile failed";
        print MODIFIEDFILE $body;
        close(MODIFIEDFILE);
    }
}


sub get_matching_filters($) {
############################################################################
# Checks which filters Privoxy would apply. 
############################################################################
    our $privoxy;
    our $working_dir;
    our $local_server;
    our @filter_list;
    our $curl;
    our $fetch_with_curl;

    my $url = shift;
    my ($http, $req, $body);
    my $request = PRIVOXY_CGI_URL . 'show-url-info?url=' . $url;
    my $final_results_reached = 0;

    my $matching_filters = '';

    if ($fetch_with_curl) {
        
        if (!is_invalid_url($url))
        {
            untaint_without_checking(\$request);
            my $command = $curl . ' -x "' . $privoxy .
                '" --max-time 60 -s "' .  $request . '" -H "User-Agent: ' . PFT_VERSION . '"';
            undef %ENV;
            log_message("Requesting $request with: $command");
            $body = `$command`;
        }
        else
        {
            $body = "Invalid URL rejected";
        }

    } else {

        log_message("Requesting $request myself");

        $http = new HTTP::Lite;
        $http->add_req_header("User-Agent", PFT_VERSION);
        $http->proxy( $privoxy );

        $req = $http->request( $request )
            or die "Unable to get document: $!";

        log_message("Request finished");

        if ($req ne "200") {
            log_message("Request for Privoxy URL info failed ($req): " . $http->status_message());
        }

        $body = $http->body() || "" if $req;
    }

    foreach my $line (split (/\n/, $body) ) {
        $final_results_reached = 1 if $line =~ m/\<h2\>Final results:\<\/h2\>/;
        next unless $final_results_reached;

        if ($line =~ m/<br>\+[^>]*>filter<\/a>\s?\{([^}]*)\}/) {
            #<br>+<a href="http://config.privoxy.org/user-manual/actions-file.html#FILTER">filter</a> {content-cookies}
            my $matching_filter = $1;
            foreach my $i (0 .. @filter_list - 1) {
                if ($filter_list[$i]{name} =~ /^$matching_filter$/) {
                    $matching_filters .= "\n# Included from matching filter ";
                    $matching_filters .= $filter_list[$i]{name};
                    $matching_filters .= ":\n" . $filter_list[$i]{content};
                    last;
                }
            }
        }
    }
    $matching_filters .= "# No matching filters found" unless $matching_filters;

    return $matching_filters;
}

sub get_diff($$$) {
############################################################################
# Compares the original with the filtered document and saves HTML diff.
############################################################################
    our $working_dir;
    my $freshfile    = $working_dir . "/" . shift;
    my $modifiedfile = $working_dir . "/" . shift;
    my $diff_file    = $working_dir . "/" . shift;

    my $diff = Text::Diff::diff "$freshfile", "$modifiedfile", { STYLE => 'Text::Diff::HTML' } || '';

    log_message(($diff eq '') ? "No difference detected\n" : "Difference detected");

    open( DIFF, ">$diff_file" ) || die "Writing $diff_file failed";
    print DIFF "$diff";
    close(DIFF);    
}

sub insert_linebreaks($) {
############################################################################
# Inserts linebreaks after 80 characters.
############################################################################
    our $working_dir;
    my $filename  = $working_dir . "/" . shift;
    my $newfile = $filename;# . "-linebreak-edition";
    my $content;
    local($/);

    log_message("--- Adding linebreaks requested. Filename is: " . $filename);
    open(FILE, "$filename") || die "Failed to open: " . $filename;
    $content = <FILE>;
    $content =~ s@(.{60})(?<=[^\n])@$1\n@g;
    close(FILE);

    open(NEWFILE, ">" . $newfile) || die "Failed to open: " . $newfile;
    print NEWFILE $content;
    close(NEWFILE);
    log_message("--- Line breks added where necessary.");
}

sub pft_client {
############################################################################
# Once upon a time there was no webinterface. The 'client' was left over
# and hasn't been properly integrated yet.
############################################################################
    
    my $newrequest        = 1 if (@_ == 4);
    my $basename          = shift;
    my $insert_linebreaks = shift eq "yes";
    my $target            = shift if $newrequest;
    my $disable_filters   = shift if $newrequest;

    my $modifiedfile    = PREFIX_FILTERED . $basename; 
    my $freshfile       = PREFIX_ORIGINAL . $basename;
    
    if ($newrequest) {
       fetch_freshfile( $freshfile, $target, $disable_filters);
       log_message("Fetching fresh file: $target\n disable_filters= $disable_filters\nSaving as $freshfile\n"
         );
    } else {
       log_message("Using local file $freshfile");
    }

    insert_linebreaks($freshfile) if ($insert_linebreaks);

    log_message("Retrieving modified file, saving as $modifiedfile");
    fetch_modifiedfile($freshfile, $modifiedfile);
    log_message("Diffing $freshfile and $modifiedfile");
    get_diff($freshfile, $modifiedfile, DIFF_FILE);
}

#Server
sub handle_request($$) {
############################################################################
# Fork and return to make sure pft doesn't block.
############################################################################

    my ($self, $cgi) = @_;

    if (!fork()) {
        really_handle_request($cgi);
    }
}

sub really_handle_request($) {
############################################################################
# Forked into from handle_request and exits if work is done.
# "Work" either means "display webinterface" or "react to input
# and show result".
############################################################################

    my $cgi = shift @_;
    our $filter               = $cgi->param('filter');
    my $deliver               = $cgi->param('deliver');
    my $fetch                 = $cgi->param('fetch');
    my $fetch_filtered        = $cgi->param('fetch-filtered') || "Empty";
    my $localcopy             = $cgi->param('local');
    my $document              = $cgi->param('document');
    my $on_the_fly_filtertext = $cgi->param('filtertext');
    my @add_known_filters     = $cgi->param('add_known_filters');
    my $otf_filtering         = $cgi->param('otf');
    my $add_matching_filters  = $cgi->param('add-matching-filters') || "Nope";
    my $save                  = $cgi->param('save') || 0;
    my $filtername            = $cgi->param('filtername');
    my $randomid              = $cgi->param('randomid') || 0;
    my $insert_linebreaks     = $cgi->param('insert-linebreaks') || "No";
    my $showdiff              = 0;
    our $url_is_invalid       = 0;
    our @filter_list;

    log_message("Randomid: $randomid");
    my $disable_filtering = ($fetch_filtered eq "enabled") ? 0 : 1;

    $randomid =~ /(\d*)/;
    $randomid = $1;

    my $basename = $randomid . "-" . FETCHED_FILE;

    get_filters();

    if ($add_matching_filters =~ /yes/) {
        log_message("Adding filters ...");
        $document = fix_url($document);
        $url_is_invalid = is_invalid_url($document);
        $filter .= get_matching_filters($document) unless $url_is_invalid;
    }
    foreach my $i (@add_known_filters) {
        $filter .= "\n# Included from filter: " . $filter_list[$i]{name} . "\n";
        $filter .= "\n" . $filter_list[$i]{content};
    }

    write_filter($filter);

    if (FILTER_SAVING_ALLOWED and $save) {
        save_filter($filtername, $filter);
        get_filters();
    }
    if ($otf_filtering) {
        log_message("OTF filter mode");
        $basename =  $randomid . "-" . RECIEVED_FILE;   
        write_file($basename, $on_the_fly_filtertext)
    }

    if ($fetch) {
        write_file($basename, "No body.");
        log_message("Fetch mode");
        $document = fix_url($document);
        $url_is_invalid = is_invalid_url($document);

        pft_client($basename, $insert_linebreaks, $document, $disable_filtering) unless $url_is_invalid;
    }

    pft_client($basename, $insert_linebreaks) if ($localcopy or $otf_filtering);

    if ($deliver) {
         log_message("Deliver mode");
	 deliver($deliver);
    } else {
	 log_message("Webinterface mode. showdiff= $showdiff");
         $showdiff = 1 if $localcopy or $fetch or $otf_filtering;
         send_webinterface($cgi, $showdiff, $randomid);
    }
    log_message("--- Forked process is done ---");

    exit;
}

sub fix_url($) {
############################################################################
# Fixes some obvious problems like missing protocol or trailing slash
# after domain name.
############################################################################

    my $url = shift;

    log_message("Checking for protocol in $url");
    $url =~ s@^(^http://)@http://@; # At least one ...

    log_message("Checking for duplicate protocol in $url");
    $url =~ s@(http://)\1+@$1@;     # but not more protocols.

    log_message("Checking for trailing slash in $url");
    $url =~ s@http://[^/]*$@$0/@;

    log_message("Checking for hashes in " . $url);

    $url =~ s@\#.*@@;

    log_message("Fixed URL looks like this: $url");

    return $url;
}

sub is_invalid_url($) {
    my $url = shift;
    my $validurl='http://[-a-zA-Z\d.]+\.[a-zA-Z]+/[-=\dA-Za-z~:.\/;,+@"_%\?&*^]*';
    my $privoxy_config_url = 'http://(config\.privoxy\.org|p\.p)';

    if ($url =~ m/^$validurl$/){
       log_message("$url looks valid");
    } else {
       log_message("$url looks fishy");
       return(1) if STRICT_URL_CHECK;    
    }
    if ($url =~ m/^$privoxy_config_url/){
       log_message("$url looks like a config url");
       return(1);
    }

    return(0);    
}

sub write_file($$) {
############################################################################
# Writes the file that is later filtered. The file is saved locally
# so it only has to be fetched once.
############################################################################

    our $working_dir;
    my $file = $working_dir . "/" . PREFIX_ORIGINAL . shift;
    my $text = shift;

    log_message("Writing $file($text)");
    open( ORIGINALFILE, ">$file" )
     || die "Opening $file failed";
    print ORIGINALFILE $text;
    print ORIGINALFILE "\n" if $text;
    close ORIGINALFILE;
}

sub write_filter($) {
############################################################################
# (Over)writes the pft filter file privoxy-filter-test.filter
############################################################################

    our $privoxy_dir;
    my $filter = shift || "";
    my $filterfile = $privoxy_dir . "/privoxy-filter-test.filter";

    $filter = "FILTER: privoxy-filter-test Filter created with pft-server\n" . $filter . "\n";

    log_message("Writing filterfile: $filterfile($filter)");
    open( FILTERFILE, ">$filterfile" )
     || die "Opening $filterfile failed";
        
#    print FILTERFILE "FILTER: privoxy-filter-test Filter created with pft-server\n";
    print FILTERFILE $filter;
    close FILTERFILE;
}

sub save_filter($$) {
############################################################################
# Saves a filter to FILTER_FILE_TO_APPEND_TO if the user thinks the filter
# is working properly.
############################################################################

    our $privoxy_dir;
    my $filtername = shift;
    my $filter     = shift || '';
    my $filterfile = $privoxy_dir . "/" . FILTER_FILE_TO_APPEND_TO;

    log_message("Saving Filter $filtername ($filter) in $filterfile");

    if (open(FILTERFILE, ">>$filterfile")) {

        print FILTERFILE "\nFILTER: $filtername (created with pft-server)\n";
        print FILTERFILE "$filter\n";
        close FILTERFILE;

    } else {
 
        log_message("Opening " . $filterfile . " failed: " . $!);
    }
}       

sub get_filters() {
############################################################################
# Loads all the filters Privoxy knows of. This is useful to debug problems
# with Privoxy's own filters.
############################################################################

    our $known_filters;
    our $privoxy_dir;
    our $privoxy_config_file;
    our %filters;
    our @filter_list;
    my $file_number;
    my $filter_number = 0;
    my @filterfiles;
    my $number;

    my $current_filter = '';

    open( CONFIG_FILE, $privoxy_config_file )
     || die "Opening $privoxy_config_file failed";

    while (<CONFIG_FILE>) {
        if (/^\s*filterfile\s*([^\s\#]*)/) {
           $filterfiles[$file_number++] = $privoxy_dir . "/" . $1;
        }
    }
    close CONFIG_FILE;

    for $file_number (0 .. @filterfiles - 1) {
        my $filterfile = $filterfiles[$file_number];

        open( FILTERFILE, "$filterfile" )
            || die "Opening $filterfile failed";

        while (<FILTERFILE>){
            if (/^\s*(?:(?:SERVER|CLIENT)-HEADER-)?FILTER:\s*([^\s\#]*)\s*(.*)$/) {
                if ($current_filter) {
                    #log_message("Content of filter $current_filter is:\n$filter_list[$filter_number]{content}");
                    $filter_number++;
                }
                $current_filter = $1;
                $filter_list[$filter_number]{name} = $1;
                $filter_list[$filter_number]{description} = $2 if $2;
                $filter_list[$filter_number]{content} = '';
                #log_message("Beginning of new filter $current_filter detected");
                next;
            }
            #$current_filter = '' if (/^\s*(SERVER|CLIENT)-HEADER-FILTER:\s*([^\s\#]*)\s*(.*)$/);
            next unless $current_filter;
            next if (/^\s*(?!<\\)\#/); # comment
            next if (/^\s+$/);         # empty line
            $filter_list[$filter_number]{content} .= $_;
        }
        close FILTERFILE;
    }
}
             
sub deliver($) {
############################################################################
# Small webserver through which we refetch the original file for filtering.
############################################################################

    our $working_dir;

    my $file = shift || "";
    my $originalfile;    
    my $legal_beginning = PREFIX_ORIGINAL;
    my $legal_ending = '(' . FETCHED_FILE . '|' . RECIEVED_FILE . ')';
    local($/);

    print "HTTP/1.1 200 Come and get some\r\n",
          "Content-Encoding: utf-8\r\n",
          "Content-Type: text/plain\r\n",
          "Connection: Close\r\n\r\n";

    if ( $file =~ m/^$legal_beginning\d*-$legal_ending$/ && -r $working_dir . "/" . $file) {
        $file = $working_dir . "/" . $file;
        log_message("Delivering $file");

        open( ORIGINALFILE, "$file" )
         || die "Opening $file";
        $originalfile = <ORIGINALFILE>;
        print "$originalfile";
        close ORIGINALFILE;
    } else {
        log_message("Didn't fullfil request for $file");
        print "Someone has been naughty\n";
    }
}

sub send_webinterface($$$) {
############################################################################
# Generates the input page through which pft is controlled.
# The result blows quite a bit because HTTP::Lite's documentation
# is a joke and I'm to lazy to digg into the source.
############################################################################

    our $working_dir;
    our $url_is_invalid;
    our $filter;
    our @filter_list;
    our $fetch_with_privoxy;
    our $fetch_with_curl;
    our $curl_maxtime;
    our $area_rows = 10;

    my $cgi = shift;
    my $showdiff = shift;
    my $randomid = shift || int(rand(10000000));


    my $head;
    my $b = ''; # body

    $head =
    #Wish this crap had some documentation.
    #$cgi->header(    -status=>'200 Come and get some',
    #		      -type=>' application/xhtml+xml',
    #                 -charset=>'utf-8',
    #                 ),
    "HTTP/1.1 200 Come and get some\r\n" .
    "Server: " . PFT_VERSION . "\r\n" .
    "Content-Encoding: utf-8\r\n" .
#    "Content-Type: application/xhtml+xml\r\n" .
    "Content-Type: text/html\r\n" .
    "X-Documentation: You wish\r\n" .
    "Connection: Close\r\n\r\n";

    $b .= $cgi->start_html(# -dtd=>'Yet another thing hat doesn't work'
                      -title=>'Privoxy-Filter-Test',
                      -content_type=>'utf-8',
                          );

    $b .= $cgi->h1(PFT_VERSION) unless SUPPRESS_TITLE;
    $b .= $cgi->start_form(-method=>FORM_METHOD);
    $b .= $cgi->hidden(-name=>'randomid', -default=>[$randomid]);
    $b .= $cgi->p("Filter to apply:");
    $b .= $cgi->textarea(-name     => 'filter',
                   -default  => $filter,
                   -override => 1,
                   -rows     => $area_rows,
                   -style    => 'width: 100%'
                         );

    $b .= $cgi->start_p();
    if ($fetch_with_privoxy) {
        $b .= "Fetch this document with Privoxy's usual filters";
        $b .= $cgi-> radio_group(-name=>'fetch-filtered',
                           -values=>['enabled','disabled'],
                           -default=>'disabled',
			   );
        $b .= ":";
    } else {
        $b .= "Fetch this document without Privoxy at all, because " .
	      "someone didn't apply the needed Privoxy improvements:";
    }

    $b .= $cgi->end_p();

    $b .= $cgi->textfield(-name  => 'document',
                          -value => 'http://',
                          -style  => 'width: 100%');
    $b .= $cgi->submit(-name  => 'fetch',
                       -value => 'Fetch (again)');

    $b .= $cgi->submit(-name  => 'local',
                       -value => 'Use local copy');

    if ($curl_maxtime) { 
	$b .= $cgi->p("Download will be forcefully stopped after " . $curl_maxtime . " seconds!");
    }

    $b .= $cgi->p("Apply matching filters:",
                  $cgi-> radio_group(-name    => 'add-matching-filters',
                                     -values  => ['yes','no'],
                                     -default => 'no',
                                     ),
                  ". Insert linebreaks after fetching:",
                  $cgi-> radio_group(-name    => 'insert-linebreaks',
                                     -values  => ['yes','no'],
                                     -default => 'no',
                                     ),
                  );
    $b .= $cgi->p("Apply filter to this text instead:");
    $b .= $cgi->textarea(-name    =>'filtertext',
                         -default =>'',
                         -rows    => 7,
                         -style   => 'width: 100%');
    $b .= $cgi->br();
    $b .= $cgi->submit(-name=>'otf', -value=>'Use this text');
    $b .= $cgi->defaults("Reload defaults");
    $b .= $cgi->reset("Reset");

    if( $url_is_invalid){
        $b .= $cgi->p("Important message from Mr. T: <q><strong style='color:red;'>Invalid URL, foo'.</strong></q>"); 
    } elsif ($showdiff) {
        local( $/);
        open( DIFF, $working_dir . "/diff.html" )
         || die "Opening " . $working_dir . "/diff.html failed";
        my $diff = <DIFF>;
        close DIFF;

        if ($diff) {
            $b .= $cgi->p("The result of your filter is:");
            $b .= $cgi->blockquote(
                     $cgi->pre("$diff"),
                     $cgi->p("Non-ascii characters get messed up by pft, it has nothing to do with your filter."),
                                  );
        } else {
            $b .= $cgi->p("No differences detected!");
	}
        if (FILTER_SAVING_ALLOWED) {    
            $b .= $cgi->br();
            $b .= $cgi->submit(-name=>'save', -value=>'That\'s good enough, save filter as:');
            $b .= $cgi->textfield(-name  => 'filtername',
                                  -value => '',
                                  -style => 'width: 100%');
        } else	{
            $b .= $cgi->p("If FILTER_SAVING_ALLOWED wasn't set to zero, you could save this filter now."); 
	}
    }

    $b .= $cgi->p("Available filters (" . @filter_list . "):");
    $b .=  "<table><tr><th>Filtername</th><th>Description</th></tr>";

    for my $i (0 .. @filter_list - 1) {

        $b .= '<tr><td><input type="checkbox" name="add_known_filters" value="';
        $b .= $i . '"></input>' . $filter_list[$i]{name} . "</td><td> ";
        $b .= $filter_list[$i]{description} ?
              $cgi->escapeHTML($filter_list[$i]{description}) :
              "No description available. Naughty.";
        $b .= '</td></tr>';

    }

    $b .= "</table>";

    $b .= $cgi->end_form();
    $b .= $cgi->end_html;

    print $head, $b;
}

sub print_banner() {
############################################################################
# Shows that pft is working and where the webinterface is listening.
############################################################################

    our $web_interface_ip;
    our $web_interface_port; 
    print PFT_VERSION . " is awaiting your input at: " .
        $web_interface_ip . ":" . $web_interface_port . "/\n";
}

sub help() {
############################################################################
# Doesn't help a bit.
############################################################################

    print "Help yourself\n";
    exit;
}

sub log_message ($) {

    my $message = shift;

    our $logfile;
    our $no_logging;

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime time;
    $year += 1900;
    $mon  += 1;
    my $logtime = sprintf "%i/%.2i/%.2i %.2i:%.2i:%.2i", $year, $mon, $mday, $hour,
      $min, $sec;

    printf(STDERR "$logtime: %s\n", $message);

    #open( LOGFILE, ">>" . $logfile ) || die "Writing " . $logfile . " failed";
    #printf LOGFILE UAGEN_VERSION . " ($logtime) $message\n";
    #close(LOGFILE);

}


sub VersionMessage() {
############################################################################
# Prints version line.
############################################################################

    log_message(PFT_VERSION);
}

sub untaint_without_checking($) {
    my $tainted = shift;

    $$tainted =~ /^(.*)$/;
    $$tainted = $1;

    return $1;
}


sub main() {
############################################################################
# Parses command line options and enters listening loop.
############################################################################

    our $privoxy_config_file; # Depends on variables not yet set.
    our $working_dir         = WORKING_DIR;
    our $privoxy_dir         = PRIVOXY_DIR;
    our $privoxy             = PRIVOXY;
    our $local_server        = LOCAL_SERVER;
    our $web_interface_ip    = WEB_INTERFACE_IP;
    our $web_interface_port  = WEB_INTERFACE_PORT;
    our $fetch_with_privoxy  = FETCH_WITH_PRIVOXY;
    our $debug               = DEBUG;
    our $fetch_with_curl     = FETCH_WITH_CURL;
    our $curl_max_time       = CURL_MAXTIME;
    our $curl                = CURL;
    our $log_to_file         = LOG_TO_FILE;
    our $logfile             = LOGFILE;

    GetOptions('working-dir=s' => \$working_dir,
               'privoxy-dir=s' => \$privoxy_dir,
               'privoxy-config-file=s' => \$privoxy_config_file,
               'privoxy=s' => \$privoxy,
               'local-server=s' => \$local_server,
               'web-interface-ip=s' => \$web_interface_ip,
               'web-interface-port=s' => \$web_interface_port,
               'fetch-with-privoxy' => \$fetch_with_privoxy,
               'debug' => \$debug,
               'fetch-with-curl' => \$fetch_with_curl,
               'curl-max-time' => \$curl_max_time,
               'curl=s' => \$curl,
               'log-to-file' => \$log_to_file,
               'logfile=s' => \$logfile,
               'help' => \&help,
               'version' => sub {VersionMessage && exit(0)}
    ) or exit(1);

    $privoxy_config_file = $privoxy_dir . "/" . PRIVOXY_CONFIG_FILE
        unless $privoxy_config_file;

    if ($fetch_with_curl and $privoxy !~ /http:/ ) {
        $privoxy = 'http://' . $privoxy;
    }

    # XXX: While we trust the user to specify save CLI
    # paramters, perl 5.10 on Windows does not.
    untaint_without_checking(\$working_dir);
    untaint_without_checking(\$privoxy_dir);
    untaint_without_checking(\$working_dir);
    untaint_without_checking(\$privoxy_dir);
    untaint_without_checking(\$privoxy);
    untaint_without_checking(\$local_server);
    untaint_without_checking(\$web_interface_ip);
    untaint_without_checking(\$web_interface_port);
    untaint_without_checking(\$fetch_with_privoxy);
    untaint_without_checking(\$debug);
    untaint_without_checking(\$fetch_with_curl);
    untaint_without_checking(\$curl_max_time);
    untaint_without_checking(\$curl);
    untaint_without_checking(\$log_to_file);
    untaint_without_checking(\$logfile);

    $SIG{CHLD} = "IGNORE";
    $0 = PFT_VERSION;
    if ($log_to_file) {
       open(STDOUT,  ">>" . $logfile) or die "Opening $logfile";;
       open(STDERR, ">>" . $logfile)  or die "Opening $logfile";;
    }

    my $server = PrivoxyFilterTest->new();
    $server->host($web_interface_ip);
    $server->port($web_interface_port);
    $server->run;
    exit 1;
}

main();