source: preprover/server.pl @ 19be896

#!/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;
}