vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/base/http.t

   1 #!./perl -w
   2
   3 print "1..15\n";
   4
   5 use strict;
   6 #use Data::Dump ();
   7
   8 my $CRLF = "\015\012";
   9 my $LF   = "\012";
  10
  11 {
  12     package HTTP;
  13     use vars qw(@ISA);
  14     require Net::HTTP::Methods;
  15     @ISA=qw(Net::HTTP::Methods);
  16
  17     my %servers = (
  18       a => { "/" => "HTTP/1.0 200 OK${CRLF}Content-Type: text/plain${CRLF}Content-Length: 6${CRLF}${CRLF}Hello\n",
  19              "/bad1" => "HTTP/1.0 200 OK${LF}Server: foo${LF}HTTP/1.0 200 OK${LF}Content-type: text/foo${LF}${LF}abc\n",
  20              "/09" => "Hello${CRLF}World!${CRLF}",
  21              "/chunked" => "HTTP/1.1 200 OK${CRLF}Transfer-Encoding: chunked${CRLF}${CRLF}0002; foo=3; bar${CRLF}He${CRLF}1${CRLF}l${CRLF}2${CRLF}lo${CRLF}0000${CRLF}Content-MD5: xxx${CRLF}${CRLF}",
  22              "/head" => "HTTP/1.1 200 OK${CRLF}Content-Length: 16${CRLF}Content-Type: text/plain${CRLF}${CRLF}",
  23            },
  24     );
  25
  26     sub http_connect {
  27         my($self, $cnf) = @_;
  28         my $server = $servers{$cnf->{PeerAddr}} || return undef;
  29         ${*$self}{server} = $server;
  30         ${*$self}{read_chunk_size} = $cnf->{ReadChunkSize};
  31         return $self;
  32     }
  33
  34     sub print {
  35         my $self = shift;
  36         #Data::Dump::dump("PRINT", @_);
  37         my $in = shift;
  38         my($method, $uri) = split(' ', $in);
  39
  40         my $out;
  41         if ($method eq "TRACE") {
  42             my $len = length($in);
  43             $out = "HTTP/1.0 200 OK${CRLF}Content-Length: $len${CRLF}" .
  44                    "Content-Type: message/http${CRLF}${CRLF}" .
  45                    $in;
  46         }
  47         else {
  48             $out = ${*$self}{server}{$uri};
  49             $out = "HTTP/1.0 404 Not found${CRLF}${CRLF}" unless defined $out;
  50         }
  51
  52         ${*$self}{out} .= $out;
  53         return 1;
  54     }
  55
  56     sub sysread {
  57         my $self = shift;
  58         #Data::Dump::dump("SYSREAD", @_);
  59         my $length = $_[1];
  60         my $offset = $_[2] || 0;
  61
  62         if (my $read_chunk_size = ${*$self}{read_chunk_size}) {
  63             $length = $read_chunk_size if $read_chunk_size < $length;
  64         }
  65
  66         my $data = substr(${*$self}{out}, 0, $length, "");
  67         return 0 unless length($data);
  68
  69         $_[0] = "" unless defined $_[0];
  70         substr($_[0], $offset) = $data;
  71         return length($data);
  72     }
  73
  74     # ----------------
  75
  76     sub request {
  77         my($self, $method, $uri, $headers, $opt) = @_;
  78         $headers ||= [];
  79         $opt ||= {};
  80
  81         my($code, $message, @h);
  82         my $buf = "";
  83         eval {
  84             $self->write_request($method, $uri, @$headers) || die "Can't write request";
  85             ($code, $message, @h) = $self->read_response_headers(%$opt);
  86
  87             my $tmp;
  88             my $n;
  89             while ($n = $self->read_entity_body($tmp, 32)) {
  90                 #Data::Dump::dump($tmp, $n);
  91                 $buf .= $tmp;
  92             }
  93
  94             push(@h, $self->get_trailers);
  95
  96         };
  97
  98         my %res = ( code => $code,
  99                     message => $message,
 100                     headers => \@h,
 101                     content => $buf,
 102                   );
 103
 104         if ($@) {
 105             $res{error} = $@;
 106         }
 107
 108         return \%res;
 109     }
 110 }
 111
 112 # Start testing
 113 my $h;
 114 my $res;
 115
 116 $h = HTTP->new(Host => "a", KeepAlive => 1) || die;
 117 $res = $h->request(GET => "/");
 118
 119 #Data::Dump::dump($res);
 120
 121 print "not " unless $res->{code} eq "200" && $res->{content} eq "Hello\n";
 122 print "ok 1\n";
 123
 124 $res = $h->request(GET => "/404");
 125 print "not " unless $res->{code} eq "404";
 126 print "ok 2\n";
 127
 128 $res = $h->request(TRACE => "/foo");
 129 print "not " unless $res->{code} eq "200" &&
 130                     $res->{content} eq "TRACE /foo HTTP/1.1${CRLF}Keep-Alive: 300${CRLF}Connection: Keep-Alive${CRLF}Host: a${CRLF}${CRLF}";
 131 print "ok 3\n";
 132
 133 # try to turn off keep alive
 134 $h->keep_alive(0);
 135 $res = $h->request(TRACE => "/foo");
 136 print "not " unless $res->{code} eq "200" &&
 137                     $res->{content} eq "TRACE /foo HTTP/1.1${CRLF}Connection: close${CRLF}Host: a${CRLF}${CRLF}";
 138 print "ok 4\n";
 139
 140 # try a bad one
 141 $res = $h->request(GET => "/bad1", [], {laxed => 1});
 142 print "not " unless $res->{code} eq "200" && $res->{message} eq "OK" &&
 143                     "@{$res->{headers}}" eq "Server foo Content-type text/foo" &&
 144                     $res->{content} eq "abc\n";
 145 print "ok 5\n";
 146
 147 $res = $h->request(GET => "/bad1");
 148 print "not " unless $res->{error} =~ /Bad header/ && !$res->{code};
 149 print "ok 6\n";
 150 $h = undef;  # it is in a bad state now
 151
 152 $h = HTTP->new("a") || die;  # reconnect
 153 $res = $h->request(GET => "/09", [], {laxed => 1});
 154 print "not " unless $res->{code} eq "200" && $res->{message} eq "Assumed OK" &&
 155                     $res->{content} eq "Hello${CRLF}World!${CRLF}" &&
 156                     $h->peer_http_version eq "0.9";
 157 print "ok 7\n";
 158
 159 $res = $h->request(GET => "/09");
 160 print "not " unless $res->{error} =~ /^Bad response status line: 'Hello'/;
 161 print "ok 8\n";
 162 $h = undef;  # it's in a bad state again
 163
 164 $h = HTTP->new(Host => "a", KeepAlive => 1, ReadChunkSize => 1) || die;  # reconnect
 165 $res = $h->request(GET => "/chunked");
 166 print "not " unless $res->{code} eq "200" && $res->{content} eq "Hello" &&
 167                     "@{$res->{headers}}" eq "Transfer-Encoding chunked Content-MD5 xxx";
 168 print "ok 9\n";
 169
 170 # once more
 171 $res = $h->request(GET => "/chunked");
 172 print "not " unless $res->{code} eq "200" && $res->{content} eq "Hello" &&
 173                     "@{$res->{headers}}" eq "Transfer-Encoding chunked Content-MD5 xxx";
 174 print "ok 10\n";
 175
 176 # test head
 177 $res = $h->request(HEAD => "/head");
 178 print "not " unless $res->{code} eq "200" && $res->{content} eq "" &&
 179                     "@{$res->{headers}}"  eq "Content-Length 16 Content-Type text/plain";
 180 print "ok 11\n";
 181
 182 $res = $h->request(GET => "/");
 183 print "not " unless $res->{code} eq "200" && $res->{content} eq "Hello\n";
 184 print "ok 12\n";
 185 #use Data::Dump; Data::Dump::dump($res);
 186
 187
 188 $h = HTTP->new(Host => undef, PeerAddr => "a", );
 189 $h->http_version("1.0");
 190 print "not " if defined $h->host;
 191 print "ok 13\n";
 192 $res = $h->request(TRACE => "/");
 193 print "not " unless $res->{code} eq "200" && $res->{content} eq "TRACE / HTTP/1.0\r\n\r\n";
 194 print "ok 14\n";
 195
 196 require Net::HTTP;
 197 eval {
 198     $h = Net::HTTP->new;
 199 };
 200 print "# $@";
 201 print "not " unless $@;
 202 print "ok 15\n";
 203