[f7040d8] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
[6159c8d] | 4 | use Getopt::Long; |
---|
[f7040d8] | 5 | use Data::Dumper; |
---|
| 6 | use RPC::XML qw(smart_encode); |
---|
[a26520d] | 7 | use RPC::XML::Parser; |
---|
| 8 | use Crypt::SSLeay; |
---|
[f7040d8] | 9 | use LWP::UserAgent; |
---|
| 10 | use HTTP::Request; |
---|
| 11 | |
---|
| 12 | use ABAC; |
---|
| 13 | |
---|
| 14 | use constant { |
---|
[19be896] | 15 | USER_AGENT => 'abac/0.1.0', |
---|
[f7040d8] | 16 | }; |
---|
| 17 | |
---|
[6159c8d] | 18 | my ($keystore, $cert, $key, $role); |
---|
| 19 | my $url = 'localhost:8000'; |
---|
| 20 | GetOptions( |
---|
| 21 | 'keystore=s' => \$keystore, |
---|
| 22 | 'url=s' => \$url, |
---|
| 23 | 'cert=s' => \$cert, |
---|
| 24 | 'key=s' => \$key, |
---|
| 25 | 'role=s' => \$role, |
---|
| 26 | ) || usage(); |
---|
| 27 | |
---|
| 28 | usage() unless defined $keystore && defined $cert && defined $key && defined $role; |
---|
| 29 | |
---|
| 30 | # code starts here |
---|
| 31 | ABAC::libabac_init; |
---|
[f7040d8] | 32 | |
---|
| 33 | # load the certificates |
---|
| 34 | my $context = ABAC::Context->new; |
---|
| 35 | $context->load_directory($keystore); |
---|
| 36 | |
---|
| 37 | # build the XML RPC request |
---|
| 38 | my $request = RPC::XML::request->new( |
---|
| 39 | 'abac.query', |
---|
| 40 | smart_encode({ |
---|
[6159c8d] | 41 | role => $role, |
---|
[f7040d8] | 42 | credentials => [ |
---|
| 43 | map {{ |
---|
| 44 | attribute_cert => RPC::XML::base64->new($_->attribute_cert), |
---|
| 45 | issuer_cert => RPC::XML::base64->new($_->issuer_cert), |
---|
| 46 | }} @{$context->credentials} |
---|
| 47 | ], |
---|
| 48 | }), |
---|
| 49 | ); |
---|
| 50 | |
---|
| 51 | # encode and send the HTTP POST |
---|
| 52 | my $request_body = $request->as_string; |
---|
| 53 | |
---|
[6159c8d] | 54 | $ENV{HTTPS_CERT_FILE} = $cert; |
---|
| 55 | $ENV{HTTPS_KEY_FILE} = $key; |
---|
[a26520d] | 56 | # $ENV{HTTPS_DEBUG} = 1; |
---|
[f7040d8] | 57 | |
---|
| 58 | my $ua = LWP::UserAgent->new; |
---|
| 59 | |
---|
| 60 | my $request = HTTP::Request->new( |
---|
| 61 | 'POST', |
---|
| 62 | "https://$url/RPC2", |
---|
| 63 | ); |
---|
| 64 | $request->header('User-Agent', USER_AGENT); |
---|
| 65 | $request->header('Content-Length', length $request_body); |
---|
| 66 | $request->content($request_body); |
---|
| 67 | |
---|
| 68 | my $response = $ua->request($request); |
---|
| 69 | if (!$response->is_success) { |
---|
| 70 | die $response->status_line; |
---|
| 71 | } |
---|
| 72 | |
---|
| 73 | # decode the reply |
---|
[a26520d] | 74 | my $xmlrpc_response = RPC::XML::Parser->new->parse($response->decoded_content); |
---|
| 75 | my $result = $xmlrpc_response->value->value; |
---|
| 76 | |
---|
| 77 | # load all the credentials from the reply |
---|
| 78 | foreach my $cred (@{$result->{credentials}}) { |
---|
| 79 | $context->load_identity_chunk($cred->{attribute_cert}); |
---|
| 80 | $context->load_attribute_chunk($cred->{attribute_cert}); |
---|
| 81 | } |
---|
| 82 | |
---|
| 83 | my $success = $result->{success}; |
---|
| 84 | if ($success) { |
---|
| 85 | print "Success\n"; |
---|
| 86 | } |
---|
| 87 | |
---|
| 88 | foreach my $cred (@{$context->credentials}) { |
---|
| 89 | printf "Credential %s <- %s\n", |
---|
| 90 | $cred->head->string, |
---|
| 91 | $cred->tail->string; |
---|
| 92 | } |
---|
[6159c8d] | 93 | |
---|
| 94 | sub usage { |
---|
| 95 | print "Usage: $0 \\\n"; |
---|
| 96 | print " --keystore <keystore> [ --url <host:port> ] \\\n"; |
---|
| 97 | print " --cert <cert.pem> --key <key.pem> \\\n"; |
---|
| 98 | print " --role <keyid.role>\n"; |
---|
| 99 | print " url defaults to localhost:8000\n"; |
---|
| 100 | exit 1; |
---|
| 101 | } |
---|