# ************************************************************************* # Copyright (c) 2014-2022, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* # ------------------------ # This package contains handlers. # ------------------------ package Web::MREST::Dispatch; use strict; use warnings; use feature "state"; use App::CELL qw( $CELL $log $core $meta $site ); use Data::Dumper; use Exporter qw( import ); use Module::Runtime qw( use_module ); use Params::Validate qw( :all ); use Web::MREST::InitRouter qw( $router $resources ); use Web::MREST::Util qw( pod_to_html pod_to_text ); use parent 'Web::MREST::Entity'; =head1 NAME App::MREST::Dispatch - Resource handlers =head1 DESCRIPTION Your application should not call any of the routines in this module directly. They are called by L during the course of request processing. What your application can do is provide its own resource handlers. The resource handlers are called as ordinary functions with a sole argument: the MREST context. =cut =head1 INITIALIZATION/RESOURCE DEFINITIONS In this section we provide definitions of all resources handled by this module. These are picked up by L. =cut our @EXPORT_OK = qw( init_router ); our $resource_defs = { # root resource '/' => { handler => 'handler_noop', description => 'The root resource', documentation => <<'EOH', =pod This resource is the parent of all resources that do not specify a parent in their resource definition. EOH }, # bugreport 'bugreport' => { parent => '/', handler => { GET => 'handler_bugreport', }, cli => 'bugreport', description => 'Display instructions for reporting bugs in Web::MREST', documentation => <<'EOH', =pod Returns a JSON structure containing instructions for reporting bugs. EOH }, # configinfo 'configinfo' => { parent => '/', handler => { GET => 'handler_configinfo', }, cli => 'configinfo', description => 'Display information about Web::MREST configuration', documentation => <<'EOH', =pod Returns a list of directories that were scanned for configuration files. EOH }, # docu 'docu' => { parent => '/', handler => 'handler_noop', cli => 'docu', description => 'Access on-line documentation (via POST to appropriate subresource)', documentation => <<'EOH', =pod This resource provides access to on-line documentation through its subresources: 'docu/pod', 'docu/html', and 'docu/text'. To get documentation on a resource, send a POST reqeuest for one of these subresources, including the resource name in the request entity as a bare JSON string (i.e. in double quotes). EOH }, # docu/pod 'docu/pod' => { parent => 'docu', handler => { POST => 'handler_docu', }, cli => 'docu pod $RESOURCE', description => 'Display POD documentation of a resource', documentation => <<'EOH', =pod This resource provides access to on-line help documentation in POD format. It expects to find a resource name (e.g. "employee/eid/:eid" including the double-quotes, and without leading or trailing slash) in the request body. It returns a string containing the POD source code of the resource documentation. EOH }, # docu/html 'docu/html' => { parent => 'docu', handler => { POST => 'handler_docu', }, cli => 'docu html $RESOURCE', description => 'Display HTML documentation of a resource', documentation => <<'EOH', =pod This resource provides access to on-line help documentation. It expects to find a resource name (e.g. "employee/eid/:eid" including the double-quotes, and without leading or trailing slash) in the request body. It generates HTML from the resource documentation's POD source code. EOH }, # docu/text 'docu/text' => { parent => 'docu', handler => { POST => 'handler_docu', }, cli => 'docu text $RESOURCE', description => 'Display resource documentation in plain text', documentation => <<'EOH', =pod This resource provides access to on-line help documentation. It expects to find a resource name (e.g. "employee/eid/:eid" including the double-quotes, and without leading or trailing slash) in the request body. It returns a plain text rendering of the POD source of the resource documentation. EOH }, # echo 'echo' => { parent => '/', handler => { POST => 'handler_echo', }, cli => 'echo [$JSON]', description => 'Echo the request body', documentation => <<'EOH', =pod This resource simply takes whatever content body was sent and echoes it back in the response body. EOH }, # noop 'noop' => { parent => '/', handler => 'handler_noop', cli => 'noop', description => 'A resource that does nothing', documentation => <<'EOH', =pod Regardless of anything, this resource does nothing at all. EOH }, # param/:type/:param 'param/:type/:param' => { parent => '/', handler => { 'GET' => 'handler_param', 'PUT' => 'handler_param', 'DELETE' => 'handler_param', }, cli => { 'GET' => 'param $TYPE $PARAM', 'PUT' => 'param $TYPE $PARAM $VALUE', 'DELETE' => 'param $TYPE $PARAM', }, description => { 'GET' => 'Display value of a meta/core/site parameter', 'PUT' => 'Set value of a parameter (meta only)', 'DELETE' => 'Delete a parameter (meta only)', }, documentation => <<'EOH', =pod This resource can be used to look up (GET) meta, core, and site parameters, as well as to set (PUT) and delete (DELETE) meta parameters. EOH validations => { 'type' => qr/^(meta)|(core)|(site)$/, 'param' => qr/^[[:alnum:]_][[:alnum:]_-]+$/, }, }, # test/?:specs 'test/?:specs' => { parent => '/', handler => 'handler_test', cli => 'test [$SPECS]', description => "Resources for testing resource handling semantics", }, # version 'version' => { parent => '/', handler => { GET => 'handler_version', }, cli => 'version', description => 'Display application name and version', documentation => <<'EOH', =pod Shows the software version running on the present instance. The version displayed is taken from the C<$VERSION> package variable of the package specified in the C site parameter. EOH }, }; =head1 FUNCTIONS =cut =head2 init_router Initialize (populate) the router. Called from Resource.pm when the first request comes waltzing in. =cut sub init_router { $log->debug("Entering " . __PACKAGE__. "::init_router"); # # initialize Path::Router singleton # $router = Path::Router->new unless ref( $router ) and $router->can( 'match' ); # # load resource definitions # Web::MREST::InitRouter::load_resource_defs( $resource_defs ); # ... might need to be called multiple times ... } =head2 _first_pass_always_exists Boilerplate code for use in handlers of resources that always exist =cut sub _first_pass_always_exists { my ( $self, $pass ) = @_; if ( $pass == 1 ) { $log->debug( "Resource handler first pass, resource always exists" ); return 1; } return 0; } =head2 handler_bugreport Handler for the C resource. =cut sub handler_bugreport { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::handler_bugreport, pass number $pass" ); # first pass return 1 if $self->_first_pass_always_exists( $pass ); # second pass return $CELL->status_ok( 'MREST_DISPATCH_BUGREPORT', payload => { report_bugs_to => $site->MREST_REPORT_BUGS_TO }, ); } =head2 handler_configinfo Handler for the C resource. =cut sub handler_configinfo { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::handler_configinfo, pass number $pass" ); # first pass return 1 if $self->_first_pass_always_exists( $pass ); # second pass return $CELL->status_ok( 'MREST_DISPATCH_CONFIGINFO', payload => $meta->CELL_META_SITEDIR_LIST, ); } =head2 handler_docu =cut sub handler_docu { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::handler_docu, pass number $pass" ); # first pass return 1 if $self->_first_pass_always_exists( $pass ); # '/docu/...' resources only # the resource to be documented should be in the request body - if not, return 400 my $docu_resource = $self->context->{'request_entity'}; if ( $docu_resource ) { $log->debug( "handler_docu: request body is ->$docu_resource<-" ); } else { $self->mrest_declare_status( 'code' => 400, 'explanation' => 'Missing request entity' ); return $CELL->status_not_ok; } # the resource should be defined - if not, return 404 my $def = $resources->{$docu_resource}; $log->debug( "handler_docu: resource definition is " . Dumper( $def ) ); if ( ref( $def ) ne 'HASH' ) { $self->mrest_declare_status( 'code' => 404, 'explanation' => 'Undefined resource' ); $log->debug( "Resource not defined: " . Dumper( $docu_resource ) ); return $CELL->status_not_ok; } # all green - assemble the requested documentation my $method = $self->context->{'method'}; my $resource_name = $self->context->{'resource_name'}; my $pl = { 'resource' => $docu_resource, }; my $docs = $def->{'documentation'} || <<"EOH"; =pod The definition of resource $docu_resource lacks a 'documentation' property EOH # if they want POD, give them POD; if they want HTML, give them HTML, etc. if ( $resource_name eq 'docu/pod' ) { $pl->{'format'} = 'POD'; $pl->{'documentation'} = $docs; } elsif ( $resource_name eq 'docu/html' ) { $pl->{'format'} = 'HTML'; $pl->{'documentation'} = pod_to_html( $docs ); } else { # fall back to plain text $pl->{'format'} = 'text'; $pl->{'documentation'} = pod_to_text( $docs ); } return $CELL->status_ok( 'MREST_DISPATCH_ONLINE_DOCUMENTATION', payload => $pl ); } =head2 handler_echo Echo request body back in the response =cut sub handler_echo { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::handler_echo, pass number $pass" ); return 1 if $self->_first_pass_always_exists( $pass ); # second call - just echo, nothing else return $CELL->status_ok( "ECHO_REQUEST_ENTITY", payload => $self->context->{'request_entity'} ); } =head2 handler_param Handler for 'param/:type/:param' resource. =cut sub handler_param { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::handler_param, pass number $pass" ); # get parameters my $method = $self->context->{'method'}; my $mapping = $self->context->{'mapping'}; my ( $type, $param ); if ( $mapping ) { $type = $self->context->{'mapping'}->{'type'}; $param = $self->context->{'mapping'}->{'param'}; } else { die "AAAHAHAHAAHAAHAAAAAAAA! no mapping?? in handler_param_get"; } my $resource_name = $self->context->{'resource_name'}; my ( $bool, $param_obj ); if ( $type eq 'meta' ) { $param_obj = $meta; } elsif ( $type eq 'core' ) { $param_obj = $core; } elsif ( $type eq 'site' ) { $param_obj = $site; } if ( ! $param_obj) { $self->mrest_declare_status( code => '500', explanation => 'IMPROPER TYPE' ); return 0; } # first pass if ( $pass == 1 ) { $bool = $param_obj->exists( $param ); $bool = $bool ? 1 : 0; $self->context->{'stash'}->{'param_value'} = $param_obj->get( $param ) if $bool; return $bool; } # second pass if ( $type ne 'meta' and $method =~ m/^(PUT)|(DELETE)$/ ) { $self->mrest_declare_status( code => 400, explanation => 'PUT and DELETE can be used with meta parameters only' ); return $CELL->status_not_ok; } if ( $method eq 'GET' ) { return $CELL->status_ok( 'MREST_PARAMETER_VALUE', payload => { $param => $self->context->{'stash'}->{'param_value'}, } ); } elsif ( $method eq 'PUT' ) { $log->debug( "Request entity: " . Dumper( $self->context->{'request_entity'} ) ); return $param_obj->set( $param, $self->context->{'request_entity'} ); } elsif ( $method eq 'DELETE' ) { delete $param_obj->{$param}; return $CELL->status_ok( 'MREST_PARAMETER_DELETED', payload => { 'type' => $type, 'param' => $param, } ); } } =head2 handler_noop Generalized handler for resources that don't do anything. =cut sub handler_noop { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::noop" ); # pass one return 1 if $self->_first_pass_always_exists( $pass ); # pass two my $method = $self->context->{'method'}; my $resource_name = $self->context->{'resource_name'}; my $def = $resources->{$resource_name}; my $pl = { 'resource_name' => $resource_name, 'description' => $def->{$method}->{'description'}, 'parent' => $def->{'parent'}, 'children' => $def->{'children'}, }; return $CELL->status_ok( 'MREST_DISPATCH_NOOP', payload => $pl ); } =head2 handler_test The only purpose of this resource is testing/demonstration of request handling. =cut sub handler_test { my ( $self, $pass ) = @_; my $method = $self->context->{'method'}; my $mapping = $self->context->{'mapping'}; my $specs = $self->context->{'mapping'}->{'specs'} if $mapping; # first pass if ( $pass == 1 ) { my $re = 0; if ( not defined $specs ) { $log->debug( "handler_test: \$specs is missing and the resource exists" ); $re = 1; } elsif ( $specs eq '0' ) { $log->debug( "handler_test: \$specs is ->$specs<- and the resource does not exist" ); } else { $log->debug( "handler_test: \$specs is ->$specs<- and the resource exists" ); $re = 1; if ( $method eq 'POST' ) { if ( $specs ne '1' ) { $self->context->{'post_is_create'} = 1; $self->context->{'create_path'} = $self->context->{'uri_path'}; } } } return $re; } # second pass if ( $method eq 'GET' ) { return $self->_test_get( $specs ); } elsif ( $method eq 'POST' ) { return $self->_test_post( $specs ); } elsif ( $method eq 'PUT' ) { return $self->_test_put( $specs ); } elsif ( $method eq 'DELETE' ) { return $self->_test_delete( $specs ); } else { return $CELL->status_crit( 'ERROR_UNSUPPORTED_METHOD' ); } } sub _test_get { my ( $self, $specs ) = @_; my $status = $CELL->status_ok( 'TEST_GET_RESOURCE' ); $status->payload( 'DUMMY' ); return $status; } sub _test_post { my ( $self, $specs ) = @_; # $specs cannot be 0, but can be anything else, including undef # we interpret the values '1' and undef to mean post_is_create is false my $status; if ( not defined $specs or $specs eq '1' ) { # this post does not create a new resource $status = $CELL->status_ok( 'TEST_POST_OK' ); $self->context->{'post_is_create'} = 0; } elsif ( $specs eq '0' ) { # already handled in caller die "AAAADAHDDAAAAADDDDGGAAAA!"; } else { # pretend that this POST creates a new resource $status = $CELL->status_ok( 'TEST_POST_IS_CREATE' ); } $status->payload( 'DUMMY' ); return $status; } sub _test_put { my ( $self, $specs ) = @_; my $bool = $specs ? 1 : 0; my $status; if ( $specs ) { # pretend that the resource already existed $status = $CELL->status_ok( 'TEST_PUT_RESOURCE_EXISTS' ); } else { # pretend that a new resource was created $status = $CELL->status_ok( 'TEST_PUT_NEW_RESOURCE_CREATED' ); } $status->payload( 'DUMMY' ); return $status; } sub _test_delete { my ( $self, $specs ) = @_; my $bool = $specs ? 1 : 0; my $status; if ( $specs ) { # pretend we deleted something $status = $CELL->status_ok( 'TEST_RESOURCE_DELETED' ); } else { # resource didn't exist $status = $CELL->status_not_ok( 'TEST_NON_EXISTENT_RESOURCE', args => [ 'DELETE' ], ); # we have to force 404 here - due to how Web::Machine handles DELETE $self->mrest_declare_status( 'code' => 404, explanation => 'Request to delete non-existent resource; nothing to do' ); } $status->payload( 'DUMMY' ); return $status; } =head2 handler_version Handler for the C resource. =cut sub handler_version { my ( $self, $pass ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::handler_version, pass number $pass" ); # first pass return 1 if $self->_first_pass_always_exists( $pass ); # second pass my $param = $site->MREST_APPLICATION_MODULE; my $version = use_module( $param )->version; my $payload = ( $version ) ? { 'application' => $param, 'version' => $version, } : "BUBBA did not find nothin"; return $CELL->status_ok( 'MREST_DISPATCH_VERSION', payload => $payload ); } 1;