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