source: preprover/abac_preprover_server.pl @ a26520d

abac0-leakabac0-meicompt_changesgec13mei-idmei-rt0-nmei_rt0mei_rt2mei_rt2_fix_1meiyap-rt1meiyap1rt2tvf-new-xml 0.1.0
Last change on this file since a26520d was a26520d, checked in by Mike Ryan <mikeryan@…>, 14 years ago

intelligently display preprover results

  • Property mode set to 100755
File size: 2.0 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use Getopt::Long;
5use Data::Dumper;
6use IO::Socket::SSL;
7use XMLRPC;
8
9use lib '../swig/perl';
10use ABAC;
11
12ABAC::libabac_init;
13
14use constant {
15    PORT    => 8000,
16};
17
18my ($keystore, $cert, $key);
19my $port = 8000;
20GetOptions(
21    'keystore=s'    => \$keystore,
22    'port=i'        => \$port,
23    'cert=s'        => \$cert,
24    'key=s'        => \$key,
25) || usage();
26
27usage() unless defined $keystore && defined $cert && defined $key;
28
29my $ctx = ABAC::Context->new;
30$ctx->load_directory($keystore);
31
32my $server = XMLRPC->new();
33$server->add_method({
34    name        => 'abac.query',
35    code        => \&abac_query,
36    signature   => [ 'struct struct' ],
37});
38$server->run($port, $cert, $key);
39
40sub abac_query {
41    my ($server, $request) = @_;
42
43    my $peer_cert = $server->{peer_cert};
44    my $peer_id = ABAC::SSL_keyid($peer_cert);
45
46    # clone the context so the state remains pure between requests
47    my $local_ctx = ABAC::Context->new($ctx);
48    foreach my $cred (@{$request->{credentials}}) {
49        my $ret = $local_ctx->load_id_chunk($cred->{issuer_cert});
50        warn "Invalid issuer certificate" unless $ret == $ABAC::ABAC_CERT_SUCCESS;
51
52        $ret = $local_ctx->load_attribute_chunk($cred->{attribute_cert});
53        warn "Invalid attribute certificate" unless $ret == $ABAC::ABAC_CERT_SUCCESS;
54    }
55
56    my $role = $request->{role};
57    print "$role <- $peer_id\n";
58    my ($success, $credentials) = $local_ctx->query($role, $peer_id);
59
60    return {
61        success => $success,
62        map {{
63            attribute_cert  => RPC::XML::base64->new($_->attribute_cert),
64            issuer_cert     => RPC::XML::base64->new($_->issuer_cert),
65        }} @$credentials,
66    };
67}
68
69sub usage {
70    print "Usage: $0 \\\n";
71    print "        --keystore <keystore> [ --port <port> ] \\\n";
72    print "        --cert <cert.pem> --key <key.pem>\n";
73    print "    port defaults to 8000\n";
74    print "\n";
75    print "    cert and key must be an OpenSSL cert and key\n";
76    print "    ABAC cert and key will not work\n";
77    exit 1;
78}
Note: See TracBrowser for help on using the repository browser.