[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 { |
---|
[ab52de1] | 15 | USER_AGENT => 'abac/0.2.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 |
---|
[f7040d8] | 31 | |
---|
| 32 | # load the certificates |
---|
| 33 | my $context = ABAC::Context->new; |
---|
| 34 | $context->load_directory($keystore); |
---|
| 35 | |
---|
| 36 | # build the XML RPC request |
---|
| 37 | my $request = RPC::XML::request->new( |
---|
| 38 | 'abac.query', |
---|
| 39 | smart_encode({ |
---|
[6159c8d] | 40 | role => $role, |
---|
[f7040d8] | 41 | credentials => [ |
---|
| 42 | map {{ |
---|
| 43 | attribute_cert => RPC::XML::base64->new($_->attribute_cert), |
---|
| 44 | issuer_cert => RPC::XML::base64->new($_->issuer_cert), |
---|
| 45 | }} @{$context->credentials} |
---|
| 46 | ], |
---|
| 47 | }), |
---|
| 48 | ); |
---|
| 49 | |
---|
| 50 | # encode and send the HTTP POST |
---|
| 51 | my $request_body = $request->as_string; |
---|
| 52 | |
---|
[6159c8d] | 53 | $ENV{HTTPS_CERT_FILE} = $cert; |
---|
| 54 | $ENV{HTTPS_KEY_FILE} = $key; |
---|
[a26520d] | 55 | # $ENV{HTTPS_DEBUG} = 1; |
---|
[f7040d8] | 56 | |
---|
| 57 | my $ua = LWP::UserAgent->new; |
---|
| 58 | |
---|
| 59 | my $request = HTTP::Request->new( |
---|
| 60 | 'POST', |
---|
| 61 | "https://$url/RPC2", |
---|
| 62 | ); |
---|
| 63 | $request->header('User-Agent', USER_AGENT); |
---|
| 64 | $request->header('Content-Length', length $request_body); |
---|
| 65 | $request->content($request_body); |
---|
| 66 | |
---|
| 67 | my $response = $ua->request($request); |
---|
| 68 | if (!$response->is_success) { |
---|
| 69 | die $response->status_line; |
---|
| 70 | } |
---|
| 71 | |
---|
| 72 | # decode the reply |
---|
[a26520d] | 73 | my $xmlrpc_response = RPC::XML::Parser->new->parse($response->decoded_content); |
---|
| 74 | my $result = $xmlrpc_response->value->value; |
---|
| 75 | |
---|
| 76 | # load all the credentials from the reply |
---|
| 77 | foreach my $cred (@{$result->{credentials}}) { |
---|
| 78 | $context->load_identity_chunk($cred->{attribute_cert}); |
---|
| 79 | $context->load_attribute_chunk($cred->{attribute_cert}); |
---|
| 80 | } |
---|
| 81 | |
---|
| 82 | my $success = $result->{success}; |
---|
| 83 | if ($success) { |
---|
| 84 | print "Success\n"; |
---|
| 85 | } |
---|
| 86 | |
---|
| 87 | foreach my $cred (@{$context->credentials}) { |
---|
| 88 | printf "Credential %s <- %s\n", |
---|
| 89 | $cred->head->string, |
---|
| 90 | $cred->tail->string; |
---|
| 91 | } |
---|
[6159c8d] | 92 | |
---|
| 93 | sub usage { |
---|
| 94 | print "Usage: $0 \\\n"; |
---|
| 95 | print " --keystore <keystore> [ --url <host:port> ] \\\n"; |
---|
| 96 | print " --cert <cert.pem> --key <key.pem> \\\n"; |
---|
| 97 | print " --role <keyid.role>\n"; |
---|
| 98 | print " url defaults to localhost:8000\n"; |
---|
| 99 | exit 1; |
---|
| 100 | } |
---|