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