sjero.net Git - wget/blob - tests/HTTPServer.pm

   1 #!/usr/bin/perl -w
   2
   3 use HTTP::Daemon;
   4 use HTTP::Status;
   5 use HTTP::Headers;
   6 use HTTP::Response;
   7
   8 use strict;
   9
  10 package HTTPServer;
  11
  12 sub run_daemon {
  13     my %urls = @_;
  14     my $server = HTTP::Daemon->new (LocalAddr => 'localhost',
  15                                     LocalPort => '8080',
  16                                     ReuseAddr => 1) or die "Cannot create server!!!";
  17
  18     while (my $con = $server->accept) {
  19         while (my $req = $con->get_request) {
  20             # print STDERR "method: ", $req->method, "\n";
  21             if ($req->method eq "GET" and $urls{$req->url->path}) {
  22                 # print STDERR "requested URL: ", $req->url->path, "\n";
  23
  24                 # create response
  25                 my $tmp = $urls{$req->url->path};
  26                 my $resp = HTTP::Response->new ($tmp->{'code'},
  27                                                 $tmp->{'msg'});
  28                 # print STDERR "HTTP::Response: \n", $resp->as_string;
  29
  30                 # fill in headers
  31                 while (my ($name, $value) = each %{$tmp->{headers}}) {
  32                     # print STDERR "setting header: $name = $value\n";
  33                     $resp->header($name => $value);
  34                 }
  35                 # print STDERR "HTTP::Response with headers: \n", $resp->as_string;
  36
  37                 # fill in content
  38                 $resp->content($tmp->{content});
  39                 # print STDERR "HTTP::Response with content: \n", $resp->as_string;
  40
  41                 $con->send_response($resp);
  42                 # print STDERR "HTTP::Response sent: \n", $resp->as_string;
  43             } else {
  44                 print STDERR "requested wrong URL: ", $req->url->path, "\n";
  45                 $con->send_error($HTTP::Status::RC_FORBIDDEN);
  46             }
  47         }
  48         $con->close;
  49         undef($con);
  50     }
  51 }
  52
  53 sub run {
  54     my $pid = fork();
  55
  56     if($pid == 0) {
  57         run_daemon(@_);
  58     }
  59
  60     return $pid;
  61 }
  62
  63 1;
  64
  65 # vim: et ts=4 sw=4
  66