home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / LWP / Authen / Digest.pm < prev    next >
Encoding:
Perl POD Document  |  2008-10-20  |  1.8 KB  |  69 lines
  1. package LWP::Authen::Digest;
  2.  
  3. use strict;
  4. use base 'LWP::Authen::Basic';
  5.  
  6. require Digest::MD5;
  7.  
  8. sub auth_header {
  9.     my($class, $user, $pass, $request, $ua, $h) = @_;
  10.  
  11.     my $auth_param = $h->{auth_param};
  12.  
  13.     my $nc = sprintf "%08X", ++$ua->{authen_md5_nonce_count}{$auth_param->{nonce}};
  14.     my $cnonce = sprintf "%8x", time;
  15.  
  16.     my $uri = $request->url->path_query;
  17.     $uri = "/" unless length $uri;
  18.  
  19.     my $md5 = Digest::MD5->new;
  20.  
  21.     my(@digest);
  22.     $md5->add(join(":", $user, $auth_param->{realm}, $pass));
  23.     push(@digest, $md5->hexdigest);
  24.     $md5->reset;
  25.  
  26.     push(@digest, $auth_param->{nonce});
  27.  
  28.     if ($auth_param->{qop}) {
  29.     push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop});
  30.     }
  31.  
  32.     $md5->add(join(":", $request->method, $uri));
  33.     push(@digest, $md5->hexdigest);
  34.     $md5->reset;
  35.  
  36.     $md5->add(join(":", @digest));
  37.     my($digest) = $md5->hexdigest;
  38.     $md5->reset;
  39.  
  40.     my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque);
  41.     @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5");
  42.  
  43.     if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) {
  44.     @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
  45.     }
  46.  
  47.     my(@order) = qw(username realm qop algorithm uri nonce nc cnonce response);
  48.     if($request->method =~ /^(?:POST|PUT)$/) {
  49.     $md5->add($request->content);
  50.     my $content = $md5->hexdigest;
  51.     $md5->reset;
  52.     $md5->add(join(":", @digest[0..1], $content));
  53.     $md5->reset;
  54.     $resp{"message-digest"} = $md5->hexdigest;
  55.     push(@order, "message-digest");
  56.     }
  57.     push(@order, "opaque");
  58.     my @pairs;
  59.     for (@order) {
  60.     next unless defined $resp{$_};
  61.     push(@pairs, "$_=" . qq("$resp{$_}"));
  62.     }
  63.  
  64.     my $auth_value  = "Digest " . join(", ", @pairs);
  65.     return $auth_value;
  66. }
  67.  
  68. 1;
  69.