Implememt client-side basic auth

* lib/Makefile.am: Add base64.c
* lib/base64.c: New file.
* lib/basicauth.c: Move base64 support to a separate source.
* lib/basicauth.h (base64_encode,base64_decode): New protos.

* src/strsplit.c: New file.
* src/Makefile.am (libping903_a_SOURCES): Add strsplit.c
* src/defs.h (CRED_FILE_NAME): New macro.
(ecalloc,strsplit,argcv_free): New proto.
* src/mem.c (ecalloc): New function.
* src/ping903.c (strsplit): Remove.
(cf_auth): Use modified strsplit.
* src/ping903q.c (http_query): Attempt to authenticate
if basic auth is required.

* examples/lib/LWP/Ping903.pm: New file.
* examples/dbload: Use LWP::Ping903
* examples/inspect: Likewise.
* examples/ipadd: Likewise.
* examples/ipdel: Likewise.

5 files changed, 68 insertions, 10 deletions

diff --git a/examples/dbload b/examples/dbload
index 6b776e4..f3e9ec2 100755
--- a/examples/dbload
+++ b/examples/dbload
@@ -164,7 +164,7 @@ L<DBI>.
 use strict;
 use warnings;
 use JSON;
-use LWP::UserAgent;
+use LWP::Ping903;
 use DBI;
 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
 use File::Spec;
@@ -238,7 +238,7 @@ my $json_text = JSON->new->encode({
 	'ip-list' => [ map { $_->[0] } @$res ]
   });
 
-my $ua = new LWP::UserAgent;
+my $ua = new LWP::Ping903;
 
 my $response = $ua->post("$baseurl/config/ip-list",
 			 'Content-Type' => 'application/json',
diff --git a/examples/inspect b/examples/inspect
index beebc17..6aacad4 100755
--- a/examples/inspect
+++ b/examples/inspect
@@ -57,13 +57,16 @@ L<DBI>.
 
 use strict;
 use warnings;
-use LWP::UserAgent;
+use LWP::Ping903;
+use HTTP::Status qw(:constants);
 use JSON;
 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
 use Pod::Usage;
 use Pod::Man;
 
 my $baseurl = 'http://localhost:8080';
+my $user;
+my $password;
 
 GetOptions(
     'U|url=s' => \$baseurl,
@@ -80,9 +83,17 @@ GetOptions(
 ) or exit(1);
 die "too many arguments; try `$0 --help' for more info\n" if @ARGV;
 
-my $ua = new LWP::UserAgent;
+my $ua = new LWP::Ping903;
+
 my $response = $ua->get("$baseurl/config");
 unless ($response->is_success) {
+    if ($response->code eq HTTP_UNAUTHORIZED) {
+	my $s = $response->header('WWW-Authenticate');
+	$s =~ s/Basic realm=//;
+	$s =~ s/^"(.*)"$/$1/;
+	$s =~ s/\\([\\\"])/$1/g;
+	die "$s: not authorized";
+    }
     die $response->status_line;
 }
 
@@ -111,5 +122,3 @@ if (@{$resp->{'ip-list'}}) {
     }
     print "EOF\n";
 }
-
-
diff --git a/examples/ipadd b/examples/ipadd
index f001950..d6195da 100755
--- a/examples/ipadd
+++ b/examples/ipadd
@@ -57,7 +57,7 @@ L<DBI>.
 
 use strict;
 use warnings;
-use LWP::UserAgent;
+use LWP::Ping903;
 use JSON;
 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
 use Pod::Usage;
@@ -82,7 +82,7 @@ GetOptions(
 my $ip = shift @ARGV or die "not enough arguments";
 die "too many arguments; try `$0 --help' for more info\n" if @ARGV;
 
-my $ua = new LWP::UserAgent;
+my $ua = new LWP::Ping903;
 my $response = $ua->put("$baseurl/config/ip-list/$ip");
 unless ($response->is_success) {
     print $response->status_line,"\n";
diff --git a/examples/ipdel b/examples/ipdel
index fa4cb8f..8eed7eb 100755
--- a/examples/ipdel
+++ b/examples/ipdel
@@ -57,7 +57,7 @@ L<DBI>.
 
 use strict;
 use warnings;
-use LWP::UserAgent;
+use LWP::Ping903;
 use JSON;
 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
 use Pod::Usage;
@@ -83,7 +83,7 @@ my $ip = shift @ARGV or die "not enough arguments";
 die "too many arguments; try `$0 --help' for more info\n" if @ARGV;
 
 
-my $ua = new LWP::UserAgent;
+my $ua = new LWP::Ping903;
 my $response = $ua->delete("$baseurl/config/ip-list/$ip");
 unless ($response->is_success) {
     print $response->status_line,"\n";
diff --git a/examples/lib/LWP/Ping903.pm b/examples/lib/LWP/Ping903.pm
new file mode 100644
index 0000000..8fc398e
--- /dev/null
+++ b/examples/lib/LWP/Ping903.pm
@@ -0,0 +1,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 ();
+}