Commit | Line | Data |
3fea05b9 |
1 | package HTTP::Headers::Auth; |
2 | |
3 | use strict; |
4 | use vars qw($VERSION); |
5 | $VERSION = "5.817"; |
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, shift(@$_) => {}); |
26 | shift @$_; |
27 | } |
28 | if (@ret) { |
29 | # this a new parameter pair for the last auth scheme |
30 | while (@$_) { |
31 | my $k = 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; |