HTTP-Daemon-6.01HEADHTTP-Daemon-6.01master

6 files changed, 927 insertions, 0 deletions

diff --git a/t/chunked.t b/t/chunked.t
new file mode 100644
index 0000000..e11799f
--- /dev/null
+++ b/t/chunked.t
@@ -0,0 +1,184 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Config;
+use HTTP::Daemon;
+use Test::More;
+# use Time::HiRes qw(sleep);
+our $CRLF;
+use Socket qw($CRLF);
+
+our $LOGGING = 0;
+
+our @TESTS = (
+              {
+               expect => 629,
+               comment => "traditional, unchunked POST request",
+               raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
+User-Agent: UNTRUSTED/1.0
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 629
+Host: localhost
+
+JSR-205=0;font_small=15;png=1;jpg=1;alpha_channel=256;JSR-82=0;JSR-135=1;mot-wt=0;JSR-75-pim=0;pointer_motion_event=0;camera=1;free_memory=455472;heap_size=524284;cldc=CLDC-1.1;canvas_size_y=176;canvas_size_x=176;double_buffered=1;color=65536;JSR-120=1;JSR-184=1;JSR-180=0;JSR-75-file=0;push_socket=0;pointer_event=0;nokia-ui=1;java_platform=xxxxxxxxxxxxxxxxx/xxxxxxx;gif=1;midp=MIDP-1.0 MIDP-2.0;font_large=22;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;font_medium=18;fullscreen_canvas_size_y=220;fullscreen_canvas_size_x=176;java_locale=de;video_encoding=encoding=JPEG&width=176&height=182encoding=JPEG&width=176&height=220;"
+              },
+              {
+               expect => 8,
+               comment => "chunked with illegal Content-Length header; tiny message",
+               raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
+Host: localhost
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 8
+Transfer-Encoding: chunked
+
+8
+icm.x=u2
+0
+
+",
+              },
+              {
+               expect => 868,
+               comment => "chunked with illegal Content-Length header; medium sized",
+               raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
+Host:dev05
+Connection:close
+Content-Type:application/x-www-form-urlencoded
+Content-Length:868
+transfer-encoding:chunked
+
+364
+JSR-205=0;font_small=20;png=1;jpg=1;JSR-82=0;JSR-135=1;mot-wt=0;JSR-75-pim=0;http=1;pointer_motion_event=0;browser_launch=1;free_memory=733456;user_agent=xxxxxxxxx/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx;heap_size=815080;cldc=CLDC-1.0;canvas_size_y=182;canvas_size_x=176;double_buffered=1;NAVIGATION PRESS=20;JSR-184=0;JSR-120=1;color=32768;JSR-180=0;JSR-75-file=0;RIGHT SOFT KEY=22;NAVIGATION RIGHT=5;KEY *=42;push_socket=0;pointer_event=0;KEY #=35;KEY NUM 9=57;nokia-ui=0;KEY NUM 8=56;KEY NUM 7=55;KEY NUM 6=54;KEY NUM 5=53;gif=1;KEY NUM 4=52;NAVIGATION UP=1;KEY NUM 3=51;KEY NUM 2=50;KEY NUM 1=49;midp=MIDP-2.0 VSCL-1.1.0;font_large=20;KEY NUM 0=48;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;NAVIGATION LEFT=2;LEFT SOFT KEY=21;font_medium=20;fullscreen_canvas_size_y=204;fullscreen_canvas_size_x=176;https=1;NAVIGATION DOWN=6;java_locale=en-DE;
+0
+
+",
+              },
+              {
+               expect => 1104,
+               comment => "chunked correctly, size ~1k; base for the big next test",
+               raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
+User-Agent: UNTRUSTED/1.0
+Content-Type: application/x-www-form-urlencoded
+Host: localhost:80
+Transfer-Encoding: chunked
+
+450
+JSR-205=0;font_small=15;png=1;jpg=1;jsr184_dithering=0;CLEAR/DELETE=-8;JSR-82=0;alpha_channel=32;JSR-135=1;mot-wt=0;JSR-75-pim=0;http=1;pointer_motion_event=0;browser_launch=1;BACK/RETURN=-11;camera=1;free_memory=456248;user_agent=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx;heap_size=524284;cldc=CLDC-1.1;canvas_size_y=176;canvas_size_x=176;double_buffered=1;NAVIGATION PRESS=-5;JSR-184=1;JSR-120=1;color=65536;JSR-180=0;JSR-75-file=0;RIGHT SOFT KEY=-7;NAVIGATION RIGHT=-4;KEY *=42;push_socket=0;pointer_event=0;KEY #=35;KEY NUM 9=57;nokia-ui=1;KEY NUM 8=56;KEY NUM 7=55;KEY NUM 6=54;KEY NUM 5=53;java_platform=xxxxxxxxxxxxxxxxx/xxxxxxx;KEY NUM 4=52;gif=1;KEY NUM 3=51;NAVIGATION UP=-1;KEY NUM 2=50;KEY NUM 1=49;midp=MIDP-1.0 MIDP-2.0;font_large=22;KEY NUM 0=48;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;NAVIGATION LEFT=-3;LEFT SOFT KEY=-6;jsr184_antialiasing=0;font_medium=18;fullscreen_canvas_size_y=220;fullscreen_canvas_size_x=176;https=1;NAVIGATION DOWN=-2;java_locale=de;video_encoding=encoding=JPEG&width=176&height=182encoding=JPEG&width=176&height=220;
+0
+
+"
+              },
+              {
+               expect => 1104*1024,
+               comment => "chunked with many chunks",
+               raw => ("POST /cgi-bin/redir-TE.pl HTTP/1.1
+User-Agent: UNTRUSTED/1.0
+Content-Type: application/x-www-form-urlencoded
+Host: localhost:80
+Transfer-Encoding: chunked
+
+".("450
+JSR-205=0;font_small=15;png=1;jpg=1;jsr184_dithering=0;CLEAR/DELETE=-8;JSR-82=0;alpha_channel=32;JSR-135=1;mot-wt=0;JSR-75-pim=0;http=1;pointer_motion_event=0;browser_launch=1;BACK/RETURN=-11;camera=1;free_memory=456248;user_agent=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx;heap_size=524284;cldc=CLDC-1.1;canvas_size_y=176;canvas_size_x=176;double_buffered=1;NAVIGATION PRESS=-5;JSR-184=1;JSR-120=1;color=65536;JSR-180=0;JSR-75-file=0;RIGHT SOFT KEY=-7;NAVIGATION RIGHT=-4;KEY *=42;push_socket=0;pointer_event=0;KEY #=35;KEY NUM 9=57;nokia-ui=1;KEY NUM 8=56;KEY NUM 7=55;KEY NUM 6=54;KEY NUM 5=53;java_platform=xxxxxxxxxxxxxxxxx/xxxxxxx;KEY NUM 4=52;gif=1;KEY NUM 3=51;NAVIGATION UP=-1;KEY NUM 2=50;KEY NUM 1=49;midp=MIDP-1.0 MIDP-2.0;font_large=22;KEY NUM 0=48;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;NAVIGATION LEFT=-3;LEFT SOFT KEY=-6;jsr184_antialiasing=0;font_medium=18;fullscreen_canvas_size_y=220;fullscreen_canvas_size_x=176;https=1;NAVIGATION DOWN=-2;java_locale=de;video_encoding=encoding=JPEG&width=176&height=182encoding=JPEG&width=176&height=220;
+"x1024)."0
+
+")
+              },
+             );
+
+
+my $can_fork = $Config{d_fork} ||
+  (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+   $Config{useithreads} and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
+
+my $tests = @TESTS;
+my $tport = 8333;
+
+my $tsock = IO::Socket::INET->new(LocalAddr => '0.0.0.0',
+                                  LocalPort => $tport,
+                                  Listen    => 1,
+                                  ReuseAddr => 1);
+if (!$can_fork) {
+  plan skip_all => "This system cannot fork";
+}
+elsif (!$tsock) {
+  plan skip_all => "Cannot listen on 0.0.0.0:$tport";
+}
+else {
+  close $tsock;
+  plan tests => $tests;
+}
+
+sub mywarn ($) {
+  return unless $LOGGING;
+  my($mess) = @_;
+  open my $fh, ">>", "http-daemon.out"
+    or die $!;
+  my $ts = localtime;
+  print $fh "$ts: $mess\n";
+  close $fh or die $!;
+}
+
+
+my $pid;
+if ($pid = fork) {
+  sleep 4;
+  for my $t (0..$#TESTS) {
+    my $test = $TESTS[$t];
+    my $raw = $test->{raw};
+    $raw =~ s/\r?\n/$CRLF/mg;
+    if (0) {
+      open my $fh, "| socket localhost $tport" or die;
+      print $fh $test;
+    }
+    use IO::Socket::INET;
+    my $sock = IO::Socket::INET->new(
+                                     PeerAddr => "127.0.0.1",
+                                     PeerPort => $tport,
+                                    ) or die;
+    if (0) {
+      for my $pos (0..length($raw)-1) {
+        print $sock substr($raw,$pos,1);
+        sleep 0.001;
+      }
+    } else {
+      print $sock $raw;
+    }
+    local $/;
+    my $resp = <$sock>;
+    close $sock;
+    my($got) = $resp =~ /\r?\n\r?\n(\d+)/s;
+    is($got,
+       $test->{expect},
+       "[$test->{expect}] $test->{comment}",
+      );
+  }
+  wait;
+} else {
+  die "cannot fork: $!" unless defined $pid;
+  my $d = HTTP::Daemon->new(
+                            LocalAddr => '0.0.0.0',
+                            LocalPort => $tport,
+                            ReuseAddr => 1,
+                           ) or die;
+  mywarn "Starting new daemon as '$$'";
+  my $i;
+  LISTEN: while (my $c = $d->accept) {
+    my $r = $c->get_request;
+    mywarn sprintf "headers[%s] content[%s]", $r->headers->as_string, $r->content;
+    my $res = HTTP::Response->new(200,undef,undef,length($r->content).$CRLF);
+    $c->send_response($res);
+    $c->force_last_request; # we're just not mature enough
+    $c->close;
+    undef($c);
+    last if ++$i >= $tests;
+  }
+}
+
+
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 2
+# End:
diff --git a/t/local/http.t b/t/local/http.t
new file mode 100644
index 0000000..421e7a3
--- /dev/null
+++ b/t/local/http.t
@@ -0,0 +1,380 @@
+if ($^O eq "MacOS") {
+    print "1..0\n";
+    exit(0);
+}
+
+unless (-f "CAN_TALK_TO_OURSELF") {
+    print "1..0 # Skipped: Can't talk to ourself (misconfigured system)\n";
+    exit;
+}
+
+$| = 1; # autoflush
+
+require IO::Socket;  # make sure this work before we try to make a HTTP::Daemon
+
+# First we make ourself a daemon in another process
+my $D = shift || '';
+if ($D eq 'daemon') {
+
+    require HTTP::Daemon;
+
+    my $d = HTTP::Daemon->new(Timeout => 10);
+
+    print "Please to meet you at: <URL:", $d->url, ">\n";
+    open(STDOUT, $^O eq 'VMS'? ">nl: " : ">/dev/null");
+
+    while ($c = $d->accept) {
+	$r = $c->get_request;
+	if ($r) {
+	    my $p = ($r->uri->path_segments)[1];
+	    my $func = lc("httpd_" . $r->method . "_$p");
+	    if (defined &$func) {
+		&$func($c, $r);
+	    }
+	    else {
+		$c->send_error(404);
+	    }
+	}
+	$c = undef;  # close connection
+    }
+    print STDERR "HTTP Server terminated\n";
+    exit;
+}
+else {
+    use Config;
+    my $perl = $Config{'perlpath'};
+    $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i;
+    open(DAEMON, "$perl local/http.t daemon |") or die "Can't exec daemon: $!";
+}
+
+use Test;
+plan tests => 54;
+
+my $greeting = <DAEMON>;
+$greeting =~ /(<[^>]+>)/;
+
+require URI;
+my $base = URI->new($1);
+sub url {
+   my $u = URI->new(@_);
+   $u = $u->abs($_[1]) if @_ > 1;
+   $u->as_string;
+}
+
+print "Will access HTTP server at $base\n";
+
+require LWP::UserAgent;
+require HTTP::Request;
+$ua = new LWP::UserAgent;
+$ua->agent("Mozilla/0.01 " . $ua->agent);
+$ua->from('gisle@aas.no');
+
+#----------------------------------------------------------------
+print "Bad request...\n";
+$req = new HTTP::Request GET => url("/not_found", $base);
+$req->header(X_Foo => "Bar");
+$res = $ua->request($req);
+
+ok($res->is_error);
+ok($res->code, 404);
+ok($res->message, qr/not\s+found/i);
+# we also expect a few headers
+ok($res->server);
+ok($res->date);
+
+#----------------------------------------------------------------
+print "Simple echo...\n";
+sub httpd_get_echo
+{
+    my($c, $req) = @_;
+    $c->send_basic_header(200);
+    print $c "Content-Type: message/http\015\012";
+    $c->send_crlf;
+    print $c $req->as_string;
+}
+
+$req = new HTTP::Request GET => url("/echo/path_info?query", $base);
+$req->push_header(Accept => 'text/html');
+$req->push_header(Accept => 'text/plain; q=0.9');
+$req->push_header(Accept => 'image/*');
+$req->push_header(':foo_bar' => 1);
+$req->if_modified_since(time - 300);
+$req->header(Long_text => 'This is a very long header line
+which is broken between
+more than one line.');
+$req->header(X_Foo => "Bar");
+
+$res = $ua->request($req);
+#print $res->as_string;
+
+ok($res->is_success);
+ok($res->code, 200);
+ok($res->message, "OK");
+
+$_ = $res->content;
+@accept = /^Accept:\s*(.*)/mg;
+
+ok($_, qr/^From:\s*gisle\@aas\.no\n/m);
+ok($_, qr/^Host:/m);
+ok(@accept, 3);
+ok($_, qr/^Accept:\s*text\/html/m);
+ok($_, qr/^Accept:\s*text\/plain/m);
+ok($_, qr/^Accept:\s*image\/\*/m);
+ok($_, qr/^If-Modified-Since:\s*\w{3},\s+\d+/m);
+ok($_, qr/^Long-Text:\s*This.*broken between/m);
+ok($_, qr/^Foo-Bar:\s*1\n/m);
+ok($_, qr/^X-Foo:\s*Bar\n/m);
+ok($_, qr/^User-Agent:\s*Mozilla\/0.01/m);
+
+# Try it with the higher level 'get' interface
+$res = $ua->get(url("/echo/path_info?query", $base),
+    Accept => 'text/html',
+    Accept => 'text/plain; q=0.9',
+    Accept => 'image/*',
+    X_Foo => "Bar",
+);
+#$res->dump;
+ok($res->code, 200);
+ok($res->content, qr/^From: gisle\@aas.no$/m);
+
+#----------------------------------------------------------------
+print "Send file...\n";
+
+my $file = "test-$$.html";
+open(FILE, ">$file") or die "Can't create $file: $!";
+binmode FILE or die "Can't binmode $file: $!";
+print FILE <<EOT;
+<html><title>En prøve</title>
+<h1>Dette er en testfil</h1>
+Jeg vet ikke hvor stor fila behøver å være heller, men dette
+er sikkert nok i massevis.
+EOT
+close(FILE);
+
+sub httpd_get_file
+{
+    my($c, $r) = @_;
+    my %form = $r->uri->query_form;
+    my $file = $form{'name'};
+    $c->send_file_response($file);
+    unlink($file) if $file =~ /^test-/;
+}
+
+$req = new HTTP::Request GET => url("/file?name=$file", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+
+ok($res->is_success);
+ok($res->content_type, 'text/html');
+ok($res->content_length, 147);
+ok($res->title, 'En prøve');
+ok($res->content, qr/å være/);
+
+# A second try on the same file, should fail because we unlink it
+$res = $ua->request($req);
+#print $res->as_string;
+ok($res->is_error);
+ok($res->code, 404);   # not found
+		
+# Then try to list current directory
+$req = new HTTP::Request GET => url("/file?name=.", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+ok($res->code, 501);   # NYI
+
+
+#----------------------------------------------------------------
+print "Check redirect...\n";
+sub httpd_get_redirect
+{
+   my($c) = @_;
+   $c->send_redirect("/echo/redirect");
+}
+
+$req = new HTTP::Request GET => url("/redirect/foo", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+
+ok($res->is_success);
+ok($res->content, qr|/echo/redirect|);
+ok($res->previous->is_redirect);
+ok($res->previous->code, 301);
+
+# Let's test a redirect loop too
+sub httpd_get_redirect2 { shift->send_redirect("/redirect3/") }
+sub httpd_get_redirect3 { shift->send_redirect("/redirect2/") }
+
+$req->uri(url("/redirect2", $base));
+$ua->max_redirect(5);
+$res = $ua->request($req);
+#print $res->as_string;
+ok($res->is_redirect);
+ok($res->header("Client-Warning"), qr/loop detected/i);
+ok($res->redirects, 5);
+
+$ua->max_redirect(0);
+$res = $ua->request($req);
+ok($res->previous, undef);
+ok($res->redirects, 0);
+$ua->max_redirect(5);
+
+#----------------------------------------------------------------
+print "Check basic authorization...\n";
+sub httpd_get_basic
+{
+    my($c, $r) = @_;
+    #print STDERR $r->as_string;
+    my($u,$p) = $r->authorization_basic;
+    if (defined($u) && $u eq 'ok 12' && $p eq 'xyzzy') {
+        $c->send_basic_header(200);
+	print $c "Content-Type: text/plain";
+	$c->send_crlf;
+	$c->send_crlf;
+	$c->print("$u\n");
+    }
+    else {
+        $c->send_basic_header(401);
+	$c->print("WWW-Authenticate: Basic realm=\"libwww-perl\"\015\012");
+	$c->send_crlf;
+    }
+}
+
+{
+   package MyUA; @ISA=qw(LWP::UserAgent);
+   sub get_basic_credentials {
+      my($self, $realm, $uri, $proxy) = @_;
+      if ($realm eq "libwww-perl" && $uri->rel($base) eq "basic") {
+	  return ("ok 12", "xyzzy");
+      }
+      else {
+          return undef;
+      }
+   }
+}
+$req = new HTTP::Request GET => url("/basic", $base);
+$res = MyUA->new->request($req);
+#print $res->as_string;
+
+ok($res->is_success);
+#print $res->content;
+
+# Let's try with a $ua that does not pass out credentials
+$res = $ua->request($req);
+ok($res->code, 401);
+
+# Let's try to set credentials for this realm
+$ua->credentials($req->uri->host_port, "libwww-perl", "ok 12", "xyzzy");
+$res = $ua->request($req);
+ok($res->is_success);
+
+# Then illegal credentials
+$ua->credentials($req->uri->host_port, "libwww-perl", "user", "passwd");
+$res = $ua->request($req);
+ok($res->code, 401);
+
+
+#----------------------------------------------------------------
+print "Check proxy...\n";
+sub httpd_get_proxy
+{
+   my($c,$r) = @_;
+   if ($r->method eq "GET" and
+       $r->uri->scheme eq "ftp") {
+       $c->send_basic_header(200);
+       $c->send_crlf;
+   }
+   else {
+       $c->send_error;
+   }
+}
+
+$ua->proxy(ftp => $base);
+$req = new HTTP::Request GET => "ftp://ftp.perl.com/proxy";
+$res = $ua->request($req);
+#print $res->as_string;
+ok($res->is_success);
+
+#----------------------------------------------------------------
+print "Check POSTing...\n";
+sub httpd_post_echo
+{
+   my($c,$r) = @_;
+   $c->send_basic_header;
+   $c->print("Content-Type: text/plain");
+   $c->send_crlf;
+   $c->send_crlf;
+
+   # Do it the hard way to test the send_file
+   open(TMP, ">tmp$$") || die;
+   binmode(TMP);
+   print TMP $r->as_string;
+   close(TMP) || die;
+
+   $c->send_file("tmp$$");
+
+   unlink("tmp$$");
+}
+
+$req = new HTTP::Request POST => url("/echo/foo", $base);
+$req->content_type("application/x-www-form-urlencoded");
+$req->content("foo=bar&bar=test");
+$res = $ua->request($req);
+#print $res->as_string;
+
+$_ = $res->content;
+ok($res->is_success);
+ok($_, qr/^Content-Length:\s*16$/mi);
+ok($_, qr/^Content-Type:\s*application\/x-www-form-urlencoded$/mi);
+ok($_, qr/^foo=bar&bar=test$/m);
+
+$req = HTTP::Request->new(POST => url("/echo/foo", $base));
+$req->content_type("multipart/form-data");
+$req->add_part(HTTP::Message->new(["Content-Type" => "text/plain"], "Hi\n"));
+$req->add_part(HTTP::Message->new(["Content-Type" => "text/plain"], "there\n"));
+$res = $ua->request($req);
+#print $res->as_string;
+ok($res->is_success);
+ok($res->content =~ /^Content-Type: multipart\/form-data; boundary=/m);
+
+#----------------------------------------------------------------
+print "Check partial content response...\n";
+sub httpd_get_partial
+{
+   my($c) = @_;
+    $c->send_basic_header(206);
+    print $c "Content-Type: image/jpeg\015\012";
+    $c->send_crlf;
+    print $c "some fake JPEG content";
+
+}
+
+{
+    $req = HTTP::Request->new(  GET => url("/partial", $base) );
+    $res = $ua->request($req);
+    ok($res->is_success); # "a 206 response is considered successful"
+}
+{
+    $ua->max_size(3);
+    $req = HTTP::Request->new(  GET => url("/partial", $base) );
+    $res = $ua->request($req);
+    ok($res->is_success); # "a 206 response is considered successful"
+    # Put max_size back how we found it. 
+    $ua->max_size(undef);
+    ok($res->as_string, qr/Client-Aborted: max_size/); # Client-Aborted is returned when max_size is given
+}
+
+
+#----------------------------------------------------------------
+print "Terminating server...\n";
+sub httpd_get_quit
+{
+    my($c) = @_;
+    $c->send_error(503, "Bye, bye");
+    exit;  # terminate HTTP server
+}
+
+$req = new HTTP::Request GET => url("/quit", $base);
+$res = $ua->request($req);
+
+ok($res->code, 503);
+ok($res->content, qr/Bye, bye/);
diff --git a/t/misc/httpd b/t/misc/httpd
new file mode 100755
index 0000000..f17a2bf
--- /dev/null
+++ b/t/misc/httpd
@@ -0,0 +1,31 @@
+#!/local/perl/bin/perl -w
+
+use HTTP::Daemon ();
+
+my $s = new HTTP::Daemon;
+die "Can't create daemon: $!" unless $s;
+
+print $s->url, "\n";
+
+my $c = $s->accept;
+die "Can't accept" unless $c;
+
+$c->timeout(60);
+my $req = $c->get_request;
+
+die "No request" unless $req;
+
+my $abs = $req->uri->abs;
+
+print $req->as_string;
+
+$c->send_file_response("/etc");
+
+#$c->send_redirect("http://www.sn.no/aas", 301, "<title>Piss off</title>");
+
+#my $res = HTTP::Response->new(400, undef,
+#			      HTTP::Headers->new(Foo => 'bar'),
+#			      "Gisle\n"
+#			     );
+#$c->send_response($res);
+
diff --git a/t/misc/httpd_term.pl b/t/misc/httpd_term.pl
new file mode 100755
index 0000000..ce38c22
--- /dev/null
+++ b/t/misc/httpd_term.pl
@@ -0,0 +1,25 @@
+#!/local/perl/bin/perl
+
+use HTTP::Daemon;
+#$HTTP::Daemon::DEBUG++;
+
+my $d = HTTP::Daemon->new(Timeout => 60);
+print "Please contact me at: <URL:", $d->url, ">\n";
+
+while (my $c = $d->accept) {
+  CONNECTION:
+    while (my $r = $c->get_request) {
+	print $r->as_string;
+	$c->autoflush;
+      RESPONSE:
+        while (<STDIN>) {
+	    last RESPONSE if $_ eq ".\n";
+	    last CONNECTION if $_ eq "..\n";
+	    print $c $_;
+	}
+	print "\nEOF\n";
+    }
+    print "CLOSE: ", $c->reason, "\n";
+    $c->close;
+    $c = undef;
+}
diff --git a/t/robot/ua-get.t b/t/robot/ua-get.t
new file mode 100644
index 0000000..5c18afa
--- /dev/null
+++ b/t/robot/ua-get.t
@@ -0,0 +1,156 @@
+if($^O eq "MacOS") {
+    print "1..0\n";
+    exit(0);
+}
+
+unless (-f "CAN_TALK_TO_OURSELF") {
+    print "1..0 # Skipped: Can't talk to ourself (misconfigured system)\n";
+    exit;
+}
+
+$| = 1; # autoflush
+require IO::Socket;  # make sure this work before we try to make a HTTP::Daemon
+
+# First we make ourself a daemon in another process
+my $D = shift || '';
+if ($D eq 'daemon') {
+
+    require HTTP::Daemon;
+
+    my $d = new HTTP::Daemon Timeout => 10;
+
+    print "Please to meet you at: <URL:", $d->url, ">\n";
+    open(STDOUT, $^O eq 'MSWin32' ?  ">nul" : $^O eq 'VMS' ? ">NL:"  : ">/dev/null");
+
+    while ($c = $d->accept) {
+	$r = $c->get_request;
+	if ($r) {
+	    my $p = ($r->uri->path_segments)[1];
+	    $p =~ s/\W//g;
+	    my $func = lc("httpd_" . $r->method . "_$p");
+	    #print STDERR "Calling $func...\n";
+            if (defined &$func) {
+		&$func($c, $r);
+	    }
+	    else {
+		$c->send_error(404);
+	    }
+	}
+	$c = undef;  # close connection
+    }
+    print STDERR "HTTP Server terminated\n";
+    exit;
+}
+else {
+    use Config;
+    my $perl = $Config{'perlpath'};
+    $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i;
+    open(DAEMON , "$perl robot/ua.t daemon |") or die "Can't exec daemon: $!";
+}
+
+print "1..8\n";
+
+
+$greating = <DAEMON>;
+$greating =~ /(<[^>]+>)/;
+
+require URI;
+my $base = URI->new($1);
+sub url {
+   my $u = URI->new(@_);
+   $u = $u->abs($_[1]) if @_ > 1;
+   $u->as_string;
+}
+
+print "Will access HTTP server at $base\n";
+
+require LWP::RobotUA;
+require HTTP::Request;
+$ua = new LWP::RobotUA 'lwp-spider/0.1', 'gisle@aas.no';
+$ua->delay(0.05);  # rather quick robot
+
+#----------------------------------------------------------------
+sub httpd_get_robotstxt
+{
+   my($c,$r) = @_;
+   $c->send_basic_header;
+   $c->print("Content-Type: text/plain");
+   $c->send_crlf;
+   $c->send_crlf;
+   $c->print("User-Agent: *
+Disallow: /private
+
+");
+}
+
+sub httpd_get_someplace
+{
+   my($c,$r) = @_;
+   $c->send_basic_header;
+   $c->print("Content-Type: text/plain");
+   $c->send_crlf;
+   $c->send_crlf;
+   $c->print("Okidok\n");
+}
+
+$res = $ua->get( url("/someplace", $base) );
+#print $res->as_string;
+print "not " unless $res->is_success;
+print "ok 1\n";
+
+$res = $ua->get( url("/private/place", $base) );
+#print $res->as_string;
+print "not " unless $res->code == 403
+                and $res->message =~ /robots.txt/;
+print "ok 2\n";
+
+
+$res = $ua->get( url("/foo", $base) );
+#print $res->as_string;
+print "not " unless $res->code == 404;  # not found
+print "ok 3\n";
+
+# Let the robotua generate "Service unavailable/Retry After response";
+$ua->delay(1);
+$ua->use_sleep(0);
+
+$res = $ua->get( url("/foo", $base) );
+#print $res->as_string;
+print "not " unless $res->code == 503   # Unavailable
+                and $res->header("Retry-After");
+print "ok 4\n";
+
+#----------------------------------------------------------------
+print "Terminating server...\n";
+sub httpd_get_quit
+{
+    my($c) = @_;
+    $c->send_error(503, "Bye, bye");
+    exit;  # terminate HTTP server
+}
+
+$ua->delay(0);
+
+$res = $ua->get( url("/quit", $base) );
+
+print "not " unless $res->code == 503 and $res->content =~ /Bye, bye/;
+print "ok 5\n";
+
+#---------------------------------------------------------------
+$ua->delay(1);
+
+# host_wait() should be around 60s now
+print "not " unless abs($ua->host_wait($base->host_port) - 60) < 5;
+print "ok 6\n";
+
+# Number of visits to this place should be 
+print "not " unless $ua->no_visits($base->host_port) == 4;
+print "ok 7\n";
+
+# RobotUA used to have problem with mailto URLs.
+$ENV{SENDMAIL} = "dummy";
+$res = $ua->get("mailto:gisle\@aas.no");
+#print $res->as_string;
+
+print "not " unless $res->code == 400 && $res->message eq "Library does not allow method GET for 'mailto:' URLs";
+print "ok 8\n";
diff --git a/t/robot/ua.t b/t/robot/ua.t
new file mode 100644
index 0000000..5f679ae
--- /dev/null
+++ b/t/robot/ua.t
@@ -0,0 +1,151 @@
+if($^O eq "MacOS") {
+    print "1..0\n";
+    exit(0);
+}
+
+unless (-f "CAN_TALK_TO_OURSELF") {
+    print "1..0 # Skipped: Can't talk to ourself (misconfigured system)\n";
+    exit;
+}
+
+$| = 1; # autoflush
+require IO::Socket;  # make sure this work before we try to make a HTTP::Daemon
+
+# First we make ourself a daemon in another process
+my $D = shift || '';
+if ($D eq 'daemon') {
+
+    require HTTP::Daemon;
+
+    my $d = new HTTP::Daemon Timeout => 10;
+
+    print "Please to meet you at: <URL:", $d->url, ">\n";
+    open(STDOUT, $^O eq 'MSWin32' ?  ">nul" : $^O eq 'VMS' ? ">NL:"  : ">/dev/null");
+
+    while ($c = $d->accept) {
+	$r = $c->get_request;
+	if ($r) {
+	    my $p = ($r->uri->path_segments)[1];
+	    $p =~ s/\W//g;
+	    my $func = lc("httpd_" . $r->method . "_$p");
+	    #print STDERR "Calling $func...\n";
+            if (defined &$func) {
+		&$func($c, $r);
+	    }
+	    else {
+		$c->send_error(404);
+	    }
+	}
+	$c = undef;  # close connection
+    }
+    print STDERR "HTTP Server terminated\n";
+    exit;
+}
+else {
+    use Config;
+    my $perl = $Config{'perlpath'};
+    $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i;
+    open(DAEMON , "$perl robot/ua.t daemon |") or die "Can't exec daemon: $!";
+}
+
+print "1..7\n";
+
+
+$greating = <DAEMON>;
+$greating =~ /(<[^>]+>)/;
+
+require URI;
+my $base = URI->new($1);
+sub url {
+   my $u = URI->new(@_);
+   $u = $u->abs($_[1]) if @_ > 1;
+   $u->as_string;
+}
+
+print "Will access HTTP server at $base\n";
+
+require LWP::RobotUA;
+require HTTP::Request;
+$ua = new LWP::RobotUA 'lwp-spider/0.1', 'gisle@aas.no';
+$ua->delay(0.05);  # rather quick robot
+
+#----------------------------------------------------------------
+sub httpd_get_robotstxt
+{
+   my($c,$r) = @_;
+   $c->send_basic_header;
+   $c->print("Content-Type: text/plain");
+   $c->send_crlf;
+   $c->send_crlf;
+   $c->print("User-Agent: *
+Disallow: /private
+
+");
+}
+
+sub httpd_get_someplace
+{
+   my($c,$r) = @_;
+   $c->send_basic_header;
+   $c->print("Content-Type: text/plain");
+   $c->send_crlf;
+   $c->send_crlf;
+   $c->print("Okidok\n");
+}
+
+$req = new HTTP::Request GET => url("/someplace", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+print "not " unless $res->is_success;
+print "ok 1\n";
+
+$req = new HTTP::Request GET => url("/private/place", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+print "not " unless $res->code == 403
+                and $res->message =~ /robots.txt/;
+print "ok 2\n";
+
+$req = new HTTP::Request GET => url("/foo", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+print "not " unless $res->code == 404;  # not found
+print "ok 3\n";
+
+# Let the robotua generate "Service unavailable/Retry After response";
+$ua->delay(1);
+$ua->use_sleep(0);
+$req = new HTTP::Request GET => url("/foo", $base);
+$res = $ua->request($req);
+#print $res->as_string;
+print "not " unless $res->code == 503   # Unavailable
+                and $res->header("Retry-After");
+print "ok 4\n";
+
+#----------------------------------------------------------------
+print "Terminating server...\n";
+sub httpd_get_quit
+{
+    my($c) = @_;
+    $c->send_error(503, "Bye, bye");
+    exit;  # terminate HTTP server
+}
+
+$ua->delay(0);
+$req = new HTTP::Request GET => url("/quit", $base);
+$res = $ua->request($req);
+
+print "not " unless $res->code == 503 and $res->content =~ /Bye, bye/;
+print "ok 5\n";
+
+#---------------------------------------------------------------
+$ua->delay(1);
+
+# host_wait() should be around 60s now
+print "not " unless abs($ua->host_wait($base->host_port) - 60) < 5;
+print "ok 6\n";
+
+# Number of visits to this place should be 
+print "not " unless $ua->no_visits($base->host_port) == 4;
+print "ok 7\n";
+