diff --git a/tests/scripts/webserver.pl b/tests/scripts/webserver.pl
new file mode 100755
index 0000000..a1d171d
--- /dev/null
+++ b/tests/scripts/webserver.pl
@@ -0,0 +1,276 @@
+#!/usr/bin/perl -w
+
+# Simple WEB server.
+#
+# Inspired by some examples from the perlipc and other perl manual pages.
+#
+# Copyright (C) 2009 Michael Adam
+#
+# License: GPL
+
+use strict;
+
+use IO::Socket;
+use IO::Select;
+use Carp;
+use POSIX qw(setsid :sys_wait_h);
+use Errno;
+use Getopt::Long;
+use Pod::Usage;
+use Fcntl ':flock'; # import LOCK_* constants
+
+my $EOL = "\015\012";
+
+my $port = 2345;
+my $proto = getprotobyname('tcp');
+my $pid_file = "./webserver.pid";
+my $log_dir = "./";
+my $access_log_file;
+my $error_log_file;
+my $document_root = "./";
+my $help = 0;
+
+sub create_child($$$);
+
+sub logmsg {
+ print STDERR "[", scalar localtime, ", $$] $0: @_\n";
+}
+
+sub start_server($$) {
+ my $proto = shift;
+ my $port = shift;
+ my $server;
+
+ $server = IO::Socket::INET->new(Proto => $proto,
+ LocalPort => $port,
+ Listen => SOMAXCONN,
+ Reuse => 1);
+
+ logmsg "server started listening on port $port";
+
+ return $server;
+}
+
+sub REAPER {
+ local $!; # don't let waitpid() overwrite current error
+
+ while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
+ logmsg "reaped $pid" . ($? ? " with exit code $?" : '');
+ }
+
+ $SIG{CHLD} = \&REAPER;
+}
+
+sub child_action($) {
+ my $client = shift;
+ my $client_ip = shift;
+
+ logmsg "client_action: client $client_ip";
+
+ $client->autoflush();
+
+ my $fortune_bin = "/usr/games/fortune";
+ my $fortune = "";
+ if ( -x $fortune_bin) {
+ $fortune = qx(/usr/games/fortune);
+ $fortune =~ s/\n/$EOL/g;
+ }
+
+ my $request = "";
+ while (my $request_line = <$client>) {
+ $request .= $request_line;
+ last if ($request_line eq $EOL);
+ }
+
+ logmsg "request:\n" .
+ "------------------------------\n" .
+ "$request" .
+ "------------------------------";
+
+ print $client "HTTP/1.0 200 OK$EOL";
+ print $client "Server: Tinyproxy Test Web Server$EOL";
+ print $client "Content-Type: text/html$EOL";
+ print $client "$EOL";
+ print $client "$EOL";
+ print $client "Tinyproxy test WEB server
$EOL";
+ print $client "Fortune
$EOL";
+ if ($fortune) {
+ print $client "$fortune
$EOL";
+ } else {
+ print $client "Sorry, no $fortune_bin not found.$EOL";
+ }
+ print $client "Your request:
$EOL";
+ print $client "$request$EOL";
+ print $client "$EOL";
+
+ close $client;
+
+ return 0;
+}
+
+sub create_child($$$) {
+ my $client = shift;
+ my $action = shift;
+ my $client_ip = shift;
+
+ unless (@_ == 0 && $action && ref($action) eq 'CODE') {
+ confess "internal error. create_child needs code reference as argument";
+ }
+
+ my $pid = fork();
+ if (not defined($pid)) {
+ # error
+ logmsg "cannot fork: $!";
+ return;
+ } elsif ($pid) {
+ # parent
+ logmsg "child process created with pid $pid";
+ return;
+ } else {
+ # child
+ exit &$action($client, $client_ip);
+ }
+}
+
+sub process_options() {
+ my $result = GetOptions("help|?" => \$help,
+ "port=s" => \$port,
+ "pid-file=s" => \$pid_file,
+ "log-dir=s" => \$log_dir,
+ "root|document-root=s" => \$document_root);
+ die "Error reading cmdline options! $!" unless $result;
+
+ pod2usage(1) if $help;
+
+ # some post-processing:
+
+ ($port) = $port =~ /^(\d+)$/ or die "invalid port";
+ $access_log_file = "$log_dir/webserver.access_log";
+ $error_log_file = "$log_dir/webserver.error_log";
+}
+
+sub daemonize() {
+ umask 0;
+ chdir "/" or die "daemonize: can't chdir to /: $!";
+ open STDIN, "/dev/null" or
+ die "daemonize: Can't read from /dev/null: $!";
+ open STDOUT, ">> $access_log_file" or
+ die "daemonize: Can't write to '$access_log_file': $!";
+ open STDERR, ">> $error_log_file" or
+ die "daemonize: Can't write to '$error_log_file': $!";
+
+ my $pid = fork();
+ die "daemonize: can't fork: $!" if not defined($pid);
+ exit(0) if $pid != 0; # parent
+
+ # child (daemon)
+ setsid or die "damonize: Can't create a new session: $!";
+}
+
+sub get_pid_lock() {
+ open LOCKFILE, "> $pid_file" or
+ die "Error opening pid-file $pid_file: $!";
+ unless (flock(LOCKFILE, LOCK_EX|LOCK_NB)) {
+ my $other_pid = qx(cat $pid_file);
+ print "Webserver is already running (pid $other_pid)";
+ exit(0);
+ }
+
+ print LOCKFILE "$$";
+}
+
+sub release_pid_lock() {
+ flock(LOCKFILE, LOCK_UN);
+ close LOCKFILE;
+}
+
+# "main" ...
+
+$|=1; # autoflush
+
+process_options();
+
+daemonize();
+
+get_pid_lock();
+
+$SIG{CHLD} = \&REAPER;
+
+my $server = start_server($proto, $port);
+my $slct = IO::Select->new($server);
+
+while (1) {
+ my @ready_for_reading = $slct->can_read();
+ foreach my $fh (@ready_for_reading) {
+ if ($fh != $server) {
+ logmsg "select: fh ready for reading but not server",
+ "don't know what to do...";
+ }
+
+ # new connection:
+ my $client = $server->accept() or do {
+ # try again if accept() returned because
+ # a signal was received
+ if ($!{EINTR}) {
+ logmsg "accept: got signal EINTR ...";
+ next;
+ }
+ die "accept: $!";
+ };
+ my $client_ip = inet_ntoa($client->peeraddr);
+ logmsg "connection from $client_ip at port " . $client->peerport;
+ create_child($client, \&child_action, $client_ip);
+ close $client;
+ }
+}
+
+# never reached...
+logmsg "Server done - ooops!\n";
+
+release_pid_lock();
+
+exit(0);
+
+__END__
+
+=head1 webserver.pl
+
+A simple WEB server written in perl.
+
+=head1 SYNOPSIS
+
+webserver.pl [options]
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--help>
+
+Print a brief help message and exit.
+
+=item B<--port>
+
+Specify the port number for the server to listen on.
+
+=item B<--root|--document-root>
+
+Specify the document root directory from which to serve web content.
+
+=item B<--log-dir>
+
+Specify the directory where the log files should be stored.
+
+=item B<--pid-file>
+
+Specify the location of the pid lock file.
+
+=back
+
+=head1 DESCRIPTION
+
+This is a very simple web server. It currently does not deliver the specific web
+page requested, but constructs the same kind of answer for each request, citing
+a fortune if fortune is available, and printing the originating request.
+
+=cut