vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/live/jigsaw-auth-b.t

   1 print "1..3\n";
   2
   3 use strict;
   4 use LWP::UserAgent;
   5
   6 my $ua = LWP::UserAgent->new(keep_alive => 1);
   7
   8 my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Basic/");
   9
  10 my $res = $ua->request($req);
  11
  12 #print $res->as_string;
  13
  14 print "not " unless $res->code eq "401";
  15 print "ok 1\n";
  16
  17 $req->authorization_basic('guest', 'guest');
  18 $res = $ua->request($req);
  19
  20 #print $res->as_string;
  21 print "not " unless $res->code eq "200" && $res->content =~ /Your browser made it!/;
  22 print "ok 2\n";
  23
  24 {
  25    package MyUA;
  26    use vars qw(@ISA);
  27    @ISA = qw(LWP::UserAgent);
  28
  29    my @try = (['foo', 'bar'], ['', ''], ['guest', ''], ['guest', 'guest']);
  30
  31    sub get_basic_credentials {
  32         my($self,$realm, $uri, $proxy) = @_;
  33         print "$realm/$uri/$proxy\n";
  34         my $p = shift @try;
  35         print join("/", @$p), "\n";
  36         return @$p;
  37    }
  38
  39 }
  40
  41 $ua = MyUA->new(keep_alive => 1);
  42
  43 $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Basic/");
  44 $res = $ua->request($req);
  45
  46 #print $res->as_string;
  47
  48 print "not " unless $res->content =~ /Your browser made it!/ &&
  49                     $res->header("Client-Response-Num") == 5;
  50 print "ok 3\n";
  51