summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm98
1 files changed, 98 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm b/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm
new file mode 100755
index 00000000000..1e416e2dd9a
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm
@@ -0,0 +1,98 @@
+package HTTP::Headers::Auth;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = "5.817";
+
+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;