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

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