home *** CD-ROM | disk | FTP | other *** search
/ ftp.f-secure.com / 2014.06.ftp.f-secure.com.tar / ftp.f-secure.com / support / hotfix / fsis / IS-SpamControl.fsfix / iufssc / lib / HTTP / Headers / Auth.pm next >
Text File  |  2006-11-29  |  2KB  |  99 lines
  1. package HTTP::Headers::Auth;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = sprintf("%d.%02d", q$Revision: 2397 $ =~ /(\d+)\.(\d+)/);
  6.  
  7. use HTTP::Headers;
  8.  
  9. package HTTP::Headers;
  10.  
  11. BEGIN {
  12.     # we provide a new (and better) implementations below
  13.     undef(&www_authenticate);
  14.     undef(&proxy_authenticate);
  15. }
  16.  
  17. require HTTP::Headers::Util;
  18.  
  19. sub _parse_authenticate
  20. {
  21.     my @ret;
  22.     for (HTTP::Headers::Util::split_header_words(@_)) {
  23.     if (!defined($_->[1])) {
  24.         # this is a new auth scheme
  25.         push(@ret, lc(shift @$_) => {});
  26.         shift @$_;
  27.     }
  28.     if (@ret) {
  29.         # this a new parameter pair for the last auth scheme
  30.         while (@$_) {
  31.         my $k = lc(shift @$_);
  32.         my $v = shift @$_;
  33.             $ret[-1]{$k} = $v;
  34.         }
  35.     }
  36.     else {
  37.         # something wrong, parameter pair without any scheme seen
  38.         # IGNORE
  39.     }
  40.     }
  41.     @ret;
  42. }
  43.  
  44. sub _authenticate
  45. {
  46.     my $self = shift;
  47.     my $header = shift;
  48.     my @old = $self->_header($header);
  49.     if (@_) {
  50.     $self->remove_header($header);
  51.     my @new = @_;
  52.     while (@new) {
  53.         my $a_scheme = shift(@new);
  54.         if ($a_scheme =~ /\s/) {
  55.         # assume complete valid value, pass it through
  56.         $self->push_header($header, $a_scheme);
  57.         }
  58.         else {
  59.         my @param;
  60.         if (@new) {
  61.             my $p = $new[0];
  62.             if (ref($p) eq "ARRAY") {
  63.             @param = @$p;
  64.             shift(@new);
  65.             }
  66.             elsif (ref($p) eq "HASH") {
  67.             @param = %$p;
  68.             shift(@new);
  69.             }
  70.         }
  71.         my $val = ucfirst(lc($a_scheme));
  72.         if (@param) {
  73.             my $sep = " ";
  74.             while (@param) {
  75.             my $k = shift @param;
  76.             my $v = shift @param;
  77.             if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") {
  78.                 # must quote the value
  79.                 $v =~ s,([\\\"]),\\$1,g;
  80.                 $v = qq("$v");
  81.             }
  82.             $val .= "$sep$k=$v";
  83.             $sep = ", ";
  84.             }
  85.         }
  86.         $self->push_header($header, $val);
  87.         }
  88.     }
  89.     }
  90.     return unless defined wantarray;
  91.     wantarray ? _parse_authenticate(@old) : join(", ", @old);
  92. }
  93.  
  94.  
  95. sub www_authenticate    { shift->_authenticate("WWW-Authenticate", @_)   }
  96. sub proxy_authenticate  { shift->_authenticate("Proxy-Authenticate", @_) }
  97.  
  98. 1;
  99.