Open-ILS/src/perlmods/lib/OpenILS/Application/PermaCrud.pm

   1 # vim:et:ts=4:sw=4:
   2
   3 package OpenILS::Application::PermaCrud;
   4 use OpenILS::Application;
   5 use base qw/OpenILS::Application/;
   6 use strict; use warnings;
   7
   8 use Unicode::Normalize;
   9 use OpenSRF::EX qw/:try/;
  10
  11 use OpenSRF::AppSession;
  12 use OpenSRF::Utils::SettingsClient;
  13 use OpenSRF::Utils::Logger qw/:level/;
  14
  15 use OpenILS::Utils::Fieldmapper;
  16 use OpenSRF::Utils::JSON;
  17
  18 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  19
  20 use XML::LibXML;
  21 use XML::LibXML::XPathContext;
  22 use XML::LibXSLT;
  23 use OpenILS::Event;
  24
  25 our %namespace_map = (
  26     oils_persist=> {ns => 'http://open-ils.org/spec/opensrf/IDL/persistence/v1'},
  27     oils_obj    => {ns => 'http://open-ils.org/spec/opensrf/IDL/objects/v1'},
  28     idl         => {ns => 'http://opensrf.org/spec/IDL/base/v1'},
  29     reporter    => {ns => 'http://open-ils.org/spec/opensrf/IDL/reporter/v1'},
  30     perm        => {ns => 'http://open-ils.org/spec/opensrf/IDL/permacrud/v1'},
  31 );
  32
  33
  34 my $log = 'OpenSRF::Utils::Logger';
  35
  36 my $parser = XML::LibXML->new();
  37 my $xslt = XML::LibXSLT->new();
  38
  39 my $xpc = XML::LibXML::XPathContext->new();
  40 $xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map );
  41
  42 my $idl;
  43
  44 sub initialize {
  45
  46     my $conf = OpenSRF::Utils::SettingsClient->new;
  47     my $idl_file = $conf->config_value( 'IDL' );
  48
  49     $idl = $parser->parse_file( $idl_file );
  50
  51     $log->debug( 'IDL XML file loaded' );
  52
  53     generate_methods();
  54
  55 }
  56 sub child_init {}
  57
  58 sub CRUD_action_object_permcheck {
  59     my $self = shift;
  60     my $client = shift;
  61     my $auth = shift;
  62     my $obj = shift;
  63
  64     my $e = shift || new_editor(authtoken => $auth, xact => 1);
  65     return $e->event unless $e->checkauth;
  66
  67     if (ref($obj) && $obj->json_hint ne $self->{class_hint}) {
  68         throw OpenSRF::DomainObject::oilsException->new(
  69             statusCode => 500,
  70             status => "Class missmatch: $self->{class_hint} method called with " . $obj->json_hint,
  71         );
  72     }
  73
  74     my $class_node;
  75     my $error = '';
  76     try {
  77         ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
  78     } catch Error with {
  79         $error = shift;
  80         $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
  81         throw OpenSRF::DomainObject::oilsException->new(
  82             statusCode => 500,
  83             status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
  84         );
  85     };
  86
  87     if (!$class_node) {
  88         $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
  89         throw OpenSRF::DomainObject::oilsException->new(
  90             statusCode => 500,
  91             status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
  92         );
  93     }
  94
  95     my $action_node;
  96     try {
  97         ($action_node) = $xpc->findnodes( "perm:permacrud/perm:actions/perm:$self->{action}", $class_node );
  98     } catch Error with {
  99         $error = shift;
 100         $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]");
 101         throw OpenSRF::DomainObject::oilsException->new(
 102             statusCode => 500,
 103             status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"
 104         );
 105     };
 106
 107     if (!$action_node) {
 108         $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]");
 109         throw OpenSRF::DomainObject::oilsException->new(
 110             statusCode => 500,
 111             status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"
 112         );
 113     }
 114
 115     my $all_perms = $action_node->getAttribute( 'all_perms' );
 116
 117     my $fm_class = $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
 118     if (!ref($obj)) {
 119         my $retrieve_method = 'retrieve_' . $fm_class;
 120         $retrieve_method =~ s/::/_/go;
 121         $obj = $e->$retrieve_method( $obj ) or return $e->die_event;
 122     }
 123
 124     (my $o_type = $fm_class) =~ s/::/./go;
 125
 126     my $perm_field_value = $action_node->getAttribute('permission');
 127
 128     if ($perm_field_value) {
 129         my @perms = split ' ', $perm_field_value;
 130
 131         my @context_ous;
 132         if ($action_node->getAttribute('global_required')) {
 133             push @context_ous, $e->search_actor_org_unit( { parent_ou => undef } )->[0]->id;
 134
 135         } else {
 136             my $context_field_value = $action_node->getAttribute('context_field');
 137
 138             if ($context_field_value) {
 139                 push @context_ous, $obj->$_ for ( split ' ', $context_field_value );
 140             } else {
 141                 for my $context_node ( $xpc->findnodes( "perm:context", $action_node ) ) {
 142                     my $context_field = $context_node->getAttribute('field');
 143                     my $link_field = $context_node->getAttribute('link');
 144
 145                     if ($link_field) {
 146
 147                         my ($link_node) = $xpc->findnodes( "idl:links/idl:link[\@field='$link_field']", $class_node );
 148                         my $link_class_hint = $link_node->getAttribute('class');
 149                         my $remote_field = $link_node->getAttribute('key');
 150
 151                         my ($remote_class_node) = $xpc->findnodes( "//idl:class[\@id='$link_class_hint']", $idl->documentElement );
 152                         my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
 153                         $search_method =~ s/::/_/go;
 154
 155                         for my $remote_object ( @{$e->$search_method( { $remote_field => $obj->$link_field } )} ) {
 156                             push @context_ous, $remote_object->$context_field;
 157                         }
 158                     } else {
 159                         push @context_ous, $obj->$_ for ( split ' ', $context_field );
 160                     }
 161                 }
 162             }
 163         }
 164
 165         my $pok = 0;
 166         for my $perm (@perms) {
 167             if (@context_ous) {
 168                 for my $c_ou (@context_ous) {
 169                     if ($e->allowed($perm => $c_ou => $obj)) {
 170                         $pok++;
 171                         last;
 172                     }
 173                 }
 174             } else {
 175                 $pok++ if ($e->allowed($perm => undef => $obj));
 176             }
 177         }
 178
 179         if ((lc($all_perms) eq 'true' && @perms != $pok) or !$pok) {
 180             return OpenILS::Event->new('PERM_FAILURE',
 181                 ilsperm => "", # XXX add logic to report which perm failed
 182                 ilspermloc => "",
 183                 payload => "Perm failure -- action: $self->{action}, object type: $self->{json_hint}",
 184             );
 185         }
 186     }
 187
 188     if ($self->{action} eq 'retrieve') {
 189         $e->rollback;
 190         return $obj;
 191     }
 192
 193     $o_type =~ s/\./_/og;
 194     my $method = $self->{action} . "_$o_type";
 195     my $val = $e->$method($obj) or return $e->die_event;
 196     $e->commit;
 197
 198     return $val;
 199 }
 200
 201 sub search_permacrud {
 202     my $self = shift;
 203     my $client = shift;
 204     my $auth = shift;
 205     my @args = @_;
 206
 207     if (@args > 1) {
 208         delete $args[1]{flesh};
 209         delete $args[1]{flesh_fields};
 210     }
 211
 212     my $e = new_editor(authtoken => $auth, xact => 1);
 213     return $e->event unless $e->checkauth;
 214
 215     my $class_node;
 216     try {
 217         ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
 218     } catch Error with {
 219         my $error = shift;
 220         $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
 221         throw OpenSRF::DomainObject::oilsException->new(
 222             statusCode => 500,
 223             status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
 224         );
 225     };
 226
 227     my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
 228     $search_method =~ s/::/_/go;
 229
 230     $log->debug("Calling CStoreEditor search method: $search_method");
 231
 232     my $obj_list = $e->$search_method( \@args );
 233
 234     my $retriever = $self->method_lookup( $self->{retriever} );
 235     for my $o ( @$obj_list ) {
 236         try {
 237             ($o) = $retriever->run( $auth, $o, $e );
 238             $client->respond( $o ) if ($o);
 239         };
 240     }
 241
 242     return undef;
 243 }
 244
 245 sub generate_methods {
 246     try {
 247         for my $class_node ( $xpc->findnodes( '//idl:class[perm:permacrud]', $idl->documentElement ) ) {
 248             my $hint = $class_node->getAttribute('id');
 249             $log->debug("permacrud class_node $hint");
 250
 251             for my $action_node ( $xpc->findnodes( "perm:permacrud/perm:actions/perm:*", $class_node ) ) {
 252                 (my $method = $action_node->localname) =~ s/^.+:(.+)$/$1/o;
 253                 $log->internal("permacrud method = $method");
 254
 255                 __PACKAGE__->register_method(
 256                     method          => 'CRUD_action_object_permcheck',
 257                     api_name        => 'open-ils.permacrud.' . $method . '.' . $hint,
 258                     class_hint      => $hint,
 259                     action          => $method,
 260                 );
 261
 262                 if ($method eq 'retrieve') {
 263                     __PACKAGE__->register_method(
 264                         method          => 'search_permacrud',
 265                         api_name        => 'open-ils.permacrud.search.' . $hint,
 266                         class_hint      => $hint,
 267                         retriever       => 'open-ils.permacrud.retrieve.' . $hint,
 268                         stream          => 1
 269                     );
 270                 }
 271             }
 272         }
 273     } catch Error with {
 274         my $e = shift;
 275         $log->error("error generating permacrud methods: $e");
 276     };
 277 }
 278
 279
 280 1;
 281