Index: preprover/XMLRPC.pm
===================================================================
--- preprover/XMLRPC.pm	(revision f7040d8685ecd4dfb134a7a00b0b33fba857cb7c)
+++ preprover/XMLRPC.pm	(revision f7040d8685ecd4dfb134a7a00b0b33fba857cb7c)
@@ -0,0 +1,92 @@
+package XMLRPC;
+
+use strict;
+use Carp;
+
+use HTTP::Daemon::SSL;
+use HTTP::Status qw(:constants);
+use RPC::XML::Server;
+use Net::SSLeay;
+
+sub new {
+    my ($class) = @_;
+
+    my $srv = RPC::XML::Server->new(no_http => 1);
+    return bless \$srv, $class;
+}
+
+sub add_method {
+    my $self = shift;
+    my $srv = $$self;
+    $srv->add_method(@_);
+}
+
+sub verify {
+    my ($ok, $store_ctx) = @_;
+
+    my $x = Net::SSLeay::X509_STORE_CTX_get_current_cert($store_ctx);
+    return $x ? 1 : 0;
+}
+
+sub run {
+    my ($self, $port) = @_;
+    croak "Must supply a port to run on" unless defined $port;
+
+    my $srv = $$self;
+
+    my $daemon = HTTP::Daemon::SSL->new(
+        LocalPort   => $port,
+        ReuseAddr   => 1,
+        SSL_verify_mode => 3,
+        SSL_ca_path => 'FAIL',  # if this isn't here, verify never gets called :D
+        SSL_verify_callback => \&verify,
+    ) or die "Can't start HTTP daemon: $!";
+
+    for ( ; ; ) {
+        while (my $client = $daemon->accept) {
+            my $pid = fork;
+            next if $pid;
+
+            my $peer_cert = $client->peer_certificate;
+            $srv->{peer_cert} = $peer_cert;
+
+            while (my $request = $client->get_request) {
+                # require an SSL certificate
+                if (!defined $srv->{peer_cert}) {
+                    my $response = HTTP::Response->new(HTTP_UNAUTHORIZED);
+                    $response->content("C'mon gimme a cert");
+                    $client->send_response($response);
+                    next;
+                }
+
+                # only handle POSTs to /RPC2
+                if ($request->method ne 'POST' || $request->url->path ne '/RPC2') {
+                    $client->send_error(HTTP_FORBIDDEN);
+                    next;
+                }
+
+                my $response;
+
+                eval {
+                    my $rpc_response = $srv->dispatch($request->content);
+                    my $content = $rpc_response->as_string;
+
+                    $response = HTTP::Response->new(HTTP_OK);
+                    $response->content($content);
+                };
+
+                # return an error on any kind of exception
+                if ($@) {
+                    $response = HTTP::Response->new(HTTP_BAD_REQUEST);
+                    $response->content('Are you even trying?');
+                }
+
+                $client->send_response($response);
+            }
+
+            exit;
+        }
+    }
+}
+
+1;
Index: preprover/client.pl
===================================================================
--- preprover/client.pl	(revision f7040d8685ecd4dfb134a7a00b0b33fba857cb7c)
+++ preprover/client.pl	(revision f7040d8685ecd4dfb134a7a00b0b33fba857cb7c)
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use Data::Dumper;
+use RPC::XML qw(smart_encode);
+use RPC::XML::ParserFactory;
+use LWP::UserAgent;
+use HTTP::Request;
+# use IO::Socket::SSL;
+
+use lib '../swig/perl';
+use ABAC;
+ABAC::libabac_init;
+
+use constant {
+    USER_AGENT  => 'libabac/0.1',
+};
+
+my ($keystore, $url) = @ARGV;
+die "Usage: $0 <keystore> <url>\n" unless defined $keystore && defined $url;
+
+# load the certificates
+my $context = ABAC::Context->new;
+$context->load_directory($keystore);
+
+# build the XML RPC request
+my $request = RPC::XML::request->new(
+    'abac.query',
+    smart_encode({
+        role => '3f1aca4c5911b345d81c5f1a77675dce13249d0c.fed_create',
+        credentials => [
+            map {{
+                attribute_cert  => RPC::XML::base64->new($_->attribute_cert),
+                issuer_cert     => RPC::XML::base64->new($_->issuer_cert),
+            }} @{$context->credentials}
+        ],
+    }),
+);
+
+# encode and send the HTTP POST
+my $request_body = $request->as_string;
+
+$ENV{HTTPS_CERT_FILE} = 'certs/mike-cert.pem';
+$ENV{HTTPS_KEY_FILE} = 'certs/mike-key.pem';
+
+my $ua = LWP::UserAgent->new;
+
+my $request = HTTP::Request->new(
+    'POST',
+    "https://$url/RPC2",
+);
+$request->header('User-Agent', USER_AGENT);
+$request->header('Content-Length', length $request_body);
+$request->content($request_body);
+
+my $response = $ua->request($request);
+if (!$response->is_success) {
+    die $response->status_line;
+}
+
+# decode the reply
+my $xmlrpc_response = RPC::XML::ParserFactory->new->parse($response->decoded_content);
+print Dumper $xmlrpc_response;
Index: preprover/server.pl
===================================================================
--- preprover/server.pl	(revision f7040d8685ecd4dfb134a7a00b0b33fba857cb7c)
+++ preprover/server.pl	(revision f7040d8685ecd4dfb134a7a00b0b33fba857cb7c)
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use Data::Dumper;
+use XMLRPC;
+
+use lib '../swig/perl';
+use ABAC;
+
+ABAC::libabac_init;
+
+use constant {
+    PORT    => 8000,
+};
+
+my $keystore = shift || die "Usage: $0 <keystore>\n";
+my $ctx = ABAC::Context->new;
+$ctx->load_directory($keystore);
+
+my $server = XMLRPC->new();
+$server->add_method({
+    name        => 'abac.query',
+    code        => \&abac_query,
+    signature   => [ 'struct struct' ],
+});
+$server->run(8000);
+
+sub abac_query {
+    my ($server, $request) = @_;
+
+    my $peer_cert = $server->{peer_cert};
+    my $peer_id = ABAC::SSL_keyid($peer_cert);
+
+    # clone the context so the state remains pure between requests
+    my $local_ctx = ABAC::Context->new($ctx);
+    foreach my $cred (@{$request->{credentials}}) {
+        my $ret = $local_ctx->load_id_chunk($cred->{issuer_cert});
+        warn "Invalid issuer certificate" unless $ret == $ABAC::ABAC_CERT_SUCCESS;
+
+        $ret = $local_ctx->load_attribute_chunk($cred->{attribute_cert});
+        warn "Invalid attribute certificate" unless $ret == $ABAC::ABAC_CERT_SUCCESS;
+    }
+
+    my $role = $request->{role};
+    print "$role <- $peer_id\n";
+    my ($success, $credentials) = $local_ctx->query($role, $peer_id);
+
+    return $success;
+}
