/usr/share/perl5/HTTP/Headers/Auth.pm is in libhttp-message-perl 6.11-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | package HTTP::Headers::Auth;
use strict;
use warnings;
our $VERSION = "6.11";
use HTTP::Headers;
package
HTTP::Headers;
BEGIN {
# we provide a new (and better) implementations below
undef(&www_authenticate);
undef(&proxy_authenticate);
}
require HTTP::Headers::Util;
sub _parse_authenticate
{
my @ret;
for (HTTP::Headers::Util::split_header_words(@_)) {
if (!defined($_->[1])) {
# this is a new auth scheme
push(@ret, shift(@$_) => {});
shift @$_;
}
if (@ret) {
# this a new parameter pair for the last auth scheme
while (@$_) {
my $k = shift @$_;
my $v = shift @$_;
$ret[-1]{$k} = $v;
}
}
else {
# something wrong, parameter pair without any scheme seen
# IGNORE
}
}
@ret;
}
sub _authenticate
{
my $self = shift;
my $header = shift;
my @old = $self->_header($header);
if (@_) {
$self->remove_header($header);
my @new = @_;
while (@new) {
my $a_scheme = shift(@new);
if ($a_scheme =~ /\s/) {
# assume complete valid value, pass it through
$self->push_header($header, $a_scheme);
}
else {
my @param;
if (@new) {
my $p = $new[0];
if (ref($p) eq "ARRAY") {
@param = @$p;
shift(@new);
}
elsif (ref($p) eq "HASH") {
@param = %$p;
shift(@new);
}
}
my $val = ucfirst(lc($a_scheme));
if (@param) {
my $sep = " ";
while (@param) {
my $k = shift @param;
my $v = shift @param;
if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") {
# must quote the value
$v =~ s,([\\\"]),\\$1,g;
$v = qq("$v");
}
$val .= "$sep$k=$v";
$sep = ", ";
}
}
$self->push_header($header, $val);
}
}
}
return unless defined wantarray;
wantarray ? _parse_authenticate(@old) : join(", ", @old);
}
sub www_authenticate { shift->_authenticate("WWW-Authenticate", @_) }
sub proxy_authenticate { shift->_authenticate("Proxy-Authenticate", @_) }
1;
|