blob: 8fc398e0ce65f4f8748dbed4268ea63bb0fbed95 (
plain)
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
|
package LWP::Ping903;
use parent 'LWP::UserAgent';
use File::Spec;
use HTTP::Status qw(:constants);
use strict;
use warnings;
use Carp;
my $VERSION = '0.3';
sub new {
my $class = shift;
my $self = bless $class->SUPER::new(@_), $class;
$self->agent("$class/$VERSION");
return $self;
}
sub get_basic_credentials {
my ($self, $realm, $uri, $isproxy) = @_;
my $cf = File::Spec->catfile($ENV{HOME}, ".ping903.cred");
if (open(my $fh, '<', $cf)) {
while (<$fh>) {
chomp;
s/^\s+//;
s/\s+$//;
next if /^(#.*)?$/;
my @words;
while ($_) {
no warnings 'uninitialized';
if (s/^"(.*?)(?<!\\)"(?:\s+(.*))?$/$2/) {
(my $s = $1) =~ s/\\([\\\"])/$1/g;
push @words, $s;
} else {
s/^(.+?)(?:\s+(.+))?$/$2/;
push @words, $1;
}
}
if (@words == 4) {
my($h,$p) = split /:/, $words[0], 2;
if (($h eq '*' || $h eq $uri->host)
&& (!$p || $p eq '*' || $p eq $uri->port)
&& ($words[1] eq $realm || $words[1] eq '*')) {
return @words[2..3];
}
}
}
}
return ();
}
|