Web-MREST-0.290000755001750000144 014257045157 13455 5ustar00smithfarmusers000000000000Web-MREST-0.290/Build.PL000444001750000144 524414257045157 15113 0ustar00smithfarmusers000000000000use 5.012000; use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Web::MREST', license => 'bsd', dist_author => q{Nathan Cutler }, dist_version_from => 'lib/Web/MREST.pm', create_license => 0, create_readme => 0, release_status => 'stable', share_dir => { dist => [ 'config' ], }, meta_merge => { no_index => { directory => [ "config" ] } }, script_files => [ 'bin/mrest', 'bin/mrest-standalone', ], configure_requires => { 'Module::Build' => 0, }, build_requires => { 'App::CELL' => 0.209, 'Cwd' => 0, 'Encode' => 0, 'File::Basename' => 0, 'File::ShareDir' => 0, 'File::Spec' => 0, 'HTTP::Request' => 0, 'HTTP::Request::Common' => 0, 'JSON' => 0, 'LWP::UserAgent' => 6.05, 'LWP::Protocol::https' => 6.04, 'Module::Runtime' => 0, 'Params::Validate' => 0, 'Path::Router' => 0.12, 'Plack' => 1.0031, 'Plack::Test' => 0, 'Pod::Simple::HTML' => 0, 'Pod::Simple::Text' => 0, 'Test::Deep' => 0, 'Test::Fatal' => 0, 'Test::JSON' => 0, 'Test::More' => 0, 'Test::Warnings' => 0, 'Try::Tiny' => 0, 'URI::Escape' => 0, 'Web::Machine' => 0.15, }, requires => { 'perl' => 5.012, 'App::CELL' => 0.209, 'Getopt::Long' => 2.32, 'Encode' => 0, 'File::ShareDir' => 0, 'File::Spec' => 0, 'HTTP::Request' => 0, 'HTTP::Request::Common' => 0, 'JSON' => 0, 'LWP::UserAgent' => 6.05, 'LWP::Protocol::https' => 6.04, 'Module::Runtime' => 0, 'Params::Validate' => 1.06, 'Path::Router' => 0.12, 'Plack::Middleware::LogErrors' => 0, 'Plack::Middleware::Session' => 0, 'Plack::Middleware::StackTrace' => 0, 'Plack::Runner' => 0, 'Pod::Simple::HTML' => 0, 'Pod::Simple::Text' => 0, 'Pod::Usage' => 0, 'Term::ReadLine' => 0, 'Test::Deep::NoTest' => 0, 'Try::Tiny' => 0, 'URI::Escape' => 0, 'Web::Machine' => 0.15, 'Web::MREST::CLI' => 0.276, }, add_to_cleanup => [ 'Web-MREST-*' ], # create_makefile_pl => 'traditional', recursive_test_files => 1, ); $builder->create_build_script(); Web-MREST-0.290/Changes000444001750000144 5010614257045157 15127 0ustar00smithfarmusers000000000000Revision history for Web::MREST 0.01 2014-12-19 21:01 CET - basic module setup with code (mainly Resource.pm) taken from App::Dochazka::REST version 0.356 - MREST.pm: write POD 0.02 2014-12-22 09:52 CET - remove auto-generated build files that I committed accidentally - MREST.pm: work on POD - Resource.pm: get rid of is_authorized and associated routines 0.03 2014-12-22 16:03 CET - start development 0.04 2014-12-23 11:42 CET - rename from App::MREST to Web::MREST - get t/503-Service-Unavailable.t to work as desired 0.05 2014-12-23 16:50 CET - no longer dying in allowed_methods 0.06 2014-12-23 21:34 CET - Build.PL: add Module::Runtime dependency - MREST_Config.pm: add MREST_APPLICATION_MODULE - dispatch_MetaConfig.pm: document format of resource definitions; re-structure the resources to illustrate how individual resources can have subresources for a tree structure; add MREST_ROOT_RESOURCE - Resource.pm: fix bugs in resource initialization routines - t/405-Method-Not-Allowed.t: now that allowed_methods is doing something, add some tests 0.07 2014-12-29 15:39 CET - bin/mrest: now takes app distro as parameter - config/dispatch_MetaConfig.pm: minor fixes; add root resource definition - MREST.pm: work on POD, make init take a PARAMHASH so application can get its own meta and site parameters loaded - Resource.pm: remove Clone dependency; adapt to flat structure of resource definitions - t/405-Method-Not-Allowed.t: fix tests - t/method_not_allowed_override.t: demonstrate how a unit can define its own resources and generate HTTP requests against them 0.08 2014-12-30 15:30 CET - config/HTTP_Status_Message_en.conf: add HTTP status codes - MREST.pm: work on POD - Resource.pm: implement 'mrest_declare_error' method; use it in allowed_methods; change all instances of $self->response->body to $self->response->content; add error-handling code to 'finish_request' method; start declaring HTTP errors using the new method - Test.pm: in 'status_from_json' we call 'from_json' which might die - handle this situation more gracefully 0.09 2014-12-30 18:35 CET - implement malformed_request, is_authorized, forbidden - rename "mrest_declare_error" to "mrest_declare_status" so we can "declare" a successful status, too - try to figure out why CLI parser dies when we return a "declared" 500 status (something strange is afoot) 0.10 2014-12-31 09:54 CET - add dispatch-specific config files and module - bin/mrest: disable StackTrace middleware as it was making it difficult to return sensible 500 error entities - Resource.pm: turn warnings into errors; add 'mrest_resource_exists' method; "GET bugreport" works 0.11 2014-12-31 16:11 CET - bin/mrest: turn on Web::Machine tracing - HTTP_Status_Message_en.conf: add 501 - MREST_Config.pm: support OPTIONS method - get rid of bogus dispatch_Config.pm innards - MREST.pm: work on POD - Resource.pm: too much work to describe here 0.12 2014-12-31 23:24 CET - Resource.pm: expand 'status_declared' method; work on 'malformed_request' method; call handler in a try block - config/MREST_Config.pm: expand supported options - break tests - t/request_body_read.t: write what seem to be some sensible tests that pass - t/: address some of the brokenness 0.13 2015-01-02 14:33 CET - Util.pm: for pod_to_html - Dispatch/Docu.pm: handlers for docu resources - t/: new units t/resources/docu.t and t/4xx/415-Unsupported-Media-Type.t - get HTML responses to work - get docu resources to work - MREST.pm: POD checked up to B5 - Dispatch.pm: add 'noop' handler - Resource.pm: basic handling/checking of 'Content-Length' and 'Content-Type' headers 0.14 2015-01-02 15:19 CET - in valid_content_headers, actually check the headers against the valid set (taken from RFC2616) 0.15 2015-01-03 22:15 CET - handle and test 406 Not Acceptable - work on POD - take "content types provided" from configuration 0.16 2015-01-05 16:01 CET - dispatch_MetaConfig.pm, Dispatch.pm: add 'test/post_is_create/:bool' resource - MREST.pm: work on POD - Resource.pm: implement 'post_is_create' and 'create_path' methods - t/2xx/201.t: basic unit tests for 'post_is_create' 0.17 2015-01-06 08:28 CET - resource handlers are now method names - bin/mrest: take distro name and name of module to bless the application object into - dispatch_MetaConfig.pm: work on documentation; remove module name from handler property; generalize 'test' resource - MREST.pm: work on POD - Dispatch.pm: inherit from Web::MREST::Resource; work on 'echo' handler; generalize 'test' handler so it works for GET, POST, PUT and DELETE - Resource.pm: execute handler via method call instead of function call - Test.pm, t/: start adapting tests to current state 0.18 2015-01-06 13:44 CET - add 'forbidden' resource and test for 403 Forbidden - add site params to control "cache disablement" headers - call handlers 'handler_foo' to distinguish them from resource names - get rid of 'help' resource; rename 'not_implemented' to 'noop' 0.19 2015-01-07 16:38 CET - work on POD - change how resource handlers are called - start adapting the resource handlers (WIP) - debug Resources.pm (WIP) 0.20 2015-01-07 21:43 CET - Resource.pm: call resource targets twice (once to determine resource existence and a second time - as part of response generation - to get the status) - Dispatch.pm: adapt 'bugreport' and 'docu/..' resources to the latest change in how resource targets are called 0.21 2015-01-08 09:49 CET - add t/2xx/200-OK.t - Dispatch.pm, Resource.pm: fix post_is_create, create_path - Test.pm, t/: add low-level 'llreq' routine; make req use it 0.211 2015-01-10 08:28 CET - standardize terminology ("request entity" instead of "request body") - remove 'forbidden' resource definition and handler: they are not necessary to test 403 Forbidden response - add new modules that override 'forbidden' and 'is_authorized' methods and associated unit tests - work on POD - clarify how resource_exists is supposed to work and adapt 'handler_test' - Resource.pm: remove bogus forbidden handling code, clean up 'known_content_type', push content type onto context; add 'web_machine_metadata' accessor; work on process_post method 0.212 2015-01-12 09:01 CET - Resource.pm: add 'documentation' to hard-coded list of not-to-be-expanded properties - Test.pm: make 'llreq' handle headers argument properly, including assigning default headers if no arguments are provided - t/: adapt tests in 2xx, 4xx, and 5xx to current code state 0.213 2015-01-12 16:00 CET - config/: define resources in a site, rather than meta, config file - MANIFEST: fix omissions - Dispatch.pm: fix 'handler_echo' - t/method_not_allowed_override.t: broken unit - skip it for now 0.214 2015-01-12 19:37 CET - Resource.pm: split off init_router stuff into a separate module - Test.pm: make req really use llreq; fix a warning 0.215 2015-01-13 08:53 CET - Test.pm, t/: make initialize_unit take a PARAMHASH and prepare it to take a sitedir option 0.216 2015-01-13 10:05 CET - Resource.pm: split off "Web Services introduction" into a separate module - MREST.pm: work on POD 0.217 2015-01-13 12:03 CET - find and fix some lingering instances of 'request_body' (renamed to 'request_entity') - t/dispatch/docu.t: 'documentation_format' property renamed to 'format' - test suite running cleanly 0.218 2015-01-13 15:05 CET - InitRouter.pm: take list of non-expandable properties from a config param - MREST.pm: make 'init' take 'sitedir' property instead of inappropriately named 'path' - t/method_not_allowed_override.t: revive the unit 0.219 2015-01-14 06:20 CET - dispatch_Config.pm: add 'docu/text' resource - Dispatch.pm: resource handlers now called with ordinal number of pass - adapt and clean up; make 'handler_param_get' handle second pass properly; in 'handler_docu', return 400 if request entity missing, improve error explanations; adapt 'handler_echo' to current state - Util.pm: fix a glaring oversight 0.220 2015-01-14 16:43 CET - Build.PL, bin/mrest: use Plack::Middleware::LogErrors to redirect psgix.error to our logger object - Resource.pm: use the new 'get_acceptable_content_type_handler' method from https://github.com/stevan/webmachine-perl/pull/32 0.221 2015-01-15 09:14 CET - Dispatch.pm: have only one handler for all 'param/...' requests - Resource.pm: add accessor for declared status code; add methods for running request handler and response generator; make request handler call the response generator; properly handle empty requests in request handler; process_post just calls the _run_request_handler method; remove deprecated web_machine_metadata method 0.222 2015-01-15 16:14 CET - Resource.pm: clarify possible return values from request handler and response generator; rearrange various routines so the order in which they appear in the source file matches more closely the order in which requests propagate through the FSM 0.223 2015-01-16 08:09 CET - split off Entity.pm from Resource.pm - MREST.pm: work on POD - Resource.pm: provide a means to muffle debug-level log messages; start organizing methods according to which "part" of the FSM they belong to; move _make_json to Util.pm 0.224 2015-01-16 09:36 CET - Entity.pm: add boilerplate - Resource.pm: make 'context' initialize the context property, if needed, even when called as an accessor; do not decode_utf8 the path_info for now - Util.pm: use and export $JSON singleton; comment out 'make_json' routine as it might not be needed 0.225 2015-01-16 11:28 CET - dispatch_Config.pm, Dispatch.pm: allow DELETE method on 'param/...' resource - Entity.pm: implement get_acceptable_content_type_handler method for which patch is pending upstream; rationalize PUT/POST request processing - Resource.pm: streamline process_post 0.226 2015-01-16 14:26 CET - MREST_Config.pm: remove MREST_CONTENT_TYPES_PROVIDED - Entity.pm: rename _render_response_html -> mrest_generate_response_html; rename _render_response_json -> mrest_generate_response_json; add generic mrest_generate_response method 0.227 2015-01-16 14:35 CET - Resource.pm: include entity in responses to DELETE requests 0.228 2015-01-16 14:58 CET t/dispatch/param.t: add test cases for 'param/...' resource 0.229 2015-01-16 15:33 CET - Resource.pm: make declared status be an App::CELL::Status object from the very beginning - this simplifies finish_request - t/: adapt tests 0.230 2015-01-16 15:46 CET - Resource.pm: make mrest_declare_status optionally take a ready-made App::CELL::Status object 0.231 2015-01-16 16:02 CET - t/dispatch/noop.t: add test cases for 'noop' resource - dispatch_Config.pm: cleanup - Dispatch.pm: fix up the 'handler_noop' method 0.232 2015-01-16 22:00 CET - Dispatch.pm, t/dispatch/version.t: add handler and test cases for the 'version' resource - MREST.pm: add a 'version' method to provide access to $VERSION package variable 0.233 2015-01-18 16:19 CET - bring in CLI from App::Dochazka::CLI (0.076) 0.234 2015-01-18 23:09 CET - dispatch_Config.pm: fix 'param/..' resource definition; make root handler be 'handle_noop' - InitRouter.pm: work on POD; find some kind of weird race condition - needs a closer look 0.235 2015-01-20 07:22 CET - Build.PL: add Web::MREST::CLI::Parser module directory and move CLI configuration files to it - bin/mrest-cli: re-enable logging, add some print statements for better orientation, change prompt to Web::MREST::CLI::Parser - config_cli/: log to mrest-cli.log in home directory - CLI/UserAgent.pm: add some comments - InitRouter.pm: add debug log messages 0.236 2015-01-20 17:53 CET - Resource.pm, InitRouter.pm: get root resource to work - t/dispatch/root_resource.t: tests for the root resource 0.237 2015-01-26 15:51 CET - Test.pm: do not add content-length in llreq - MREST.pm: work on POD - bin/mrest-cli: load config parameters only once 0.238 2015-01-28 18:04 CET - Build.PL, config/: consolidate server and CLI configuration files - implement new 'configinfo' resource for displaying contents of CELL_META_SITEDIR_LIST 0.239 2015-01-29 09:57 CET - define root resource in (almost) the same way as all the other resources, - the name of the root resource is '/' - definitions of top-level resources must include parent => '/' 0.240 2015-01-29 14:42 CET - Dispatch.pm: bring in resource definitions from dispatch_Config.pm, and init_router function from InitRouter.pm - eliminate all references to $meta->RESOURCES - this data is now stored in the $resources package variable in InitRouter.pm - remove obsoleted dispatch_Config.pm (integrate documentation into MREST.pm) - t/: remove two units broken by this round of modifications 0.241 2015-01-29 17:43 CET - 503.pm: add file needed for test - Resource.pm: call init_router earlier 0.242 2015-01-30 07:50 CET - CLI/UserAgent.pm: handle exceptions more gracefully 0.243 2015-02-02 10:11 CET - bin/mrest: disable StackTrace by default since we are catching exceptions now - bin/mrest-cli: tweak how responses are displayed - InitRouter.pm: fix to handle case when a resource property is set to undef - Resource.pm: when Web::Machine catches an exception, trigger a 500 and provide a response entity with the text of the exception 0.244 2015-02-02 16:46 CET - report HTTP method in declared statuses - improve documentation of docu resource 0.245 2015-02-02 21:24 CET - Resource.pm: add explicit 'create_path_after_handler' method 0.246 2015-02-03 07:24 CET - Entity.pm: declare status when response generator is not OK - InitRouter.pm: tweak log messages 0.247 2015-02-04 17:55 CET - Resource.pm: be careful that create_path always returns a string 0.248 2015-02-11 10:18 CET - Resource.pm: add 'nullify_declared_status' method 0.249 2015-02-11 14:04 CET - Entity.pm: insert Location header only if resource does not exist - Test.pm: put Location header in return value (App::CELL::Status object) so we can test for it - t/dispatch/param.t: test for correct response code (201 or 200) and Location header in PUT requests that create/modify a resource; add more test cases 0.250 2015-02-12 07:32 CET - InitRouter.pm: make debug message more useful 0.251 2015-02-12 09:19 CET - CLI/UserAgent.pm: use URI::Escape to escape % characters - Resource.pm: make 'mrest_declare_status' take optional 'args' property so we can specify explanation as a message code 0.252 2015-02-16 21:45 CET - InitRouter.pm: expand list of non-expandable properties 0.253 2015-02-17 18:25 CET - MREST.pm: prep POD for release (WIP) - CLI/Parser.pm: enable root resource - MREST/Dispatch.pm: eliminate setting of 'resource_exists' in the response generator as I am not sure if this is useful (needs more investigation) 0.254 2015-02-18 07:06 CET - MREST.pm: mention 'curl' in SYNOPSIS - Entity.pm: handle possible \415 from get_acceptable_content_type_handler - Resource.pm: do not return scalar refs from 'process_post' 0.255 2015-02-18 07:25 CET - MREST.pm: work on POD; fix syntax error 0.256 2015-02-18 08:44 CET - implement normalize_filespec (in Util.pm) and use it to convert relative paths to absolute - eliminate all references to %ENV (for portability) 0.257 2015-02-18 16:46 CET - work on POD 0.258 2015-02-21 08:09 CET - CLI/UserAgent.pm: add 'http_code' property to return status object 0.259 2015-02-21 18:59 CET - Resource.pm: make 'known_content_type' tolerate undefined/empty content type 0.260 2015-04-06 13:42 CEST - Resource.pm: mrest_declare_status method could nominally take an App::CELL::Status object, but this functionality was not tested and, of course, didn't work properly -> fix 0.261 2015-04-06 14:59 CEST - Resource.pm: refactor 'mrest_declared_status_code' accessor, add 'mrest_declared_status_explanation' and 'declared_status' accessors - t/mrest_declared_status.t: add unit tests 0.262 2015-04-13 09:35 CEST - tweak dependencies in an attempt to fix 'Can't locate object method "create" via package "Plack::Test"' error in certain smoke tests 0.263 2015-04-13 10:06 CEST - stop generating massive README, replace it with link to metacpan.org 0.264 2015-07-04 19:03 CEST - bin/mrest: take local sitedir as a third argument 0.265 2015-07-04 19:59 CEST - bin/mrest: really load the local site configuration directory 0.266 2015-07-04 20:17 CEST - MREST.pm: make init() honor all parameters, instead of just one 0.267 2015-07-13 09:42 CEST - Test.pm: make initialize_unit() more verbose 0.268 2015-07-13 09:45 CEST - tweak release scripts 0.269 2015-07-16 11:45 CEST - bin/mrest-cli: fix version number 0.270 2015-07-16 11:48 CEST - Test.pm: make is_deeply check handle case when the value is undef? 0.271 2015-07-21 19:36 CEST - Update copyright statement to 2015 - set $VERSION in top-level module only - new release script 0.272 2015-07-22 14:42 CEST - Make MREST_CLI_URI_BASE a meta param - bin/mrest: take $VERSION from top-level module 0.273 2015-07-23 17:45 CEST - Build.PL: require recent versions of LWP::UserAgent and LWP::Protocol::https - No longer generate Makefile.PL - UserAgent.pm: enable SSL connections 0.274 2015-07-25 11:49 CEST - bin/mrest: use options instead of positional parameters - release scripting modifications - Build.PL: make LWP::Protocol::https a BuildRequires as well as a Requires 0.275 2015-07-26 21:21 CEST - Add missing "use Pod::Usage" to bin/mrest - Entity.pm: declare error statuses properly in mrest_generate_response_json() (fixes Github issue #6) - CLI/UserAgent.pm: in send_req(), be more careful when modifying the response - Build.PL: add Cwd and File::Basename to BuildRequires - bin/mrest-standalone: add wrapper for starting server in standalone mode - update documentation of standalone mode in MREST.pm 0.276 2015-07-27 - Include descriptive text with DISPATCH_VERSION and MREST_CLI_SERVER_ERROR message codes - Build.PL, MANIFEST.SKIP: release scripting modifications - Test.pm: change diag() to note() in initialize_unit() 0.277 2015-07-28 17:09 CEST - finish splitting off Web::MREST::CLI into a separate distro - bin/mrest: import normalize_filespec() from Web::MREST::CLI::UserAgent - Util.pm: drop normalize_filespec(); has been moved to Web::MREST::CLI - lib/Web/MREST/: drop entire CLI/ subtree (just two files, actually) - config/: drop all CLI-related files and keep server-related ones - Build.PL: require Web::MREST::CLI >= 0.276 0.278 2015-07-30 14:29 CEST - Early debugging feature - MREST.pm: do not call $CELL->load() with debug_mode param - bin/mrest: import normalize_filespec() from Web::MREST::CLI 0.279 2015-07-30 14:36 CEST - bin/mrest: fix a silly typo 0.280 2015-08-05 15:35 CEST - MREST.pm->init(): be more careful about early debugging filespec provided by user 0.281 2015-07-11 12:07 CET - config/: rename messages that might clash with application - global: do not convert warnings into errors - tests: use Test::Warnings to check for unexpected warnings - update release and prerelease scripts 0.282 2016-01-02 01:17 CET - bin/mrest: call app's init() function if it exists 0.283 2016-08-24 10:08 CET - Display application module in HTML header, not Web::MREST - add POD caveat: request entity not available until 2nd handler pass - release.sh: automate attachment of version number to OBS commit 0.284 2016-07-31 20:07 CET - Dispatch.pm: fix POD on _first_pass_always_exists - bin/mrest: drop deprecated comments - bin/mrest: document how to pass arguments to Plack::Runner 0.285 2016-09-05 09:02 CEST - bin/mrest: comment out a useless message - Travis CI - Merge README files into single README.rst - Add helper files for release automation scripting 0.286 2016-09-24 14:35 CEST - Drop deprecated local release scripts - cleanup: drop unused _get_sharedir() argument in bin/mrest - cleanup: fix copyright header in bin/mrest - Add get_session() function to Util.pm 0.287 2017-02-25 09:38 CET - Refrain from munging Plack::Session object - script: store sessions in a dedicated directory in /tmp 0.288 2017-10-16 22:17 CEST - build/ops: require latest App::CELL - Report MREST_DEBUG_MODE setting at startup 0.289 2022-06-29 14:46 CEST - cleanup: tweak whitespace in copyright notices - bootstrap: add (hopefully self-explanatory) bootstrap scripts - doc: Web/MREST.pm: fix error in POD - lib: update copyright year range in source files - doc: MREST.pm: point readers to CLI documentation 0.290 2022-06-29 14:49 CEST - MANIFEST.SKIP: do not include bootstrap scripts in Perl distro Web-MREST-0.290/LICENSE000444001750000144 306714257045157 14625 0ustar00smithfarmusers000000000000Copyright (c) 2014-2015, SUSE LLC All rights reserved. This is free software, licensed under: The (three-clause) BSD License The BSD License Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * 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. Web-MREST-0.290/MANIFEST000444001750000144 206514257045157 14746 0ustar00smithfarmusers000000000000bin/mrest bin/mrest-standalone Build.PL Changes config/dispatch_Message_en.conf config/favicon.ico config/HTTP_Status_Message_en.conf config/MREST_Config.pm config/MREST_Message_en.conf lib/Web/MREST.pm lib/Web/MREST/Dispatch.pm lib/Web/MREST/Entity.pm lib/Web/MREST/InitRouter.pm lib/Web/MREST/Resource.pm lib/Web/MREST/Test.pm lib/Web/MREST/Test/503.pm lib/Web/MREST/Test/Forbidden.pm lib/Web/MREST/Test/Unauthorized.pm lib/Web/MREST/Util.pm lib/Web/MREST/WebServicesIntro.pm LICENSE MANIFEST This list of files META.json META.yml README.rst t/2xx/200-OK.t t/2xx/201-Created.t t/4xx/400-Bad-Request.t t/4xx/401-Unauthorized.t t/4xx/403-Forbidden.t t/4xx/405-Method-Not-Allowed.t t/4xx/406-Not-Acceptable.t t/4xx/413-Request-Entity-Too-Large.t t/4xx/414-Request-URI-Too-Long.t t/4xx/415-Unsupported-Media-Type.t t/5xx/501-Not-Implemented.t t/5xx/503-Service-Unavailable.t t/config.t t/dispatch/bugreport.t t/dispatch/docu.t t/dispatch/echo.t t/dispatch/noop.t t/dispatch/param.t t/dispatch/root_resource.t t/dispatch/version.t t/mrest_declare_status.t t/request_body_read.t Web-MREST-0.290/META.json000444001750000144 742114257045157 15237 0ustar00smithfarmusers000000000000{ "abstract" : "Minimalistic REST server", "author" : [ "Nathan Cutler " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4224", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Web-MREST", "no_index" : { "directory" : [ "config" ] }, "prereqs" : { "build" : { "requires" : { "App::CELL" : "0.209", "Cwd" : "0", "Encode" : "0", "File::Basename" : "0", "File::ShareDir" : "0", "File::Spec" : "0", "HTTP::Request" : "0", "HTTP::Request::Common" : "0", "JSON" : "0", "LWP::Protocol::https" : "6.04", "LWP::UserAgent" : "6.05", "Module::Runtime" : "0", "Params::Validate" : "0", "Path::Router" : "0.12", "Plack" : "1.0031", "Plack::Test" : "0", "Pod::Simple::HTML" : "0", "Pod::Simple::Text" : "0", "Test::Deep" : "0", "Test::Fatal" : "0", "Test::JSON" : "0", "Test::More" : "0", "Test::Warnings" : "0", "Try::Tiny" : "0", "URI::Escape" : "0", "Web::Machine" : "0.15" } }, "configure" : { "requires" : { "Module::Build" : "0" } }, "runtime" : { "requires" : { "App::CELL" : "0.209", "Encode" : "0", "File::ShareDir" : "1.00", "File::Spec" : "0", "Getopt::Long" : "2.32", "HTTP::Request" : "0", "HTTP::Request::Common" : "0", "JSON" : "0", "LWP::Protocol::https" : "6.04", "LWP::UserAgent" : "6.05", "Module::Runtime" : "0", "Params::Validate" : "1.06", "Path::Router" : "0.12", "Plack::Middleware::LogErrors" : "0", "Plack::Middleware::Session" : "0", "Plack::Middleware::StackTrace" : "0", "Plack::Runner" : "0", "Pod::Simple::HTML" : "0", "Pod::Simple::Text" : "0", "Pod::Usage" : "0", "Term::ReadLine" : "0", "Test::Deep::NoTest" : "0", "Try::Tiny" : "0", "URI::Escape" : "0", "Web::MREST::CLI" : "0.276", "Web::Machine" : "0.15", "perl" : "5.012" } } }, "provides" : { "Web::MREST" : { "file" : "lib/Web/MREST.pm", "version" : "0.290" }, "Web::MREST::Dispatch" : { "file" : "lib/Web/MREST/Dispatch.pm" }, "Web::MREST::Entity" : { "file" : "lib/Web/MREST/Entity.pm" }, "Web::MREST::InitRouter" : { "file" : "lib/Web/MREST/InitRouter.pm" }, "Web::MREST::Resource" : { "file" : "lib/Web/MREST/Resource.pm" }, "Web::MREST::Test" : { "file" : "lib/Web/MREST/Test.pm" }, "Web::MREST::Test::503" : { "file" : "lib/Web/MREST/Test/503.pm" }, "Web::MREST::Test::Forbidden" : { "file" : "lib/Web/MREST/Test/Forbidden.pm" }, "Web::MREST::Test::Unauthorized" : { "file" : "lib/Web/MREST/Test/Unauthorized.pm" }, "Web::MREST::Util" : { "file" : "lib/Web/MREST/Util.pm" }, "Web::MREST::WebServicesIntro" : { "file" : "lib/Web/MREST/WebServicesIntro.pm" } }, "release_status" : "stable", "resources" : { "license" : [ "http://opensource.org/licenses/bsd-license.php" ] }, "version" : "0.290", "x_serialization_backend" : "JSON::PP version 2.27400_02" } Web-MREST-0.290/META.yml000444001750000144 460514257045157 15070 0ustar00smithfarmusers000000000000--- abstract: 'Minimalistic REST server' author: - 'Nathan Cutler ' build_requires: App::CELL: '0.209' Cwd: '0' Encode: '0' File::Basename: '0' File::ShareDir: '0' File::Spec: '0' HTTP::Request: '0' HTTP::Request::Common: '0' JSON: '0' LWP::Protocol::https: '6.04' LWP::UserAgent: '6.05' Module::Runtime: '0' Params::Validate: '0' Path::Router: '0.12' Plack: '1.0031' Plack::Test: '0' Pod::Simple::HTML: '0' Pod::Simple::Text: '0' Test::Deep: '0' Test::Fatal: '0' Test::JSON: '0' Test::More: '0' Test::Warnings: '0' Try::Tiny: '0' URI::Escape: '0' Web::Machine: '0.15' configure_requires: Module::Build: '0' dynamic_config: 1 generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Web-MREST no_index: directory: - config provides: Web::MREST: file: lib/Web/MREST.pm version: '0.290' Web::MREST::Dispatch: file: lib/Web/MREST/Dispatch.pm Web::MREST::Entity: file: lib/Web/MREST/Entity.pm Web::MREST::InitRouter: file: lib/Web/MREST/InitRouter.pm Web::MREST::Resource: file: lib/Web/MREST/Resource.pm Web::MREST::Test: file: lib/Web/MREST/Test.pm Web::MREST::Test::503: file: lib/Web/MREST/Test/503.pm Web::MREST::Test::Forbidden: file: lib/Web/MREST/Test/Forbidden.pm Web::MREST::Test::Unauthorized: file: lib/Web/MREST/Test/Unauthorized.pm Web::MREST::Util: file: lib/Web/MREST/Util.pm Web::MREST::WebServicesIntro: file: lib/Web/MREST/WebServicesIntro.pm requires: App::CELL: '0.209' Encode: '0' File::ShareDir: '1.00' File::Spec: '0' Getopt::Long: '2.32' HTTP::Request: '0' HTTP::Request::Common: '0' JSON: '0' LWP::Protocol::https: '6.04' LWP::UserAgent: '6.05' Module::Runtime: '0' Params::Validate: '1.06' Path::Router: '0.12' Plack::Middleware::LogErrors: '0' Plack::Middleware::Session: '0' Plack::Middleware::StackTrace: '0' Plack::Runner: '0' Pod::Simple::HTML: '0' Pod::Simple::Text: '0' Pod::Usage: '0' Term::ReadLine: '0' Test::Deep::NoTest: '0' Try::Tiny: '0' URI::Escape: '0' Web::MREST::CLI: '0.276' Web::Machine: '0.15' perl: '5.012' resources: license: http://opensource.org/licenses/bsd-license.php version: '0.290' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Web-MREST-0.290/README.rst000444001750000144 211714257045157 15302 0ustar00smithfarmusers000000000000========== App::MREST ========== .. image:: https://travis-ci.org/smithfarm/mrest.svg?branch=master :target: https://travis-ci.org/smithfarm/mrest .. image:: https://badge.fury.io/pl/App-MREST.svg :target: https://badge.fury.io/pl/App-MREST MREST stands for "minimalistic" or "mechanical" REST server. (Mechanical because it relies on Web::Machine.) Web::MREST provides a fully functional REST server that can be started with a simple command. Without modification, the server provides a set of generalized resources that can be used to demonstrate how the REST server works, or for testing. Developers can use Web::MREST as a platform for implementing their own REST servers, as described below. App::Dochazka::REST is one example of such a server. For an introduction to REST and Web Services, see Web::MREST::WebServicesIntro. Bootstrapping ============= The process of "bootstrapping" MREST (successfully running it for the first time from source) is documented in the bootstrap scripts included in the git repo. Documentation ============= See https://metacpan.org/pod/Web::MREST Web-MREST-0.290/bin000755001750000144 014257045157 14225 5ustar00smithfarmusers000000000000Web-MREST-0.290/bin/mrest000444001750000144 1714614257045157 15470 0ustar00smithfarmusers000000000000#!/usr/bin/perl # ************************************************************************* # Copyright (c) 2014-2017, 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. # ************************************************************************* # # Web::MREST server executable # # ------------------------------------------------------------------------- use 5.014; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST; use Data::Dumper; use File::Path qw( remove_tree ); use Getopt::Long; use Log::Any::Adapter; use Module::Runtime qw( is_module_name require_module ); use Plack::Builder; use Plack::Runner; use Plack::Session::Store::File; use Pod::Usage; use Try::Tiny; use Web::Machine; use Web::MREST::CLI qw( normalize_filespec ); =head1 NAME mrest - Web::MREST server startup script =head1 SYNOPSIS Possible invocations (any options after C<--> are parsed by L: basically, they can be anything accepted by C: $ mrest --distro My-Distro --module My::Module $ mrest -d My::Distro -m My::Module $ mrest --distro My-Distro --module My::Module --sitedir /etc/my-module $ mrest -d My::Distro -m My::Module -s /etc/my-module $ mrest -- --server Starman $ mrest --help =head1 DESCRIPTION Run this script from the bash prompt to start the server. =head1 PASSING OPTIONS TO PLACK This script starts the server by instantiates a L object and calling its C method. Before doing that, it calls the C method with C<@ARGV> as its argument. However, the script does so B parsing its own options. Options intended to be parsed by L should be placed at the end of the command line, preceded by C<-->. =head1 DEBUGGING OPTIONS You can include an C<--early-debug> option on the command line, with the name of a file in which L will capture "early" log messages -- i.e. all log messages generated before the "official" MREST log file (i.e. the one defined in the site parameters) is known. =head1 FUNCTIONS =cut sub _welcome_message { my $message = "Starting Web::MREST ver. $Web::MREST::VERSION"; print "$message\n"; $log->notice( $message ); } sub _get_sharedir { my ( $distro, $module ) = @_; # for distro, we allow both formats My::Distro and My-Distro # distro might be just Foo, or Foo::Bar, or Foo-Bar my @tmp_c; if ( $distro =~ m/\:/ ) { @tmp_c = split( '::', $distro ); } elsif ( $distro =~ m/\-/ ) { @tmp_c = split( '-', $distro ); } else { @tmp_c = ( $distro ); } my $app_distro = join( '-', @tmp_c ); my $app_module = $module; die "$app_module is not a module name" unless is_module_name( $app_module ); print "App distro is $app_distro\n"; print "App module is $app_module\n"; my $distro_sharedir; my $status; try { $distro_sharedir = File::ShareDir::dist_dir( $app_distro ); print "Distro sharedir is $distro_sharedir\n"; } catch { $status = "Could not find a sharedir for distro $app_distro: $_"; }; if ( $status ) { die $status; } return ( $app_distro, $app_module, $distro_sharedir ); } sub _load_config_params { my ( $app_distro, $sitedir, $early_debug ) = @_; print "Loading configuration parameters from $sitedir\n"; my $status = Web::MREST::init( distro => $app_distro, sitedir => $sitedir, early_debug => $early_debug ); die $status->text unless $status->ok; } sub _set_up_logging { #print "Setting up logging\n"; my $log_file = normalize_filespec( $site->MREST_LOG_FILE ); my $should_reset = $site->MREST_LOG_FILE_RESET; unlink $log_file if $should_reset; Log::Any::Adapter->set( 'File', $log_file ); my $message = "Logging to $log_file"; print "$message\n"; print "MREST_DEBUG_MODE is set to " . ( $site->MREST_DEBUG_MODE || 0 ) . "\n"; $log->info( $message ); if ( ! $site->MREST_APPNAME ) { die "Site parameter MREST_APPNAME is undefined - please investigate!"; } $log->init( ident => $site->MREST_APPNAME, debug_mode => ( $site->MREST_DEBUG_MODE || 0 ), ); } sub function_exists { no strict 'refs'; my $funcname = shift; return \&{$funcname} if defined &{$funcname}; return; } sub _call_init { my $app_module = shift; require_module( $app_module ); if ( my $subref = function_exists( $app_module . "::init" ) ) { print "Calling $app_module" . "::init()\n"; &$subref(); } } sub _init_webmachine { my $app_module = shift; print "Starting server\n"; return Web::Machine->new( resource => $app_module, tracing => 1, )->to_app; } =head1 MAIN =cut _welcome_message(); # process command-line options my $help = 0; my $distro = ''; my $module = ''; my $sitedir = ''; my $early_debug = ''; GetOptions( 'distro|d=s' => \$distro, 'early-debug|e=s' => \$early_debug, 'help|?' => \$help, 'module|m=s' => \$module, 'sitedir|s=s' => \$sitedir, ); pod2usage(1) if $help; print "Early debug mode activated\n" if $early_debug; # distro and module are required die "You must specify at least --distro and --module (with values). Bailing out" unless $distro and $module; my ( $app_distro, $app_module, $distro_sharedir ) = _get_sharedir( $distro, $module ); print "Local site configuration directory is $sitedir\n" if $sitedir; _load_config_params( $app_distro, $sitedir, $early_debug ); # initializes $site _set_up_logging(); # needs $site _call_init( $app_module ); my $app = _init_webmachine( $app_module ); my $runner = Plack::Runner->new; $runner->parse_options(@ARGV); remove_tree('/tmp/mrest-sessions'); mkdir '/tmp/mrest-sessions'; $runner->run( builder { enable "LogErrors", logger => sub { my $args = shift; my $level = $args->{'level'}; my $message = $args->{'message'}; $log->$level( $message ); }; # enable "StackTrace", force => 1; # enable "Session", store => 'File'; enable "Session", store => Plack::Session::Store::File->new( dir => '/tmp/mrest-sessions' ); enable "Static", path => qr{/favicon}, root => $distro_sharedir; $app; } ); Web-MREST-0.290/bin/mrest-standalone000444001750000144 352714257045157 17574 0ustar00smithfarmusers000000000000#!/bin/sh # ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # # Web::MREST standalone server executable # # ------------------------------------------------------------------------- mrest --distro Web::MREST --module Web::MREST::Dispatch Web-MREST-0.290/config000755001750000144 014257045157 14722 5ustar00smithfarmusers000000000000Web-MREST-0.290/config/HTTP_Status_Message_en.conf000444001750000144 422714257045157 22203 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------------------------- # Web::MREST # ------------------------------------------- # # HTTP_Status_Message_en.conf # # Status codes for the various HTTP errors # ------------------------------------------- 200 OK 400 Bad Request 401 Unauthorized 403 Forbidden 404 Not Found 405 Method Not Allowed 406 Not Acceptable 413 Request Entity Too Large 414 Request-URI Too Long 415 Unsupported Media Type 500 Internal Server Error 501 Not Implemented 503 Service Unavailable Web-MREST-0.290/config/MREST_Config.pm000444001750000144 1111314257045157 17611 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2017, 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. # ************************************************************************* # ------------------------------------------- # Web::MREST # ------------------------------------------- # # MREST_Config.pm # # WARNING: THIS FILE MAY CONTAIN PASSWORDS # (restrictive permissions may be warranted) # ------------------------------------------- # MREST_HOST # the hostname (vhost) where REST server will listen on a part set( 'MREST_HOST', 'localhost' ); # MREST_PORT # the port where the REST server will listen set( 'MREST_PORT', 5000 ); # MREST_LOG_FILE # full path of log file to log to (in the user's home directory) # If you don't want it in the user's home directory, specify an absolute # path. set( 'MREST_LOG_FILE', "mrest.log" ); # MREST_LOG_FILE_RESET # should the logfile be deleted/wiped/unlinked/reset before each use set( 'MREST_LOG_FILE_RESET', 1 ); # MREST_DOCUMENTATION_URI # used in the "help"/"default" resources set( 'MREST_DOCUMENTATION_URI', 'https://metacpan.org/pod/Web::MREST' ); # MREST_REPORT_BUGS_TO # this should be an ordinary string like "bugs@dochazka.com" or # "http://bugs.dochazka.com" set( 'MREST_REPORT_BUGS_TO', 'bug-App-MREST@rt.cpan.org' ); # MREST_MAX_LENGTH_URI # maximum length of a URI in bytes -- see Resource.pm->uri_too_long set( 'MREST_MAX_LENGTH_URI', 1000 ); # MREST_MAX_LENGTH_REQUEST_ENTITY # maximum length of request entity in bytes -- see Resource.pm->malformed set( 'MREST_MAX_LENGTH_REQUEST_ENTITY', 10000 ); # MREST_APPNAME # name of application (for logging) -- this can be set to any string, with # the proviso that it should not contain ':' characters set( 'MREST_APPNAME', 'Web-MREST' ); # MFILE_APPLICATION_MODULE # the 'version' method of this module is called to get the version # number returned by the 'version' resource set( 'MREST_APPLICATION_MODULE', 'Web::MREST' ); # MREST_DEBUG_MODE # determines whether or not debug- and trace-level messages are logged set( 'MREST_DEBUG_MODE', 1 ); # MREST_SUPPORTED_HTTP_METHODS # list of supported HTTP methods returned by the 'known_methods' method # "HEAD" is omitted on purpose - see t/501-Not-Implemented.t set( 'MREST_SUPPORTED_HTTP_METHODS', [ qw( GET PUT POST DELETE TRACE CONNECT OPTIONS ) ] ); # MREST_VALID_CONTENT_HEADERS # list of valid content headers as per RFC2616 set( 'MREST_VALID_CONTENT_HEADERS', [ qw( Encoding Language Length Location MD5 Range Type ) ] ); # MREST_SUPPORTED_CONTENT_TYPES # list of supported content types (major portions only!) set( 'MREST_SUPPORTED_CONTENT_TYPES', [ 'application/json', ] ); # MREST_CACHE_ENABLED # set to 0 to include response headers telling clients not to cache set( 'MREST_CACHE_ENABLED', 0 ); # MREST_CACHE_CONTROL_HEADER # value of 'Cache-Control' header used to disable caching set( 'MREST_CACHE_CONTROL_HEADER', 'no-cache, no-store, must-revalidate, private' ); # ----------------------------------- # DO NOT EDIT ANYTHING BELOW THIS LINE # ----------------------------------- use strict; use warnings; 1; Web-MREST-0.290/config/MREST_Message_en.conf000444001750000144 573514257045157 20760 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------------------------- # Web::MREST # ------------------------------------------- # # MREST_Message_en.conf # # status message codes and their respective texts # ------------------------------------------- # MREST_RESPONSE_HTML # what we display when we detect GET request from browser # takes two arguments: $version_number and $response_entity MREST_RESPONSE_HTML

%s

%s

Documentation: https://metacpan.org/pod/App::Dochazka::REST

Report bugs to: bug-Web-MREST@rt.cpan.org

Copyright (C) 2014-2015, SUSE LLC

All rights reserved.

TEST_NON_EXISTENT_RESOURCE The requested resource does not exist (%s) Web-MREST-0.290/config/dispatch_Message_en.conf000444001750000144 442514257045157 21660 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------------------------- # Web::MREST # ------------------------------------------- # # dispatch_Message_en.conf - Status messages returned by handlers. # # ------------------------------------------- MREST_DISPATCH_BUGREPORT See payload for bug reporting instructions MREST_DISPATCH_CONFIGINFO See payload for list of directories that App::CELL::Load scanned for configuration files MREST_DISPATCH_ONLINE_DOCUMENTATION See payload for the documentation you requested MREST_DISPATCH_VERSION See payload for the application and version currently running on the server MREST_DISPATCH_NOOP MREST_DISPATCH_NOOP Web-MREST-0.290/config/favicon.ico000444001750000144 217614257045157 17206 0ustar00smithfarmusers000000000000 h(  ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿiÿiÿiÿiÿiÿiÿiÿiÿiÿiÿiÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1ÿÿÿ1ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1ÿ1ÿ1ÿ1¯ÿ1ÿ1ÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1ÿ1ÿ1¯ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1ÿ1¯¯ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿÿ1ÿ1ÿ1ÿÿÿ1ÿ1ÿ1ÿÿiÿÿÿÿÿiÿÿ1ÿ1ÿ1ÿÿÿ1ÿ1ÿ1ÿÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1¯¯ÿ1ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1¯¯ÿ1ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1ÿ1ÿ1ÿ1ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿ1ÿ1ÿ1ÿ1ÿÿÿ1ÿ1ÿ1ÿ1ÿiÿÿÿÿÿiÿiÿiÿiÿiÿiÿiÿiÿiÿiÿiÿiÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€¿ý¾}¿Ý¿½¿=®u®u¾}¾}¿ý¾}¿ý€ÿÿWeb-MREST-0.290/lib000755001750000144 014257045157 14223 5ustar00smithfarmusers000000000000Web-MREST-0.290/lib/Web000755001750000144 014257045157 14740 5ustar00smithfarmusers000000000000Web-MREST-0.290/lib/Web/MREST.pm000444001750000144 14502714257045157 16376 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* package Web::MREST; use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log $meta $core $site ); use App::CELL::Test qw( _touch ); use Data::Dumper; use File::ShareDir; use Log::Any::Adapter; use Params::Validate qw( :all ); #use Try::Tiny; use Web::Machine; =head1 NAME Web::MREST - Minimalistic REST server =head1 VERSION Version 0.290 =cut our $VERSION = '0.290'; =head2 Development status L is currently in "Alpha - feature freeze". There are almost certainly bugs lurking in the code, but all features have been implemented. =head1 SYNOPSIS To take this module for a spin, execute this command: $ mrest-standalone Leave this running, and from another console start the command-line client: $ mrest-cli In the CLI client, type e.g. Web::MREST::CLI::Parser> get / A 'GET' request will be sent for the root resource and the CLI client will display a representation of the response. A similar result can be obtained using C: curl -v http://localhost:5000/ -X GET -H "Content-Type: application/json" For more information on using the CLI client, see L. =head1 DESCRIPTION MREST stands for "minimalistic" or "mechanical" REST server. (Mechanical because it relies on L.) L provides a fully functional REST server that can be started with a simple command. Without modification, the server provides a set of generalized resources that can be used to demonstrate how the REST server works, or for testing. Developers can use L as a platform for implementing their own REST servers, as described below. L is a "real-world" example of such a server. For an introduction to REST and Web Services, see L. =head1 RFC2616 AS A STATE MACHINE RFC2616 is, of course, the HTTP 1.1 standard - not a state machine. But the authors of "Web Machine" (which was originally implemented in Erlang) had a neat idea to represent it as a state machine and use this to implement a server for providing web services. L is, of course, the Perl port of Web Machine. L relies on L to implement RFC2616. L can be thought of as an additional abstraction layer over L. By itself, L is not a server. It does not listen on a port, for example. Instead, it is designed to work (via L) with a L-compliant web server. The web server hands incoming requests over to L, which runs the requests through its state machine. (The L authors refer to the state machine as "the FSM.") The best way to grasp the state machine is to envision it as a flow-chart. At each "decision node" of the flow-chart - where flow can go in one of two directions - L calls the method corresponding to that node. Each node is designated by a letter and a number: e.g. F7, O18, etc. The flow-chart implemented by the FSM can be found L - you are encouraged to have that open for reference while reading this documentation and implementing your REST server. =head1 SERVER STARTUP AND INHERITANCE SCHEME =head2 Standalone mode As stated above, L is capable of operating independently. To try it out, start up the server like this: $ mrest-standalone And then point your browser to http://localhost:5000 If you look inside the C script, you will see that it is just a wrapper for the C script, which takes two mandatory options. The first, C<--distro>, is the name of the distribution in whose sharedir it should look for configuration files. The second, C<--module>, is the name of the application's resource module, i.e. the ultimate module in the chain of inheritance. In standalone mode, the actual command that is run is: mrest --distro=Web::MREST --module=Web::MREST::Dispatch which causes the chain of inheritance to be built up as follows: =over =item C calls C<< Web::Machine->new >>; the L object is blessed into L =item L inherits from L =item L inherits from L =item L inherits from L =back When you browse to C in standalone mode, you get a list of the sample REST resources that are available. For more information on these, see C. =head2 With your application Starting the server with your application is the same as described in L<"Standalone mode">, above, except that you replace C with the name of your distribution and C with the name of your ultimate resource module. $ mrest YourApp-MREST YourApp::MREST::Dispatch For example, here we are starting the server with the distribution C, which is presumed to implement a chain of inheritance similar to L's, i.e.: Web::MREST -> YourApp::MREST::Resource -> YourApp::MREST::Dispatch Thanks to this arrangement, the application developer can customize L - i.e., not only providing her own resources and handlers, but even altering how the state machine operates, if necessary - by providing her own chain of inheritance and overriding various methods within it. =head3 Recapitulation Since the above is quite important, let's go over it again: The L documentation will always refer to your application either as the "application" or as C. The application should take the form of a Perl distribution, which should have: =over =item * a distribution sharedir =item * a resource module, C. =item * a dispatch module, C =back For now, just think of these three components as "black boxes". We will cover their contents later. The server (i.e. your application), is started by executing the C executable with the name of your application's distribution and the name of its dispatch module, which should be the ultimate module in the chain of inheritance. $ mrest --distro YourApp --module YourApp::Dispatch Under the hood the startup script, which can be reviewed at C, does essentially this: use Web::Machine; Web::Machine->new( resource => 'YourApp::Dispatch', )->to_app; There are two key points concerning the L object constructed by call to C<< Web::Machine->new >>: =over =item 1. the object is blessed into C =item 2. the object is a L application =back =head1 INHERITANCE SCHEME As seen in the previous section, C inherits from L via a chain of inheritance. Here is the chain implemented by L: -> Web::MREST::Dispatch -> Web::MREST::Entity -> Web::MREST::Resource -> Web::Machine::Resource -> Plack::Component Assuming L has its authentication and authorization routines in L and its resource definitions and handlers in L, the chain for L would look like this: -> YourApp::Dispatch -> YourApp::Resource -> Web::MREST::Entity -> Web::MREST::Resource -> Web::Machine::Resource -> Plack::Component (In other words, L and L replace L, which is just a demo.) When L reaches a given node in the FSM, it calls the corresponding method on that L object. Since the object is blessed into C, that module is where Perl will start to look for the method. If the method is not found at the lowest level, Perl follows the chain of inheritance "upward". The highest level, L, is shown only for completeness - L and L implement all the methods that your resource module might (or should) want to override. Readers who are not well-versed in writing Perl applications that use inheritance are referred to the fine Perl manuals such as C. =head1 STATE MACHINE INTRODUCTION At this point we have enough background information to begin to grasp the state machine. (Instead of writing "state machine" we will follow the L convention of referring to it as the "FSM".) This section presents selected features and nodes of the FSM, how L implements them, and how to use them. The discourse proceeds in the order in which the methods are called when an HTTP request enters the FSM. We can envision these method calls as decision nodes of a flow-chart, or "cogs" of the FSM. And we needn't just imagine the flow-chart - it actually exists and can be downloaded from L<...>. If you want to understand how L and L work, this document is of fundamental importance. Hereinafter it will be referred to as "the FSM diagram". As you can see in the FSM diagram, each FSM cog has a code like C, for ease of reference. =head1 POLICIES AND FEATURES L implements the FSM, and that's all it does. In particular, it imposes no policies on distributions that use it. By taking this approach, L maximizes its range of potential uses. Powerful as it is, L can be confusing to use. When I started writing my first application based on it, I found myself wanting an intermediate module between my application and L - something that would make L a little more friendly. L is that module. It builds on L in an effort to provide certain additional features. Inevitably, this means imposing some policies (i.e., limitations) on users. To me that seems like an acceptable trade-off. =head2 Path dispatch A key part of any web application is "path dispatch" (i.e. URI translation), which answers the question: "how are URIs mapped to resources?" Although L provides a way to specify handlers for various media types that may appear in request and response entities, it provides no way of getting from the URI to the handler. L bridges this gap by providing a system of resource definitions (see L<"Resource definitions">, below). The definition of each resource specifies the URI-to-resource mapping and provides the name of the resource's handler method. Internally, L uses a single L object to parse URIs. Before any URIs can be parsed, this L object must be initialized. This is done in L, in the C method. That method checks the scalar variable that is supposed to contain the L object and, if needed, calls the C method to initialize it. In the L demo application, C is implemented in L. =head2 Resource handlers The L documentation mentions "handlers" but doesn't go into any detail on how to write them. L not only provides some working resource handlers, but also implements a paradigm for writing them. In this paradigm, the handler is called as a method, just like any of the other methods in the chain of inheritance. (To avoid namespace issues, it is recommended that handler method names start with C.) The name of the method is specified in the resource definition. The handler method is called twice - in other words, there are two passes. In the first pass, the handler is called with the argument C<1> (scalar value) and is expected to return a boolean value indicating whether the resource exists. In the second pass, indicated by the argument C<2> (scalar value), the handler is expected to return a C object. This object (rendered in JSON) becomes the response entity unless overrided by a declared status (see C in L. B The request entity is not available to the handler (via C<$self->context->{request_entity}> until the second pass! =head2 Status objects As mentioned in the previous section, L objects are returned by resource handlers. Not only that - L tries its best to I return an L object in the response entity. Actually, it is not the object itself that is returned, but a JSON representation of its underlying data structure. From this, the object can easily be reconstituted on the client side by doing my $status = $JSON->decode( $response_entity ); bless $status, 'App::CELL::Status'; For more on what status objects can do, see L, L, and L. =head2 Error statuses L always tries to return the proper HTTP status code in the response. The application developer will likely need to "force" a code in certain cases. For example, the request may be "malformed" in a way that is not discoverable until the handler runs. Or, caught exceptions may need to be exposed to the client with C<500 - Internal Error>. Also, the RFC says . . . the server SHOULD include an entity containing an explanation of the error situation, and whether it is a temporary or permanent condition. Clearly, then, a mechanism is needed for providing such explanations and indicating whether the error is temporary or permanent. And that mechanism should enable an arbitrary status code to be declared. By itself, L does not really provide such a mechanism. What it does provide is a mechanism for "forcing" an arbitrary status code (e.g. C<404 - Not Found>) by returning a scalar reference. This mechanism has two disadvantages: =over =item it is only available at certain junctions of the FSM I wanted a way to "declare" a status code at any point and be certain that L won't change it later on. =item there is no obvious way to provide an explanation of the error L considers this an implementation detail. =back Hence, L provides the C method. To learn how to call it and how it works, see L. =head1 THE FINE STATE MACHINE In this section we take a detailed look at the FSM by considering some common scenarios. For our purposes these are C, C, C, and C requests. Handling can differ according to whether or not a C creates a new resource and whether or not the resource is determined to exist. =head2 Part One (sanity checks and information gathering) The first few cogs are executed, in the same order, on all requests regardless of method. They can be thought of both as a set of sanity checks and as an information-gathering process. =head3 C (B13) The first method call is C, which is implemented by L and should I be implemented by your application, because it calls C to ensure that all the resource definitions are loaded and the L singleton is properly initialized. This is not really a limitation, however. Whatever code you need to run here can be placed in a method called C, which should return a boolean value (i.e. 1 or 0), which determines the return value from the method. If the service really isn't available, you can return false, which will trigger a C<503 Service Not Available> response. Before returning you should do: $self->mrest_declare_status( explanation => '...', permanent => 0 ); to provide an explanation of what is going on. For details, see the C unit test. =head3 C (B12) Returns the list of supported ("known") methods in C<< $site->MREST_SUPPORTED_HTTP_METHODS >>. If the request method is not in that list, a C<501 Not Implemented> response is returned along with an explanation that the method requested is not supported. If this behavior is not appropriate, the method can be implemented by the application. =head3 C (B11) If the request URI is longer than the value set in the C site parameter, the client will receive a C<414 Request URI Too Long> response. To override this behavior, provide your own C routine in your resource module. This functionality is demonstrated by the C unit. =head3 C (B10) "Is the method allowed on this resource?" This next routine is where things start to get complicated. According to the L, we are expected to respond with a list of methods allowed on the resource. To assemble such a list, we must first answer two questions: =over =item 1. Have the resource definitions been loaded? =item 2. Does the URI match a known resource? =back After the server starts, the first time this method is called triggers a call to the C method, which populates the C<$resources> package variable in C with all the resource definitions. This is explained in detail in L<"Resource definitions">. This takes care of the first question. The second question is answered by C. Once the request has been associated with a known resource, completing our task becomes a matter of getting and returning the set of methods for which the resource is defined. =head3 C (B9) A true return value from this method triggers a "400 Bad Request" response status. RFC2616 does not stipulate exactly what constitutes a bad request. We already (in allowed_methods) took care of the case when the URI fails to match a known resource, and that includes applying any C properties from the resource definition. So, in this method (or your overlay) we take the "next step" (whatever that is) in vetting the request. Keep in mind that this method is called before the resource handler. If you have any sanity checks you wish to apply _after_ the URI is matched to a resource but _before_ the resource handler fires, this is the place to put them. If you would like to keep L's implementation of this method (which, for example, pushes the Content-Length and Content-Type information onto the context) and add your own logic, you can put it in C instead of overriding C itself. If you intend to return false from this method you should first do this: $self->mrest_declare_status( explanation => '...' ); to ensure that an explanation is included with the 400 response. =head3 C (B8) In my mind, "authentication" is the process of determining who the user is, and "authorization" determines if the user is allowed to do what she is asking to do. However, RFC2616 does not make such a clear distinction. For that reason, it is left to the application to implement this method if needed. =head3 C (B7) The same thoughts as expressed under C, above, apply to this method as well. =head3 C (B6) This is where you vet the C headers in the request. If the request contains any invalid C headers (i.e., if the '*' part does not appear in << $site->MREST_VALID_CONTENT_HEADERS >>), a 501 will be generated. The content headers are passed to the method in a L object. =head3 C (B5) If the C header is relevant - i.e., if this is a PUT or POST request and if there is a request entity - check it against << $site->MREST_SUPPORTED_CONTENT_TYPES >>. =head3 C (B4) A simple routine that compares the entity length (in bytes) with the maximum set in C<< $site->MREST_MAX_LENGTH_REQUEST_BODY >>. =head3 C (B3) If your application needs to support the C method, you should implement this yourself - otherwise, ignore it. =head2 Part Two (content negotioation) The HTTP standard provides some complicated logic to enable clients and servers to "negotiate" the format (media type), language, encoding, etc. in which content will be passed back and forth. Here in the L documentation we gloss over this complexity and focus only on the media type. However, L includes methods for handling all the content negotiation decision nodes and the application developer is free to take advantage of them. That said, L itself provides JSON handlers for both the request and the response entities, and should be fully UTF-8 clean. Hopefully, this will save application developers some work. (For more information, see L<"STATUS OBJECTS AND ERROR HANDLING">.) The following subsections detail the principal content negotiation methods. =head3 C As the L documentation states, this method must be implemented (i.e., by the application) - otherwise, "your resource will not be able to return any useful content". Quoting further: "This should return an ARRAY of HASH ref pairs where the key is the name of the media type and the value is a CODE ref (or name of a method) which can provide a resource representation in that media type." The implementation provided by L allows clients to specify (via an C header) one of two media types: =over =item C Since it is the first hashref pair of the two, it is the default. That means if the incoming request does not have an C header, the handler specified for C will be called to generate the response entity. =item C This is the media type that L was written to support, both in request entities and in response entities. However, there is nothing preventing you as the application developer from specifying handlers for other media types. =back If the request includes an C header, but none of the media types specified in it are found in C, L will generate a C<406 Not Acceptable> response. (Unfortunately, there is no easy way for L or the application to know in advance that this error will be triggered, so it will be returned "bare" - i.e., without any explanatory response entity.) In the normal case when an acceptable handler exists, it will be called to generate the response - in other words, whatever is returned by the chosen handler becomes the response entity, unless an error occurs inside the handler. In that case, the handler should return a reference to a scalar value (e.g., \400), which L will interpret as an HTTP response code. See L<"STATUS OBJECTS AND ERROR HANDLING">. For more on response entity generation, see the sections dedicated to the various HTTP methods (L<"GET">, L<"PUT">, L<"POST">, L<"DELETE">), below. =head3 C When the client sends C or C requests, it will typically provide a 'Content-Type' header specifying the media type of the bytes it is sending in the request body. This content type is compared with the media types returned by this method. If there is no match, L returns a C<415 Unsupported Media Type> error response. (Unfortunately, there is no easy way for L or the application to know in advance that this error will be triggered, so it will be returned "bare" - i.e., without any explanatory response entity.) =head3 Other methods For handling character sets, encodings, and languages, L provides a number of other content negotiation methods: =over =item C =item C =item C =item C =item C =back However, they are only needed if the application does complex content negotiation. =head2 Part Three (resource existence) When we have made it past content negotiation, we know more than just which routines will be used to process the request entity (if any) and generate the response. We have gathered quite a bit of information about the request. All this information has been pushed onto the context, so it is available to all our resource methods, including the resource handler which we will get to presently. This information includes: (FIXME: verify this list as it is outdated) =over =item C The request method =item C The resource name, which can be used as a key to look up the full resource definition in the C<< $Web::MREST::InitRouter::resources >> =item C The name of the resource handler, e.g. C. In L, the resource handlers reside in the L module. =item C The full URI provided with the request =item C The base part of the URI (e.g. "http://localhost:5000/" ) =item C The relative path to the resource (e.g. "/bugreport") =item C Reference to an array the elements of which are the individual 'components' (i.e., everything between the '/' characters) of the C =item C A hashref mapping resource parameter names (if any) to their values =item C The content-length header. =item C The content-type header. =back One major piece of information is missing, however: whether the resource exists or not. For that, we have to actually call the resource handler. =head3 C (G7) The term "resource" is not precisely defined. It can refer to the resource definition (a data structure), the resource handler (a Perl subroutine called as an object method), or an object (set of records) in an underlying database. Or it can refer to all of the above, or to something else. The following paragraphs describe L's approach. By the time control reaches this method, the request URI has already been matched to a resource definition. So the resource handler is known. Since we have no other way of knowing, we ask the resource itself, by calling the handler with the scalar value C<1> (i.e. the numeral 1) as the sole argument. This handler call is referred to as the "first pass". How the handler is implemented does not concern us. We only ask that it return a boolean value (true or false) when called with this argument. If the return value from the handler is true, we can assume that the handler will be called again (second pass) in the response generation phase - read on. =head2 Part Four (generation of response entity) At this point we have =over =item gathered information about the request and placed it on the context =item run the resource handler (first pass) to determine resource existence =back Up until now (i.e., through determination of resource existence), the FSM has been a series of steps applied, in the same order, regardless of the HTTP method. In the sections below, we examine how responses are generated for each of four HTTP methods (C, C, C, and C) when the resource exists and when it doesn't exist. =head3 Resource exists =head4 C =over =item 1. C method call First, C is called to determine the name of the method that is capable of generating the response in the required format. This method is the one we mean when we refer to the "response generator". =item 2. Response generator method call Second, the response generator is called (from C in L). It is expected to always return an L object. If an error condition is detected, the handler should declare it using C<< $self->mrest_declare_status >> and then return a "non_ok" status. =back C is the only request method that demands a response entity in the format specified by the C header. For the other methods, response entities are optional, but recommended. In practice, this means that we have to create them ourselves. =head4 C Here we have two possible paths, depending on the value returned by C: =over =item C true =over =item C and C If, and only if, C is true, processing continues via C and C. Depending on the value of the latter, the request handler (determined by consulting C) is called either before or after C. The request handler should stage the response entity in preparation for finalization. The content type can be inferred from C<< $request->env->{'web.machine.context'} >>. =item Finalization Request is finalized by a call to C. =back =item C false If C returns false, all bets are off. For reasons I do not understand, L does not consult C or C on this type of request. The only thing it does is call C, and so it is up to this method to do whatever needs to be done to generate an entity and get it into the response. L helps by making sure that the content type is stored in the context (in the C<'content_type'> property), so C can look there for it and generate the response entity accordingly. =back =head4 C On all C requests, and those C requests that are handled as C requests (see above), L uses the following process: =over =item C This method is called to determine the name of the method that can process the request body. This method is expected not only to process the request body, but also to generate the response. Therefore, we refer to this method as the "response generator" for C requests. =item Response generator method call Next, the response generator is called. For C requests, the response generator is determined from C based on the Here again, the method referred to by C is not called by L, but the response generator is free to call C and find out the method itself, and call it. Or do something else. When C is true, the response generator is called from C in L. =back Whenever a new resource is created, a C header is added to the response with the URI path of the new resource. In general, we understand C to be a request to write to a resource. Typically, this will involve either creating (INSERT) or modifying (UPDATE) one or more database records/objects. Therefore, it has to be possible for a URI to resolve to a resource that does not yet exist. For example: PUT employee/nick/Bubba There may or may not be an employee by the name of Bubba in the database, but if we have a resource called 'employee/nick/:nick', Path::Router will match it in C and the resource handler will be called in C - up until this point, the same sequence of method calls is used for C, C, C, and C. L has no way of knowing whether there is an employee named Bubba. It is up to the handler to determine this, and then do an INSERT or UPDATE operation as appropriate. This operation is not expected to fail, but if it does fail the handler should force a 4xx or 5xx status code (and provide an explanation) by calling C<< $self->mrest_declare_status >>. If the request causes a new object - and, hence, a new resource - to be created, the handler should cause a C header with the URI of the new resource to be added to the response. This tells L to set the response status to C<201 Created>. If the request only modifies an existing object/resource, simply do not add a C header to the response. This will cause L to return a C<200 OK> status in the response. =head4 C For C, two methods are called: C and C. The C method should enact the delete operation and generate the response entity. The second method, C, is for cases when the delete operation cannot be guaranteed to have completed - this method defaults to false, but if it returns true L will trigger a C<...> response. =head3 Resource does not exist =head4 C Request goes to finalization with 404 status. =head4 C Request goes to C, which always returns false in L's implementation. After that, the request goes to finalization with 404 status. If the =head4 C =head2 C The previous sections should suffice for the reader to gain a degree of understanding of how the state machine works for various types of requests, and how L interfaces with the response handlers. The last cog of the FSM is C. =head1 IN-DEPTH DISCUSSIONS OF VARIOUS TOPICS =head2 Resource definitions As we read in the "crash course" above, resources are central to what a REST server is and does: the server processes incoming requests. Each request has a URI which resolves (or does not resolve) to a resource. Resources are defined as module variables: each module that contains resource handlers should also define a module variable (via C) containing the definitions of the resources covered by that module. The top-level dispatch module, L, should implement a method called C which calls the function Web::MREST::InitRouter::load_resource_defs for all the resource-defining modules. When the first HTTP request comes in, L calls the C method. This only happens once, ensuring that the resource definitions are fully loaded for the first - and all subsequent - requests. Each resource definition is a hashref consisting of a number of properties. This definition hashref is itself included in the C<$resources> package hashref, which essentially looks like this: { RESOURCE_NAME => RESOURCE_DEFINTION, RESOURCE_NAME => RESOURCE_DEFINTION, RESOURCE_NAME => RESOURCE_DEFINTION, } where C is a resource name (a string like C<'/'> or C<'docu/text'>) and C is that resource's definition hashref. The root resource should be defined under the name C<'/'> and top-level resources should have a C property set to this string. In the resource definition, properties can be specified either as a scalar value, in which case the definition applies to all the methods specified in C<< $site->MREST_SUPPORTED_HTTP_METHODS >>, or as a hashref in case the given resource is only defined for certain methods. In the latter case, it is not necessary to define all properties as hashrefs. The set of permitted methods will always be taken from the 'handler' property. For example in this snippet whizzo_resource is only defined for the GET method, and that will be applied to 'foo' (and the rest of this resource's properties) as well. 'whizzo_resource' => { 'handler' => { 'GET' => 'some_method', }, 'foo' => 'barbazbat', ... } So 'foo' will only be defined for the GET method. Examples: 'foo_prop' => 'value applied to all available methods', 'bar_prop' => { 'GET' => 'value applied to GET requests', 'POST' => 'value applied to POST requests', }, There is one required property, 'handler', which is used to specify the handler(s) for the resource (see the examples below). The value of this property is taken to be the name of a method. This method call looks like this: $self->$handler and is located in Web::MREST::Resource->resource_exists (The inheritance chain is set up in C - the server startup script - and via C statements in the various modules that make up the inheritance chain.) In addition, each resource may have any properties you, the application developer, wish to invest in it. For our 'docu' methods we use the properties 'description' and 'documentation', for example. Two properties - 'parent' and 'validations' - are exceptions to the above and should never be defined on a per-method basis: - 'validations' contains validation checks to be applied when matching URI to resource (for more information, see the Path::Router documentation). - 'parent' contains the name of the resource's parent resource (defaults to '' - the root resource) - 'documentation' is reserved for the self-documentation feature =head3 C object initialization When the server starts, the C and C meta parameters are initialized from the configuration file C in the L distribution. The application developer will of course want to define her own set of resources. This should be done by manipulating the meta parameters C and C. A good place to do this is in the application's C routine. Here are two approaches to defining the application's resources, depending on whether the application wishes to retain the L resources. =over =item 1. retain package MyApp::Resource; use Clone 'clone'; use parent 'Web::MREST::Resource'; # We assume that the application somehow loads its resource definitions # (including the root resource) into a package variable $r_defs -- for # example by hard-coding them like this my $r_defs = { ... }; # ---------------------------------------- # mrest_init_router - called by Web::MREST # ---------------------------------------- sub mrest_init_router { my $self = shift; # set up the root resource $meta->set( 'MREST_ROOT_RESOURCE', $r_defs->{''} ); delete $r_defs->{''}; # set up the remaining resources, retaining (but possibly # overwriting) the Web::MREST default resources my $mrest_defs = clone( $meta->MREST_RESOURCE_DEFINITIONS ); foreach my $r_name ( keys %$r_defs ) { $mrest_defs->{$r_name} = $r_defs->{$r_name}; } $meta->set( 'MREST_RESOURCE_DEFINITIONS', $mrest_defs ); } =item 2. do not retain This approach is more simple because no C need be written. The application should have its own distro sharedir C and therein a file C. Inside that file, the application puts its own resource definitions in the C and C parameters (refer to C in the L distribution for syntax and semantics). The application's definitions will overlay (i.e. replace) those of L. Even in this scenario, some or all of L's resources could be used in the application, but only by copy-pasting the definitions and their respective handlers into the application's source code. =back =head3 Tree structure L allows resources to be defined in a tree structure. It is designed to allow a tree structure to be described in a flat configuration file. The C hash is keyed on the resource name. Child resources are indicated by including a C property with the name of the parent resource. Care should be exercised not to introduce any circular references. If a flat structure is desired, simply do not include any C properties in your resource definitions. The format of C hash is documented in C. =head3 C<< $Web::MREST::InitRouter::resources >> The resource definition hashrefs in the dispatch modules are designed to be written and maintained by humans. When the C method runs, it loops over all the resource definitions and builds up a second hash, C<< $Web::MREST::InitRouter::resources >>, which contains the same information in a format that is more convenient for automated processing. Since the resource definitions are a potential source of typographical and semantic errors, you should dump this package variable to the log and examine it to make sure your resource definitions are being processed correctly. =head2 Errors As we move through the state machine (i.e. the chain of method calls driven by L), we build up a "context" from which we generate the HTTP response. Stated very simply, the response code can either be 'OK' (200) or "something else" - i.e., an error of some kind. And, indeed, checking for errors accounts for a large portion of what our resource modules do. As RFC2616 explains, errors can be divided into two brought classes: client errors and server errors. =over =item Client errors (4xx) Client errors have status codes that start with 4 (e.g. 400, 401, 404). RFC2616 has this to say about them: The 4xx class of status code is intended for cases in which the client seems to have erred. Except when responding to a HEAD request, the server SHOULD include an entity containing an explanation of the error situation, and whether it is a temporary or permanent condition. These status codes are applicable to any request method. User agents SHOULD display any included entity to the user. =item Server errors (5xx) Server errors have codes beginning with th digit "5". According to RFC2616, they indicate cases in which the server is aware that it has erred or is incapable of performing the request. Except when responding to a HEAD request, the server SHOULD include an entity containing an explanation of the error situation, and whether it is a temporary or permanent condition. User agents SHOULD display any included entity to the user. These response codes are applicable to any request method. =back The key point here is that it is not sufficient to return a bare 4xx or 5xx response status code. The response should include an entity body with an explanation of the error condition. =head3 How to provide explanation in response entity L provides a mechanism for adding the explanation to the entity body as called for by RFC2616. At the exact place in your resource module where you discover the error, do something like this: $self->mrest_declare_status( code => '400', explanation => 'You messed up' ); This will be converted into the respective L object and returned in the response entity. The object will have properties like this: { level => 'ERR', code => 'You messed up', payload => { http_code => '500', uri_path => ... (taken from the context), resource_name => ... (taken from the context), found_in => ... (taken from 'caller'), permanent => JSON::true (the default), }, } Alternatively, you can pass in your own arbitary L object. To see how the L object becomes the response entity, see the C method in L. =head2 Context Typically referred to as C<$context>, the "MREST context" is a hashref that is built up during the course of request processing. In addition to being used within L, it is always sent as an argument whenever L calls a hook, so the developer can modify it in her implementations of the various hook routines. =head2 Authentication Ever since the Big Bad Wolf ate Granny, authentication mechanisms have been prone to abuse by individuals who are willing to lie about their identity. Humans are good at distinguishing one human from another, provided they can apply all their senses to the task. Computers lack proper senses and are downright awful at this task. Computerized authentication schemes typically operate by presenting the user with one or more hoops to jump through. Whoever succeeds at this task is deemed to be the user. What could go wrong? Passwords (or passphrases) are the "hoop" most frequently used to authenticate users and keep would-be intruders out. Therefore, a system's security is often gauged by how well it protects user credentials from disclosure. Since usernames are public, the only thing keeping a determined intruder at bay are the passwords, and various measures are taken to protect them. From the perspective of L, authentication is a matter of calling the L method. If the return value is false, the response will be C<401 Unauthorized>. If it is true, request processing continues. Whatever authentication measures the application developer decides to implement should be triggered by this method call. For more about L, see the L =head2 Authorization Once authentication has determined the user's identity, a related task, authorization, begins. As the name would imply (and the RFC's vague use of the term "authorization" notwithstanding), authorization answers the question: Is this specific user authorized to make this request? Compare this with authentication, which answers a different question: Is this user really who they are purporting to be? Or, even more pithily: Who is this user? Authorization implies a boolean "function" (in both the mathematical and computer science sense) that takes three arguments: the username, the HTTP method, and the resource. Implementation of this function is left to the application developer. It is worth noting here that L provides a C method. Since C is already taken for authentication, we can use C for authorization. Just be sure to understand thoroughly that a true return value from C means "not authorized". =head2 Customized URI parsing While L provides for URI parsing using L, if this is not desired the application developer can parse URIs herself by simply substituting her own C and C methods for the ones provided by L and L, respectively. When request processing enters C, Alternatively, the application developer can overlay the C routine with one that returns an arbitrary object (stored in C<$router>) that has a C method. After that, L does my $match = $router->match( $path ); where C<$path> is the relative portion of the URI (i.e. everything left after the C part is cut off). The C<$match> object should provide a C method, which should return the definition of the matched resource. See L<"RESOURCE DEFINITIONS">. =head1 FUNCTIONS IN THIS MODULE =head2 init Do initialization-like things, such as loading configuration parameters. Takes a PARAMHASH which can contain one of the following: =over =item C The name of the application distribution from which the distro sharedir will be loaded. =item C The name (full path) of a directory containing the application's configuration files. =item C A reference to a hash containing meta parameters to be loaded. =back =cut sub init { my %ARGS = validate( @_, { distro => { type => SCALAR, optional => 1 }, sitedir => { type => SCALAR, optional => 1 }, hashref => { type => HASHREF, optional => 1 }, early_debug => { type => SCALAR, optional => 1 }, } ); my $tf = $ARGS{'early_debug'}; if ( $tf ) { _touch $tf; if ( -r $tf and -w $tf ) { unlink $tf; Log::Any::Adapter->set( 'File', $tf ); $log->debug( __PACKAGE__ . "::init activating early debug logging to $tf" ); } else { print "Given unreadable/unwritable early debugging filespec $tf\n"; } } # always load Web::MREST's configuration parameters my $target = File::ShareDir::dist_dir('Web-MREST'); $log->debug( "About to load Web::MREST configuration parameters from $target" ); my $status = $CELL->load( sitedir => $target, verbose => 1 ); return $status if $status->not_ok; $meta->set( 'MREST_EARLY_DEBUGGING', $tf ); # if argument provided, load that, too if ( %ARGS ) { $target = undef; if ( $ARGS{'distro'} and $ARGS{'distro'} ne 'Web-MREST' ) { # distro must be given as "MyApp-Foo", not "MyApp::Foo" $target = File::ShareDir::dist_dir( $ARGS{'distro'} ); $status = $CELL->load( sitedir => $target ); return $status if $status->not_ok; } if ( my $sitedir_target = $ARGS{'sitedir'} ) { if ( -d $sitedir_target ) { $status = $CELL->load( sitedir => $sitedir_target ); return $status if $status->not_ok; } else { $log->warn( 'Web::MREST::init() says sitedir argument given, but it is not a directory: ' . Dumper( $sitedir_target ) ); } } if ( $ARGS{'hashref'} ) { my $count = 0; foreach my $key ( keys %{ $ARGS{'hashref'} } ) { $meta->set( $key, $ARGS{'hashref'}->{$key} ); $count += 1; } $log->notice( "Web::MREST::init loaded $count meta parameters from a hashref" ); } } return $CELL->status_ok; } =head2 version Accessor method (to be called like a constructor) providing access to C<$VERSION> variable =cut sub version { $VERSION; } 1; Web-MREST-0.290/lib/Web/MREST000755001750000144 014257045157 15632 5ustar00smithfarmusers000000000000Web-MREST-0.290/lib/Web/MREST/Dispatch.pm000444001750000144 4724414257045157 20117 0ustar00smithfarmusers000000000000# ************************************************************************* # 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; Web-MREST-0.290/lib/Web/MREST/Entity.pm000444001750000144 2306614257045157 17630 0ustar00smithfarmusers000000000000# ************************************************************************* # 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 methods for dealing with request and response # entities (parts two and four of the FSM as described in the L # documentation # ------------------------ package Web::MREST::Entity; use strict; use warnings; use App::CELL qw( $CELL $log $meta $site ); use Data::Dumper; use Try::Tiny; use Web::Machine::FSM::States; use Web::MREST::Util qw( $JSON ); use parent 'Web::MREST::Resource'; =head1 NAME Web::MREST::Entity - Methods for dealing with request, response entities =head1 SYNOPSIS Methods for dealing with request, response entities =head1 METHODS =head2 get_acceptable_content_type_handler The method to use to process the request entity (i.e, the "acceptable content type handler") is set in content_types_accepted. Web::Machine only calls the method on PUT requests and those POST requests for which post_is_create is true. On POST requests where post_is_create is false, we have to call it ourselves, and for that we need a way to get to it. =cut sub get_acceptable_content_type_handler { my $self = shift; Web::Machine::FSM::States::_get_acceptable_content_type_handler( $self, $self->request ); } =head2 content_types_provided L calls this routine to determine how to generate the response body GET requests. (It is not called for PUT, POST, or DELETE requests.) The return value has the following format: [ { 'text/html' => 'method_for_html' }, { 'application/json' => 'method_for_json' }, { 'other/mime' => 'method_for_other_mime' }, ] As you can see, this is a list of tuples. The key is a media type and the value is the name of a method. The first tuple is taken as the default. =cut sub content_types_provided { my $self = shift; my @caller = caller; $log->debug( "Entering " . __PACKAGE__ . "::content_types_provided, caller is " . Dumper( \@caller ) ); return [ { 'text/html' => 'mrest_generate_response_html' }, { 'application/json' => 'mrest_generate_response_json' }, ]; } =head2 mrest_generate_response_html Normally, clients will communicate with the server via '_render_response_json', but humans need HTML. This method takes the server's JSON response and wraps it up in a nice package. The return value from this method becomes the response entity. =cut sub mrest_generate_response_html { my ( $self ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::_render_response_html (response generator)" ); my $json = $self->mrest_generate_response_json; return $json if ref( $json ) eq 'SCALAR'; my $msgobj = $CELL->msg( 'MREST_RESPONSE_HTML', $site->MREST_APPLICATION_MODULE, $json, ); my $entity = $msgobj ? $msgobj->text : '

Internal Error

See Resource.pm->_render_response_html

'; $self->response->header('Content-Type' => 'text/html' ); $self->response->content( $entity ); return $entity; } =head2 content_types_accepted L calls this routine to determine how to handle the request body (e.g. in PUT requests). =cut sub content_types_accepted { my $self = shift; my @caller = caller; $log->debug("Entering " . __PACKAGE__ . "::content_types_accepted, caller is " . Dumper( \@caller ) ); return [ { 'application/json' => 'mrest_process_request_json' }, ] } =head2 mrest_process_request_json PUT and POST requests may contain a request body. This is the "handler function" where we process those requests. We associate this function with 'application/json' via C. =cut sub mrest_process_request_json { my $self = shift; my @caller = caller; $log->debug("Entering " . __PACKAGE__ . "::mrest_process_request_json, caller is " . Dumper( \@caller ) ); # convert body to JSON my ( $from_json, $status ); try { my $content = $self->request->content; if ( ! defined $content or $content eq '' ) { $log->debug( "There is no request body, assuming JSON null" ); $content = 'null'; } $log->debug( "Attempting to decode JSON request entity $content" ); $from_json = $JSON->decode( $content ); $log->debug( "Success" ); } catch { $status = \400; $log->error( "Caught JSON decode error; response code should be " . $$status ); $self->mrest_declare_status( 'code' => $$status, explanation => $_ ); }; return $status if ref( $status ) eq 'SCALAR'; $self->push_onto_context( { 'request_entity' => $from_json } ); return $self->mrest_generate_response; } =head2 mrest_process_request Used to call the request handler manually in cases when L does not call it for us. =cut sub mrest_process_request { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::mrest_process_request" ); my $handler = $self->get_acceptable_content_type_handler; if ( ref( $handler ) eq 'SCALAR' ) { $self->mrest_declare_status( code => $$handler, explanation => 'Could not get acceptable content type handler' ); return $CELL->status_not_ok; } $log->debug( "acceptable request handler is: " . Dumper( $handler ) ); return $self->$handler; } =head2 mrest_generate_response_json First, run pass 2 of the resource handler, which is expected to return an App::CELL::Status object. Second, push that object onto the context. Third, convert that object into JSON and push the JSON onto the context, too. Return the JSON representation of the App::CELL::Status object - this becomes the HTTP response entity. =cut sub mrest_generate_response_json { my ( $self ) = @_; my ( $d, %h, $before, $after, $after_utf8 ); my @caller = caller; $log->debug( "Entering " . __PACKAGE__ . "::mrest_generate_response_json, caller is " . Dumper( \@caller ) ); # run the handler my $handler = $self->context->{'handler'}; # WWWW $log->debug( "mrest_generate_response_json: Calling resource handler $handler for pass two" ); my ( $status, $response_obj, $entity ); try { $status = $self->$handler(2); if ( ( my $reftype = ref( $status ) ) ne 'App::CELL::Status' ) { die "AAAAHAGGHG! Handler $handler, pass two, returned a ->$reftype<-, " . "which is not an App::CELL::Status object!"; } if ( $status->not_ok and ! $self->status_declared ) { $status->{'http_code'} = 500; $self->mrest_declare_status( $status ); } $response_obj = $status->expurgate; $entity = $JSON->encode( $response_obj ); } catch { if ( ! $self->status_declared ) { $self->mrest_declare_status( code => 500, explanation => $_ ); } my $code = $self->mrest_declared_status_code; $code += 0; $status = \$code; }; $log->debug( "response generator returned " . Dumper( $status ) ); return $status if ref( $status ) eq 'SCALAR'; # for PUT requests, we need a Location header if a new resource was created if ( $self->context->{'method'} eq 'PUT' ) { my $headers = $self->response->headers; my $uri_path = $self->context->{'uri_path'}; $headers->header( 'Location' => $uri_path ) unless $self->context->{'resource_exists'}; } # stage the status object to become the response entity $self->push_onto_context( { 'handler_status' => $status, 'response_object' => $response_obj, 'response_entity' => $entity, } ); # put the entity into the response $self->response->header('Content-Type' => 'application/json' ); $self->response->content( $entity ); $log->debug( "Response will be: " . $self->response->content ); return $entity; } =head2 mrest_generate_response This should somehow get the response handler and run it. =cut sub mrest_generate_response { my $self = shift; return $self->mrest_generate_response_json; } 1; Web-MREST-0.290/lib/Web/MREST/InitRouter.pm000444001750000144 1556414257045157 20464 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* package Web::MREST::InitRouter; use 5.012; use strict; use warnings; use App::CELL qw( $log $meta $site ); use Data::Dumper; use Path::Router; use Try::Tiny; =head1 NAME Web::MREST::InitRouter - Routines for initializing our Path::Router instance =head1 SYNOPSIS L uses L to match URIs to resources. All resources are packed into a single object. The singleton is exported as C<$router> from this module and can be initialized by calling C, which is also exported, with no arguments. use Web::MREST::InitRouter qw( $router ); ... Web::MREST::InitRouter::init_router() unless defined $router and $router->can( 'match' ); =head1 PACKAGE VARIABLES =cut our $router; our $resources = {}; our @non_expandable_properties = qw( parent validations documentation resource_name children ); our %no_expand_map = map { ( $_ => '' ) } @non_expandable_properties; =head1 EXPORTS This module provides the following exports: =over =item C<$router> (Path::Router singleton) =item C<$resources> (expanded resource definitions) =back =cut use Exporter qw( import ); our @EXPORT_OK = qw( $router $resources ); =head1 FUNCTIONS =cut # # read in multiple resource definitions from a hash # sub load_resource_defs { my $defs = shift; #$log->debug("Entering " . __PACKAGE__. "::_load_resource_defs with argument " . Dumper( $defs )); # first pass -> expand resource defs and add them to $resources foreach my $resource ( keys( %$defs ) ) { # each resource definition is a hash. if ( ref( $defs->{$resource} ) eq 'HASH' ) { _process_resource_def( $resource, $defs->{$resource} ); } else { die "AAAAAAAHHHHHHH! Definition of resource $resource is not a hashref!"; } _add_route( $resource ); } } # processes an individual resource definition hash and adds Path::Router route # for it sub _process_resource_def { my ( $resource, $resource_def ) = @_; #$log->debug("Entering " . __PACKAGE__. "::_process_resource_def with:" ); $log->info("Initializing \$resource ->$resource<-"); #$log->debug("\$resource_def " . Dumper( $resource_def ) ); # expand all properties except those in %no_expand_map foreach my $prop ( keys %$resource_def ) { next if exists $no_expand_map{ $prop }; _expand_property( $resource, $resource_def, $prop ); } # handle non-expandable properties # # - validations my $validations = $resource_def->{'validations'}; $resources->{$resource}->{'validations'} = $validations if $resource_def->{'validations'}; # # - documentation my $documentation = $resource_def->{'documentation'}; $resources->{$resource}->{'documentation'} = $documentation if $resource_def->{'documentation'}; # # - parent if ( $resource ne '/' ) { my $parent = $resource_def->{'parent'} || '/'; push( @{ $resources->{$parent}->{'children'} }, $resource ); $resources->{$resource}->{'parent'} = $parent; } return; } sub _add_route { my $resource = shift; my %validations; if ( ref( $resources->{$resource}->{'validations'} ) eq 'HASH' ) { %validations = %{ $resources->{$resource}->{'validations'} }; delete $resources->{$resource}->{'validations'}; } my $ARGS = { target => $resources->{$resource}, }; $ARGS->{'validations'} = \%validations if %validations; try { $router->add_route( $resource, %$ARGS ); } catch { $log->crit( $_ ); }; } # takes an individual resource definition property, expands it and puts it in # $resources package variable sub _expand_property { my ( $resource, $resource_def, $prop ) = @_; #$log->debug("Entering " . __PACKAGE__. "::_expand_property with " . # "resource \"$resource\" and property \"$prop\"" ); # set the resource_name property $resources->{$resource}->{'resource_name'} = $resource; my @supported_methods = ( ref( $resource_def->{'handler'} ) eq 'HASH' ) ? keys( %{ $resource_def->{'handler'} } ) : @{ $site->MREST_SUPPORTED_HTTP_METHODS || [ qw( GET POST PUT DELETE ) ] }; foreach my $method ( @supported_methods ) { #$log->debug( "Considering the \"$method\" method" ); if ( exists $resource_def->{$prop} ) { my $prop_def = $resource_def->{$prop}; my $refv = ref( $prop_def ) || 'SCALAR'; #$log->debug( "The definition of this property is a $refv" ); if ( $refv eq 'HASH' ) { if ( $prop_def->{$method} ) { $resources->{$resource}->{$method}->{$prop} = $prop_def->{$method}; } else { $log->crit( "No $prop defined for $method method in $resource!" ); } } elsif ( $refv eq 'SCALAR' ) { $resources->{$resource}->{$method}->{$prop} = $prop_def; } else { die "AAAAAGAAAGAAAAAA! in " . __FILE__ . ", _populate_resources"; } } else { # resource with no def_part: suspicious $log->notice( "While walking resource definition tree, " . "encountered resource $resource with missing $prop in its definition" ); } } } 1; Web-MREST-0.290/lib/Web/MREST/Resource.pm000444001750000144 10246114257045157 20160 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2016, 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 defines how our web server handles the request-response # cycle. All the "heavy lifting" is done by Web::Machine and Plack. # ------------------------ package Web::MREST::Resource; use strict; use warnings; use feature "state"; use App::CELL qw( $CELL $log $meta $site ); use App::CELL::Status; use Data::Dumper; use JSON; use Params::Validate qw( :all ); use Plack::Session; use Try::Tiny; use Web::MREST::InitRouter qw( $router ); use Web::MREST::Util qw( $JSON ); # methods/attributes not defined in this module will be inherited from: use parent 'Web::Machine::Resource'; # use this to muffle debug messages in parts of the FSM my %muffle = ( '1' => 0, '2' => 1, '3' => 1, '4' => 1, '5' => 0, ); =head1 NAME App::MREST::Resource - HTTP request/response cycle =head1 SYNOPSIS In C: use parent 'Web::MREST::Resource'; In PSGI file: use Web::Machine; Web::Machine->new( resource => 'App::YourApp::Resource', )->to_app; It is important to understand that the L object created is actually blessed into C. The line of inheritance is: YourApp::Resource -> Web::MREST::Resource -> Web::Machine::Resource -> Plack::Component =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 versions of selected routines. =head1 METHODS =head2 Context methods Methods for manipulating the context, a hash where we accumulate information about the request. =head3 context Constructor/accessor =cut sub context { my $self = shift; $self->{'context'} = shift if @_; if ( ! $self->{'context'} ) { $self->{'context'} = {}; } return $self->{'context'}; } =head3 push_onto_context Takes a hashref and "pushes" it onto C<< $self->{'context'} >> for use later on in the course of processing the request. =cut sub push_onto_context { my $self = shift; my ( $hr ) = validate_pos( @_, { type => HASHREF } ); my $context = $self->context; foreach my $key ( keys %$hr ) { $context->{$key} = $hr->{$key}; } $self->context( $context ); } =head2 Status declaration methods Although L takes care of setting the HTTP response status code, but when we have to override L's value we have this "MREST declared status" mechanism, which places a C property in the context. During finalization, the HTTP status code placed in this property overrides the one L came up with. =head3 mrest_declare_status This method takes either a ready-made L object or, alternatively, a PARAMHASH. In the former case, an HTTP status code can be "forced" on the response by including a C property in the object. In the latter case, the following keys are recognized (and all of them are optional): =over =item level L level, can be any of the strings accepted by that module. Defaults to 'ERR'. =item code The HTTP status code to be applied to the response. Include this only if you need to override the code set by L. =item explanation Text explaining the status - use this to comply with RFC2616. Defaults to ''. =item permanent Boolean value for error statuses, specifies whether or not the error is permanent - use this to comply with RFC2616. Defaults to true. =back =cut sub mrest_declare_status { my $self = shift; my @ARGS = @_; my @caller = caller; $log->debug( "Entering " . __PACKAGE__ . "::mrest_declare_status with argument(s) " . Dumper( \@ARGS ) . "\nCaller: " . Dumper( \@caller ) ); # if status gets declared multiple times, keep only the first one if ( exists $self->context->{'declared_status'} ) { $log->notice( "Cowardly refusing to overwrite previously declared status with this one: " . Dumper( \@ARGS ) ); return; } my $declared_status; if ( @ARGS and ref( $ARGS[0] ) eq 'App::CELL::Status' ) { # # App::CELL::Status object was given; bend it to our needs # $declared_status = $ARGS[0]; # make sure there is a payload and it is a hashref if ( ! $declared_status->payload ) { $declared_status->payload( {} ); } # if 'http_code' property given, move it to the payload if ( my $hc = delete( $declared_status->{'http_code'} ) ) { $log->debug( "mrest_declare_status: HTTP code is $hc" ); $declared_status->payload->{'http_code'} = $hc; } # handle 'permanent' property if ( my $pt = delete( $declared_status->{'permanent'} ) ) { $declared_status->payload->{'permanent'} = $pt ? JSON::true : JSON::false; } else { $declared_status->payload->{'permanent'} = JSON::true; } } else { # # PARAMHASH was given # my %ARGS = validate( @ARGS, { 'level' => { type => SCALAR, default => 'ERR' }, 'code' => { type => SCALAR|UNDEF, default => undef }, 'explanation' => { type => SCALAR, default => '' }, 'permanent' => { type => SCALAR, default => 1 }, 'args' => { type => ARRAYREF, optional => 1 }, } ); $ARGS{'args'} = [] unless $ARGS{'args'}; $declared_status = App::CELL::Status->new( level => $ARGS{'level'}, code => $ARGS{'explanation'}, args => $ARGS{'args'}, payload => { http_code => $ARGS{'code'}, # might be undef permanent => ( $ARGS{'permanent'} ) ? JSON::true : JSON::false, }, ); } # add standard properties to the payload $declared_status->payload->{'uri_path'} = $self->context->{'uri_path'}; $declared_status->payload->{'resource_name'} = $self->context->{'resource_name'}; $declared_status->payload->{'http_method'} = $self->context->{'method'}; $declared_status->payload->{'found_in'} = { package => (caller)[0], file => (caller)[1], line => (caller)[2]+0, }; # the object is "done": push it onto the context $self->push_onto_context( { 'declared_status' => $declared_status, } ); } =head3 mrest_declared_status_code Accessor method, gets just the HTTP status code (might be undef); and allows setting the HTTP status code, as well, by providing an argument. =cut sub mrest_declared_status_code { my ( $self, $arg ) = @_; return unless ref( $self->context->{'declared_status'} ) eq 'App::CELL::Status'; my $dsc = $self->context->{'declared_status'}->payload->{'http_code'}; if ( $arg ) { $log->warn( "Overriding previous declared status code ->" . ( $dsc || 'undefined' ) . "<- with new value -> " . ( $arg || 'undefined' ) . "<->" ); $self->context->{'declared_status'}->payload->{'http_code'} = $arg; $dsc = $arg; } return $dsc; } =head3 mrest_declared_status_explanation Accessor method, gets just the explanation (might be undef). Does not allow changing the explanation - for this, nullify the declared status and declare a new one. =cut sub mrest_declared_status_explanation { my ( $self, $arg ) = @_; return unless ref( $self->context->{'declared_status'} ) eq 'App::CELL::Status'; return $self->context->{'declared_status'}->text; } =head2 status_declared Boolean method - checks context for presence of 'declared_status' property. If it is present, the value of that property is returned, just as if we had done C<< $self->context->{'declared_status'} >>. Otherwise, undef (false) is returned. =cut sub status_declared { my $self = shift; if ( my $declared_status_object = $self->context->{'declared_status'} ) { #$log->debug( "Declared status: " . Dumper( $declared_status_object ) ); if ( ref( $declared_status_object ) ne 'App::CELL::Status' ) { die "AAAHAAHAAA! Declared status object is not an App::CELL::Status!"; } return $declared_status_object; } return; } =head2 declared_status Synonym for C =cut sub declared_status { my $self = shift; return $self->status_declared; } =head2 nullify_declared_status This method nullifies any declared status that might be pending. =cut sub nullify_declared_status { my $self = shift; $log->debug( "Nullifying declared status: " . Dumper( $self->context->{'declared_status'} ) ); delete $self->context->{'declared_status'}; return; } =head2 FSM Part One The following methods override methods defined by L. They correspond to what the L calls "Part One" of the FSM. To muffle debug-level log messages from this part of the FSM, set $muffle{1} = 1 (above). =head3 service_available (B13) This is the first method called on every incoming request. =cut sub service_available { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::service_available (B13)" ) unless $muffle{1}; $self->init_router unless ref( $router ) and $router->can( 'match' ); my $path = $self->request->path_info; $path =~ s{^\/}{}; my $reported_path = ( $path eq '' ) ? 'the root resource' : $path; $log->info( "Incoming " . $self->request->method . " request for $reported_path" ); $log->info( "Self is a " . ref( $self ) ); $self->push_onto_context( { 'headers' => $self->request->headers, 'request' => $self->request, 'uri_path' => $path, 'method' => $self->request->method, } ); return $self->mrest_service_available; } =head3 mrest_service_available Hook. If you overlay this and intend to return false, you should call C<< $self->mrest_declare_status >> !! =cut sub mrest_service_available { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::mrest_service_available" ) unless $muffle{1}; return 1; } =head3 known_methods (B12) Returns the value of C site parameter =cut sub known_methods { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::known_methods (B12)" ) unless $muffle{1}; my $method = $self->context->{'method'}; my $known_methods = $site->MREST_SUPPORTED_HTTP_METHODS || [ qw( GET POST PUT DELETE ) ]; $log->debug( "The known methods are " . Dumper( $known_methods ) ) unless $muffle{1}; if ( ! grep { $method eq $_; } @$known_methods ) { $log->debug( "$method is not among the known methods" ) unless $muffle{1}; $self->mrest_declare_status( explanation => "The request method $method is not one of the supported methods " . join( ', ', @$known_methods ) ); } return $known_methods; } =head3 uri_too_long (B11) Is the URI too long? =cut sub uri_too_long { my ( $self, $uri ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::uri_too_long (B11)" ) unless $muffle{1}; my $max_len = $site->MREST_MAX_LENGTH_URI || 100; $max_len += 0; if ( length $uri > $max_len ) { $self->mrest_declare_status; return 1; } $self->push_onto_context( { 'uri' => $uri } ); return 0; } =head3 allowed_methods (B10) Determines which HTTP methods we recognize for this resource. We return these methods in an array. If the requested method is not included in the array, L will return the appropriate HTTP error code. RFC2616 on 405: "The response MUST include an Allow header containing a list of valid methods for the requested resource." -> this is handled by Web::Machine, but be aware that if the methods arrayref returned by allowed_methods does not include the current request method, allow_methods gets called again. =cut sub allowed_methods { my ( $self ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::allowed_methods (B10)" ) unless $muffle{1}; # # Does the URI match a known resource? # my $path = $self->context->{'uri_path'}; my $method = uc $self->context->{'method'}; $log->debug( "allowed_methods: path is $path, method is $method" ) unless $muffle{1}; if ( my $match = $router->match( $path ) ) { # path matches resource, but is it defined for this method? #$log->debug( "match object: " . Dumper( $match ) ); my $resource_name = $match->route->target->{'resource_name'}; $resource_name = ( defined $resource_name ) ? $resource_name : 'NONE_AAGH!'; $self->push_onto_context( { 'match_obj' => $match, 'resource_name' => $resource_name } ); $log->info( "allowed_methods: $path matches resource ->$resource_name<-" ); my ( $def, @allowed_methods ) = $self->_extract_allowed_methods( $match->route->target ); if ( $def ) { # method is allowed for this resource; push various values onto the context for later use $self->_stash_resource_info( $match ); $self->_get_handler( $def ); } else { # method not allowed for this resource $self->mrest_declare_status( 'explanation' => "Method not allowed for this resource" ); return \@allowed_methods; } if ( $self->status_declared ) { # something bad happened return []; } # success return \@allowed_methods; } # if path does not match, return an empty arrayref, which triggers a 405 status code $self->mrest_declare_status( 'code' => 400, 'explanation' => "URI does not match a known resource" ); return []; } sub _extract_allowed_methods { my ( $self, $target ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::_extract_allowed_methods" ) unless $muffle{1}; #$log->debug( "Target is: " . Dumper( $target ) ); # --------------------------------------------------------------- # FIXME: need to come up with a more reasonable way of doing this # --------------------------------------------------------------- # # The keys of the $route->target hash are the allowed methods plus: # - 'resource_name' # - 'parent' # - 'children' # - 'documentation' # # So, using set theory we can say that the set of allowed methods # is equal to the set of $route->target hash keys MINUS the set # of keys listed above. (This is fine until someone decides to # add another key to a resource definition and forgets to add it # here as well.) # # --------------------------------------------------------------- my @allowed_methods; foreach my $method ( keys %{ $target } ) { push( @allowed_methods, $method ) unless $method =~ m/(resource_name)|(parent)|(children)|(documentation)/; } $log->debug( "Allowed methods are " . join( ' ', @allowed_methods ) ) unless $muffle{1}; return ( $target->{ $self->context->{'method'} }, @allowed_methods ); } sub _stash_resource_info { my ( $self, $match ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::_stash_resource_info" ) unless $muffle{1}; # N.B.: $uri is the base URI, not the path my $uri = $site->MREST_URI ? $site->MREST_URI : $self->request->base->as_string; my $push_hash = { 'mapping' => $match->mapping, # mapping contains values of ':xyz' parts of path 'uri_base' => $uri, # base URI of the REST server 'components' => $match->route->components, # resource components }; $self->push_onto_context( $push_hash ); #$log->debug( "allowed_methods: pushed onto context " . Dumper( $push_hash ) ); } sub _get_handler { my ( $self, $def ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::_get_handler with resource definition: " . Dumper( $def ) ) unless $muffle{1}; # be idempotent if ( my $handler_from_context = $self->context->{'handler'} ) { return $handler_from_context; } my $status = 0; my $handler_name; if ( $handler_name = $def->{'handler'} ) { # $handler_name is the name of a method that will hopefully be callable # by doing $self->$handler_name $self->push_onto_context( { 'handler' => $handler_name, } ); } else { $status = "No handler defined for this resource+method combination!"; } if ( $status ) { $self->mrest_declare_status( 'code' => '500', explanation => $status ); $log->err( "Leaving _get_handler with status $status" ); } else { $log->info( "Leaving _get_handler (all green) - handler is ->$handler_name<-" ); } } =head3 malformed_request (B9) A true return value from this method aborts the FSM and triggers a "400 Bad Request" response status. =cut sub malformed_request { my ( $self ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::malformed_request (B9)" ) unless $muffle{1}; # we examing the request body on PUT and POST only (FIXME: make this configurable) my $method = $self->context->{'method'}; return 0 unless $method =~ m/^(PUT)|(POST)$/; #$log->debug( "Method is $method" ); # get content-type and content-length my $content_type = $self->request->headers->header('Content-Type'); $content_type = '' unless defined( $content_type ); my $content_length = $self->request->headers->header('Content-Length'); $content_length = '' unless defined( $content_length ); #$log->debug( "Content-Type: $content_type, Content-Length: $content_length" ); # no Content-Type and/or no Content-Length, yet request body present -> # clearly a violation if ( $self->request->content ) { if ( $content_type eq '' or $content_length eq '' ) { $self->mrest_declare_status( explanation => 'no Content-Type and/or no Content-Length, yet request body present' ); return 1; } } $self->push_onto_context( { 'headers' => { 'content-length' => $content_length, 'content-type' => $content_type, } } ); return $self->mrest_malformed_request; } =head3 mrest_malformed_request Hook =cut sub mrest_malformed_request { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::mrest_malformed_request (B9)" ) unless $muffle{1}; return 0; } =head3 is_authorized (B8) Authentication method - should be implemented in the application. =cut sub is_authorized { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::is_authorized (B8)" ) unless $muffle{1}; return 1; } =head3 forbidden (B7) Authorization method - should be implemented in the application. =cut sub forbidden { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::forbidden (B7)" ) unless $muffle{1}; return 0; } =head3 valid_content_headers (B6) Receives a L object containing all the C headers in the request. Checks these against << $site->MREST_VALID_CONTENT_HEADERS >>, returns false if the check fails, true if it passes. =cut sub valid_content_headers { my ( $self, $content_headers ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::valid_content_headers (B6)" ) unless $muffle{1}; $log->debug( "Content headers: " . join( ', ', keys( %$content_headers ) ) ) unless $muffle{1}; # get site param my $valid_content_headers = $site->MREST_VALID_CONTENT_HEADERS; die "AAAAAHAHAAAAAHGGGG!! \$valid_content_headers is not an array reference!!" unless ref( $valid_content_headers ) eq 'ARRAY'; # check these content headers against it my $valids = _b6_make_hash( $valid_content_headers ); foreach my $content_header ( keys( %$content_headers ) ) { if ( not exists $valids->{$content_header} ) { $self->mrest_declare_status( explanation => "Content header ->$content_header<- not found in MREST_VALID_CONTENT_HEADERS" ); return 0; } } return 1; } sub _b6_make_hash { my $ar = shift; my %h; foreach my $chn ( @$ar ) { $chn = 'Content-' . $chn unless $chn =~ m/^Content-/; $h{ $chn } = ''; } return \%h; } =head3 known_content_type (B5) The assumption for C and C requests is that they might have an accompanying request entity, the type of which should be declared via a C header. If the content type is not recognized by the application, return false from this method to trigger a "415 Unsupported Media Type" response. The basic content-types (major portions only) accepted by the application should be listed in C<< $site->MREST_SUPPORTED_CONTENT_TYPES >>. Override this method if that's not good by you. =cut sub known_content_type { my ( $self, $content_type ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::known_content_type (B5)" ) unless $muffle{1}; return 1 if not $content_type; # if $content_type is a blessed object, deal with that my $ct_isa = ref( $content_type ); if ( $ct_isa ) { $log->debug( "\$content_type is a ->$ct_isa<-" ) unless $muffle{1}; if ( $ct_isa ne 'HTTP::Headers::ActionPack::MediaType' ) { $self->mrest_declare_status( code => '500', explanation => "Bad content_type class ->$ct_isa<-" ); return 0; } $content_type = $content_type->type; # convert object to string } $log->debug( "Content type of this request is ->$content_type<-" ) unless $muffle{1}; # push it onto context $self->context->{'content_type'} = $content_type; # convert supported content types into a hash for easy lookup my %types = map { ( $_ => '' ); } @{ $site->MREST_SUPPORTED_CONTENT_TYPES }; if ( exists $types{ $content_type } ) { $log->info( "$content_type is supported" ); return 1; } $self->mrest_declare_status( explanation => "Content type ->$content_type<- is not supported" ); return 0; } =head3 valid_entity_length (B4) Called by Web::Machine with one argument: the length of the request body. Return true or false. =cut sub valid_entity_length { my ( $self, $body_len ) = @_; state $max_len = $site->MREST_MAX_LENGTH_REQUEST_ENTITY; $log->debug( "Entering " . __PACKAGE__ . "::valid_entity_length, maximum request entity length is $max_len" ) unless $muffle{1}; $body_len = $body_len || 0; $log->info( "Request body is $body_len bytes long" ); if ( $body_len > $max_len ) { $self->mrest_declare_status( explanation => "Request body is $body_len bytes long, which exceeds maximum length set in \$site->MREST_MAX_LENGTH_REQUEST_ENTITY" ); return 0; } return 1; } =head3 charsets_provided This method causes L to encode the response body (if any) in UTF-8. =cut sub charsets_provided { return [ qw( UTF-8 ) ]; } #=head3 default_charset # #Really use UTF-8 all the time. # #=cut # #sub default_charset { 'utf8'; } =head2 FSM Part Two (Content Negotiation) See L. =head2 FSM Part Three (Resource Existence) =head2 resource_exists (G7) The initial check for resource existence is the URI-to-resource mapping, which has already taken place in C. Having made it to here, we know that was successful. So, what we do here is call the handler function, which is expected to return an L object. How this status is interpreted is left up to the application: we pass the status object to the C method, which should return either true or false. For GET and POST, failure means 404 by default, but can be overrided by calling C from within C. For PUT, success means this is an update operation and failure means insert. For DELETE, failure means "202 Accepted" - i.e. a request to delete a resource that doesn't exist is accepted, but nothing actually happens. =cut sub resource_exists { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::resource_exists" ); #$log->debug( "Context is " . Dumper( $self->context ) ); # no handler is grounds for 500 if ( not exists $self->context->{'handler'} ) { $self->mrest_declare_status( code => '500', explanation => 'AAAAAAAAAAGAHH!!! In resource_exists, no handler/mapping on context' ); return 0; } # # run handler (first pass) and push result onto context # my $handler = $self->context->{'handler'}; $log->debug( "resource_exists: Calling resource handler $handler for the first time" ); my $bool; try { $bool = $self->$handler(1); } catch { $self->mrest_declare_status( code => 500, explanation => $_ ); $bool = 0; }; $self->push_onto_context( { 'resource_exists' => $bool } ); return 1 if $bool; # Application thinks the resource doesn't exist. Return value will be # 0. For GET and DELETE, this should trigger 404 straightaway: make # sure the status is declared so we don't send back a bare response. # For POST, the next method will be 'allow_missing_post'. # For PUT, it will be ...?... if ( not $self->status_declared ) { my $method = $self->context->{'method'}; my $explanation = "Received request for non-existent resource"; if ( $method eq 'GET' ) { # 404 will be assigned by Web::Machine $self->mrest_declare_status( 'explanation' => $explanation ); } elsif ( $method eq 'DELETE' ) { # for DELETE, Web::Machine would ordinarily return a 202 so # we override that $self->mrest_declare_status( 'code' => 404, 'explanation' => $explanation ); } } return 0; } =head2 allow_missing_post If the application wishes to allow POST to a non-existent resource, this method will need to be overrided. =cut sub allow_missing_post { my ( $self ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::allow_missing_post" ); # we do not allow POST to a non-existent resource, so we declare 404 $self->mrest_declare_status( 'code' => 404, explanation => 'Detected attempt to POST to non-existent resource' ) unless $self->status_declared; return 0; } =head2 post_is_create =cut sub post_is_create { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::post_is_create" ); return $self->mrest_post_is_create; } =head2 mrest_post_is_create Looks for a 'post_is_create' property in the context and returns 1 or 0, as appropriate. =cut sub mrest_post_is_create { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::mrest_post_is_create" ); my $pic = $self->context->{'post_is_create'}; if ( ! defined( $pic ) ) { $log->error( "post_is_create property is missing; defaults to false" ); return 0; } if ( $pic ) { $log->info( "post_is_create property is true" ); return 1; } $log->info( "post_is_create property is false" ); return 0; } =head2 create_path =cut sub create_path { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::create_path" ); # if there is a declared status, return a dummy value return "DUMMY" if $self->status_declared; return $self->mrest_create_path; } =head2 mrest_create_path This should always return _something_ (never undef) =cut sub mrest_create_path { my $self = shift; $log->debug( "Entering " . __PACKAGE__ . "::mrest_create_path" ); my $create_path = $self->context->{'create_path'}; if ( ! defined( $create_path ) ) { $site->mrest_declare_status( code => 500, explanation => "Post is create, but create_path missing in handler status" ); return 'ERROR'; } $log->debug( "Returning create_path " . Dumper( $create_path ) ); return $create_path; } =head2 create_path_after_handler This is set to true so we can set C<< $self->context->{'create_path'} >> in the handler. =cut sub create_path_after_handler { 1 } =head2 process_post This is where we construct responses to POST requests that do not create a new resource. Since we expect our resource handlers to "do the needful", all we need to do is call the resource handler for pass two. The return value should be a Web::Machine/HTTP status code like, e.g., \200 - this ensures that Web::Machine does not attempt to encode the response body, as in our case this would introduce a double- encoding bug. =cut sub process_post { my $self = shift; $log->debug("Entering " . __PACKAGE__ . "::process_post" ); # Call the request handler. This way is bad, because it ignores any # 'Accept' header provided in the request by the user agent. However, until # Web::Machine is patched we have no other way of knowing the request # handler's name so we have to hard-code it like this. #$self->_load_request_entity; #my $status = $self->mrest_process_request; #return $status if ref( $status ) eq 'SCALAR'; # #return \200 if $self->context->{'handler_status'}->ok; # # if the handler status is not ok, there SHOULD be a declared status #return $self->mrest_declared_status_code || \500; my $status = $self->mrest_process_request; $log->debug( "Handler returned: " . Dumper( $status ) ); return $status; } =head2 delete_resource This method is called on DELETE requests and is supposed to tell L whether or not the DELETE operation was enacted. In our case, we call the resource handler (pass two). =cut sub delete_resource { my $self = shift; $log->debug("Entering " . __PACKAGE__ . "::delete_resource"); my $status = $self->mrest_generate_response; return 0 if ref( $status ) eq 'SCALAR' or $self->context->{'handler_status'}->not_ok; return 1; }; =head2 finish_request This overrides the Web::Machine method of the same name, and is called just before the final response is constructed and sent. We use it for adding certain headers in every response. =cut sub finish_request { my ( $self, $metadata ) = @_; state $http_codes = $site->MREST_HTTP_CODES; $log->debug( "Entering " . __PACKAGE__ . "::finish_request with metadata: " . Dumper( $metadata ) ); if ( ! $site->MREST_CACHE_ENABLED ) { # # tell folks not to cache # $self->response->header( 'Cache-Control' => $site->MREST_CACHE_CONTROL_HEADER ); $self->response->header( 'Pragma' => 'no-cache' ); } # # when Web::Machine catches an exception, it sends us the text in the # metadata -- in practical terms, this means: if the metadata contains an # 'exception' property, something died somewhere # if ( $metadata->{'exception'} ) { my $exception = $metadata->{'exception'}; $exception =~ s/\n//g; $self->mrest_declare_status( code => '500', explanation => $exception ); } # # if there is a declared status, we assume that it contains the entire # intended response and clobber $self->response->content with it # if ( $self->status_declared ) { my $declared_status = $self->context->{'declared_status'}; $log->debug( "finish_request: declared status is " . Dumper( $declared_status ) ); if ( ! $declared_status->payload->{'http_code'} ) { $declared_status->payload->{'http_code'} = $self->response->code; } else { $self->response->code( $declared_status->payload->{'http_code'} ); } my $json = $JSON->encode( $declared_status->expurgate ); $self->response->content( $json ); $self->response->header( 'content-length' => length( $json ) ); } # The return value is ignored, so any effect of this method must be by # modifying the response. $log->debug( "Response finalized: " . Dumper( $self->response ) ); return; } 1; Web-MREST-0.290/lib/Web/MREST/Test.pm000444001750000144 2137014257045157 17267 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* # ------------------------ # Test helper functions module # ------------------------ package Web::MREST::Test; use strict; use warnings; use App::CELL qw( $CELL $log $meta $site ); use Data::Dumper; use File::HomeDir; use HTTP::Request; use JSON; use Log::Any::Adapter; use Params::Validate qw( :all ); use Plack::Test; use Test::JSON; use Test::More; use Try::Tiny; use Web::Machine; use Web::MREST; =head1 NAME Web::MREST::Test - Test helper functions =head1 DESCRIPTION This module provides helper code for unit tests. =cut =head1 EXPORTS =cut use Exporter qw( import ); our @EXPORT = qw( initialize_unit req llreq docu_check ); =head1 PACKAGE VARIABLES =cut # dispatch table with references to HTTP::Request::Common functions my %methods = ( GET => \&GET, PUT => \&PUT, POST => \&POST, DELETE => \&DELETE, HEAD => \&HEAD, ); =head1 FUNCTIONS =cut =head2 initialize_unit Perform the boilerplate tasks that have to be done at the beginning of every unit. Takes a PARAMHASH with two optional parameters: 'class' => class into which Web::Machine object is to be blessed 'sitedir' => sitedir parameter to be passed to Web::MREST::init =cut sub initialize_unit { my %ARGS = @_; note( "Initializing unit " . (caller)[1] . " with arguments " . Dumper( \%ARGS ) ); my $class = $ARGS{'class'} || undef; my %init_options = $ARGS{'sitedir'} ? ( 'sitedir' => $ARGS{'sitedir'} ) : (); # zero logfile and tell Log::Any to log to it my $log_file_spec = File::HomeDir->my_home . "/mrest.log"; unlink $log_file_spec; Log::Any::Adapter->set( 'File', $log_file_spec ); $log->init( ident => 'MREST_UNIT_TEST' ); # load configuration parameters my $status = Web::MREST::init( %init_options ); is( $status->level, 'OK' ); note( 'check that site configuration parameters were loaded' ); is_deeply( [ $site->MREST_SUPPORTED_CONTENT_TYPES ], [ [ 'application/json' ] ], 'configuration parameters loaded?' ); # set debug mode $log->debug_mode( $site->MREST_DEBUG_MODE ); my $app = Web::Machine->new( resource => ( $class || 'Web::MREST::Dispatch' ) )->to_app; my $test = Plack::Test->create( $app ); isa_ok( $test, 'Plack::Test::MockHTTP' ); return $test; } =head2 status_from_json L is designed to return status objects in the HTTP response entity. Before inclusion in the response, the status object is converted to JSON. This routine goes the opposite direction, taking a JSON string and converting it back into a status object. FIXME: There may be some encoding issues here! =cut sub status_from_json { my ( $json ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::status_from_json" ); my $obj; try { $obj = bless from_json( $json ), 'App::CELL::Status'; } catch { $obj = $_; }; return $obj if ref( $obj) eq 'App::CELL::Status'; die "\n\nfrom_json died"; } =head2 req Assemble and process a HTTP request. Takes the following positional arguments: * Plack::Test object * expected HTTP result code * user to authenticate with (can be 'root', 'demo', or 'active') * HTTP method * resource string * optional JSON string If the HTTP result code is 200, the return value will be a status object, undef otherwise. =cut sub req { my ( $test, $code, $method, $resource, $json ) = validate_pos( @_, 1, 1, 1, 1, 0 ); $log->debug( "Entering " . __PACKAGE__ . "::req" ); if ( ref( $test ) ne 'Plack::Test::MockHTTP' ) { diag( "Plack::Test::MockHTTP object not passed to 'req' from " . (caller)[1] . " line " . (caller)[2] ); BAIL_OUT(0); } # assemble request my @headers = ( 'accept' => 'application/json', 'content-type' => 'application/json', ); my $r = llreq( $method, $resource, \@headers, $json ); # send request; get response my $res = $test->request( $r ); isa_ok( $res, 'HTTP::Response' ); diag( Dumper $res ) if ( $res->code == 500 ); #diag( $res->code . " " . $res->message ); is( $res->code, $code, "$method $resource" . ( $json ? " with $json" : "" ) . " 1" ); my $content = $res->content; if ( $content ) { #diag( Dumper $content ); is_valid_json( $content, "$method $resource" . ( $json ? " with $json" : "" ) . " 2" ); my $status = status_from_json( $content ); if ( my $location_header = $res->header( 'Location' ) ) { $status->{'location_header'} = $location_header; } return $status; } return; } =head2 llreq Low-level request generator =cut sub llreq { my ( $method, $uri, @args ) = @_; my ( $headers, $content ); if ( @args ) { $headers = shift @args; $log->debug( "llreq: headers set to " . Dumper( $headers ) ); } else { $headers = [ 'accept' => 'application/json', 'content-type' => 'application/json', ]; } if ( @args and defined( $args[0] ) ) { $log->debug( "llreq: args is " . Dumper( \@args ) ); $content = join( ' ', @args ); } return HTTP::Request->new( $method, $uri, $headers, $content ); } =head2 docu_check Check that the resource has on-line documentation (takes Plack::Test object and resource name without quotes) =cut sub docu_check { my ( $test, $resource ) = @_; #diag( "Entering " . __PACKAGE__ . "::docu_check with argument $resource" ); if ( ref( $test ) ne 'Plack::Test::MockHTTP' ) { diag( "Plack::Test::MockHTTP object not passed to 'req' from " . (caller)[1] . " line " . (caller)[2] ); BAIL_OUT(0); } my $tn = "docu_check $resource "; my $t = 0; my ( $docustr, $docustr_len ); # # - straight 'docu' resource my $status = req( $test, 200, 'demo', 'POST', '/docu', <<"EOH" ); { "resource" : "$resource" } EOH is( $status->level, 'OK', $tn . ++$t ); is( $status->code, 'DISPATCH_ONLINE_DOCUMENTATION', $tn . ++$t ); if ( exists $status->{'payload'} ) { ok( exists $status->payload->{'resource'}, $tn . ++$t ); is( $status->payload->{'resource'}, $resource, $tn . ++$t ); ok( exists $status->payload->{'documentation'}, $tn . ++$t ); $docustr = $status->payload->{'documentation'}; $docustr_len = length( $docustr ); ok( $docustr_len > 10, $tn . ++$t ); isnt( $docustr, 'NOT WRITTEN YET', $tn . ++$t ); } # # - not a very thorough examination of the 'docu/html' version $status = req( $test, 200, 'demo', 'POST', '/docu/html', <<"EOH" ); { "resource" : "$resource" } EOH is( $status->level, 'OK', $tn . ++$t ); is( $status->code, 'DISPATCH_ONLINE_DOCUMENTATION', $tn . ++$t ); if ( exists $status->{'payload'} ) { ok( exists $status->payload->{'resource'}, $tn . ++$t ); is( $status->payload->{'resource'}, $resource, $tn . ++$t ); ok( exists $status->payload->{'documentation'}, $tn . ++$t ); $docustr = $status->payload->{'documentation'}; $docustr_len = length( $docustr ); ok( $docustr_len > 10, $tn . ++$t ); isnt( $docustr, 'NOT WRITTEN YET', $tn . ++$t ); } } 1; Web-MREST-0.290/lib/Web/MREST/Util.pm000444001750000144 670014257045157 17245 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2016, 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. # ************************************************************************* package Web::MREST::Util; use 5.012; use strict; use warnings; use App::CELL qw( $log ); use File::Spec; use JSON; use Params::Validate qw( :all ); use Pod::Simple::HTML; use Pod::Simple::Text; our $JSON = JSON->new->allow_nonref->convert_blessed->utf8->pretty; =head1 NAME Web::MREST::Util - Miscellaneous utilities =head1 SYNOPSIS Miscellaneous utilities =head1 EXPORTS This module provides the following exports: =over =item C<$JSON> (singleton) =item C (function) =item C (function) =back =cut use Exporter qw( import ); our @EXPORT_OK = qw( $JSON pod_to_html pod_to_text ); =head1 FUNCTIONS =head2 pod_to_html Every L resource definition includes a 'documentation' property containing a POD string. Our 'docu/html' resource converts this POD string into HTML with a little help from this routine. =cut sub pod_to_html { my ( $pod_str ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::pod_to_html" ); #$log->debug( "pod_to_html before: $pod_str" ); my $p = Pod::Simple::HTML->new; $p->output_string(\my $html_str); $p->parse_string_document($pod_str); # now $html_str contains a full-blown HTML file, of which only one part is # of interest to us. That part starts with the line and # ends with $html_str =~ s/.*//s; $html_str =~ s/.*//s; $log->debug( "pod_to_html after: $html_str" ); return $html_str; } =head2 pod_to_text Convert POD string into text =cut sub pod_to_text { my $pod_str = shift; $log->debug( "Entering " . __PACKAGE__ . "::pod_to_text" ); my $p = Pod::Simple::Text->new; $p->output_string(\my $text_str); $p->parse_string_document($pod_str); return $text_str; } 1; Web-MREST-0.290/lib/Web/MREST/WebServicesIntro.pm000444001750000144 3137414257045157 21612 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* package Web::MREST::WebServicesIntro; use 5.012; use strict; use warnings; =head1 NAME Web::MREST::WebServicesIntro - General discussion of REST and Web Services =head1 GENERAL DISCUSSION OF REST AND WEB SERVICES Before you try to implement a REST server using L, you might want to take a look at our "prerequisites". The heading of each subsection below describes the prerequisite. However, the text under each subsection heading should B be taken as an authoritative discourse on the subject. =head2 Know what Web Services are A "Web Service" is a client-server application that uses the HTTP protocol for communications between client and server. More specifically, the client attempts to open a TCP connection to a pre-defined host and port where the server is listening. Once a connection is open, the client and server communicate in HTTP. Web Services can run on any TCP/IP network - the public Internet is one example, but many Web Services run on corporate intranets, for example. A developer will typically have an isolated testing network on his own machine, etc. =head2 Know what a RESTful Web Service is Before you write a REST server, you should probably learn what a REST server is. Here is a crash course. Even if you _think_ you know what a REST server is, it might be useful to either skim this crash course or, even better, just read L which this "crash course" attempts to paraphrase. =head3 Introduction REST is an approach to implementing client-server software architecture, in which communications between client and server use the HTTP protocol. It turns out that HTTP is "good enough" for many applications, and using it can save a lot of work. I urge all prospective REST server developers to study and "grok" the L, since it is the conceptual basis for this discourse. =head3 More than a web server Providing a Web Service implies having a web server. L does this for you, with help from L and L. But the mere presence of a web server does not make a Web Service "RESTful". =head3 Level 0: tunnelling mechanism Some notorious Web Services - such as those based on the XML-RPC and SOAP technologies - use HTTP as a tunnelling mechanism. In this paradigm, each client message is serialized and sent to the server in the body of a C request. The server always responds with a 200 status code, which in this case signifies no more than that the message was received and processed, and the server's serialized response is placed in the response body. Richardson calls this "One URI, one HTTP method". Example HTTP request: Method: POST URI: http://myapp.example.com/ Header: Accept: application/json Body: { "command" : "employee.insert", "arguments" : { ... } } Example HTTP response: Status code: 200 OK Content-Type: application/json Body: { "status" : { "level" : "ERROR", "code" : "MYAPP_INSUFFICIENT_PRIVS", "text" : "Insufficient privileges" } } To quote Richardson: If you look at an XML-RPC service, or a typical SOAP service . . ., you'll see something that looks a lot like a C library. There are a bunch of functions, sometimes namespaced with periods. All of these functions are accessed by sending a POST request to one single URI. =head3 Level 1: resources The next step, which Richardson calls "Many URIs, one HTTP method", involves moving some part of the XML/JSON body into the URI. Though this step might seem insignificant, calling it "revolutionary" would be closer to the truth. Let's apply this to our example. If employees can be uniquely identified by their nick, a request for employee "simona" might look like this: Method: POST URI: http://myapp.example.com/employee/nick/simona Header: Accept: application/json Body: { "command" : "GET" } By moving the object specification to the URI, I, and this is what makes it "revolutionary". The very purpose of the HTTP standard is to facilitate the publishing and manipulation of web resources, and the URI is the "Uniform Resource Identifier". Moving from level 0 to level 1 involves the same paradigm shift as embracing OO principles in your code. But even if you already were using OO principles in the underlying code, what benefit is there in bundling the object identifier in the HTTP request body? The Uniform Resource Identifier (URI) is the right tool for that. =head3 Level 2: HTTP verbs If you know about HTTP methods, the previous example should cry out to you (or, rather, you might cry out to it): "why are they using C for a GET request?!" And, while it may seem astonishing, that is exactly what many Web Services do (or used to do before Richardson published his influential paper). The next "level" in Richardson's structure involves leveraging HTTP methods to distinguish read requests, which should be idempotent, from write requests, which modify the underlying data. When this distinction is hidden in the API, there is no way for client code to optimize read-only requests. Illustrating with our example: Method: GET URI: http://myapp.example.com/employee/nick/simona The barest glace is enough to make it obvious that this request is far simpler than its level 1 equivalent. At level 2, the server guarantees that GET requests will never change the data, and that means your client code can dispense with whatever special precautions it needs to take to prevent unwanted modifications. Richardson's designation for this level is: "Many URIs, each supporting multiple HTTP methods". Quoting Richardson again to drive the point home: The web is powerful because it gives you tools for splitting the inherent complexity of a task into small chunks. The URI lets you give a name to every object in the system. With URIs, every object can be a little bit complex. That's the URI level. On the HTTP level, the major advance of the web is that although it can handle any kind of operation, it splits out read operations, operations that want to fetch data, and treats them specially. Taking our example a little bit further, let's say we want to create a new employee at this level. Here's what the request might look like: Method: PUT URI: http://myapp.example.com/employee/nick/george Header: Accept: application/json Body: { "name" : "George III", "occupation" : "King of England" ... } The important point here is that the request body now contains content only - no command or function name. The role of the function name is taken over by the combination of HTTP method and URI. Now we are really using HTTP to its fullest potential. Or are we? =head3 Level 3: hypermedia controls Until this point, the discourse has been easy to follow. Yet, Richardson describes a third level, "hypermedia", which he defines as: Resources describe their own capabilities and interconnections This is also sometimes referred to as "Hypermedia As The Engine Of Application State", or HATEOAS. As Richardson himself acknowledges, this is where the enthusiasm starts to fade. According to Richardson, whereas level 1 is "the lesson of URIs" and level 2 is "the lesson of HTTP", the lesson we learn at this level is "the lesson of HTML". That is because HTML is an example of hypermedia controls that we are all familiar with. Generalizing this, we can say that a HATEOAS client "navigates" its server very much like a human surfs the web, that is: by parsing and following links. Just like on the WWW, in a HATEOAS application, resources link to other resources and, crucially, I. Returning to our example, let us say that our employee objects link to occupation objects. Inside the database, each occupation is identified by its "occupation_id", an integer value, and linked tables use this as a foreign key. Without hypermedia controls, our request for employee "george" and the server's response (the part following the '*') might look like this: Method: GET URI: http://myapp.example.com/employee/nick/george * Status code: 200 OK Content-Type: application/json Body: { "name" : "George III", "occupation_id" : 553, ... } In HATEOAS, the same request/response might look like this: Method: GET URI: http://myapp.example.com/employee/nick/george * Status code: 200 OK Content-Type: application/json Body: { "name" : "George III", "occupation" : { "link" : { "href" : "http://myapp.example.com/occupation/catalog/553, "rel" : "http://myapp.example.com/occupation", "name" : "King of England" }, ... } While at first glance it seems more complicated, this approach (which we will call the HATEOAS approach) is superior to the non-HATEOAS approach illustrated by the first example. In the non-HATEOAS version, the client code needs to know that occupation objects are identified by their 'occupation_id' property. Further, to gain access to the object it needs to know how to transform the occupation ID into the appropriate resource so it can issue a GET request for it. By putting the full URI of the occupation resource into the response, the client no longer needs to know any of that. To get the resource, it directly issues a GET request to the URI provided in 'href'. But the "link" property gives us more than this. From the additional properties the client can, for example, derive that the resource can be modified by issuing a C request to C and including the "name" property (with the value "King of England") in the request body. The non-HATEOAS variant, by contrast, provides nothing more than a number. The "knowledge" of what can be done with it must be embedded in the client code. As Richardson notes, this makes client code more brittle. He cites examples of RESTful Web Service projects where clients were abandoned after being broken repeatedly by server-side changes to the REST API. =head3 Conclusion There is more that can be done with the HATEOAS approach, of course, than provide URI links in the HTTP response. The idea is for clients to get information on their state from the server via HTTP. This should make the clients less prone to breakage when changes are made on the server side. =cut 1; Web-MREST-0.290/lib/Web/MREST/Test000755001750000144 014257045157 16551 5ustar00smithfarmusers000000000000Web-MREST-0.290/lib/Web/MREST/Test/503.pm000444001750000144 376014257045157 17561 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* # special testing module for use with t/4xx/401-503.t package Web::MREST::Test::503; use 5.012; use strict; use warnings; use App::CELL qw( $log ); use Web::MREST::Dispatch qw( init_router ); use parent 'Web::MREST::Resource'; =head1 NAME Web::MREST::Test::503 - Override service_unavailable method =head1 SYNOPSIS bla bla =cut 1; Web-MREST-0.290/lib/Web/MREST/Test/Forbidden.pm000444001750000144 436014257045157 21143 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* # special testing module for use with t/4xx/403-Forbidden.t package Web::MREST::Test::Forbidden; use 5.012; use strict; use warnings; use App::CELL qw( $log ); use Web::MREST::Dispatch qw( init_router ); use parent 'Web::MREST::Resource'; =head1 NAME Web::MREST::Test::Forbidden - Override forbidden method =head1 SYNOPSIS Provide a forbidden method to override the default one. =head1 FUNCTIONS =head2 forbidden A forbidden method that always returns 1. =cut sub forbidden { my ( $self ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::forbidden" ); return 1; } 1; Web-MREST-0.290/lib/Web/MREST/Test/Unauthorized.pm000444001750000144 442314257045157 21730 0ustar00smithfarmusers000000000000# ************************************************************************* # 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. # ************************************************************************* # special testing module for use with t/4xx/401-Unauthorized.t package Web::MREST::Test::Unauthorized; use 5.012; use strict; use warnings; use App::CELL qw( $log ); use Web::MREST::Dispatch qw( init_router ); use parent 'Web::MREST::Resource'; =head1 NAME Web::MREST::Test::Unauthorized - Override is_authorized method =head1 SYNOPSIS Provide an is_authorized method to override the default one. =head1 FUNCTIONS =head2 is_authorized An is_authorized method that always returns 0. =cut sub is_authorized { my ( $self ) = @_; $log->debug( "Entering " . __PACKAGE__ . "::is_authorized" ); return 0; } 1; Web-MREST-0.290/t000755001750000144 014257045157 13720 5ustar00smithfarmusers000000000000Web-MREST-0.290/t/config.t000444001750000144 416014257045157 15510 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/config.t - test if config params are loaded # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST; use Web::MREST::Test qw( initialize_unit ); use Log::Any::Adapter; use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # test a random parameter is( $site->MREST_REPORT_BUGS_TO, 'bug-App-MREST@rt.cpan.org' ); done_testing; Web-MREST-0.290/t/mrest_declare_status.t000444001750000144 1007014257045157 20474 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/mrest_declare_status.t # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL ); use Data::Dumper; use JSON; use Test::More; use Test::Warnings; use Web::MREST; use Web::MREST::Resource; note( 'load configuration parameters' ); my $status = Web::MREST::init(); is( $status->level, 'OK' ); note( 'create a Web::MREST::Resource object with a context' ); my $r = bless {}, 'Web::MREST::Resource'; $r->{'context'} = {}; isa_ok( $r, 'Web::MREST::Resource', "Web::MREST::Resource object" ); note( 'push_onto_context should now work' ); $r->push_onto_context( { 'foo' => 'bar' } ); is( ref( $r->context ), 'HASH', "context method" ); is( $r->context->{'foo'}, 'bar', "foo property of context" ); note( 'declare a status -- simple' ); ok( ! $r->status_declared ); $r->mrest_declare_status( $CELL->status_ok ); ok( $r->status_declared ); is( ref( $r->status_declared ), 'App::CELL::Status' ); ok( $r->status_declared->ok ); note( 'declared_status is a synonym for status_declared' ); ok( $r->declared_status->ok ); note( 'nullify declared status' ); $r->nullify_declared_status; ok( ! $r->status_declared ); note( 'declare a new status using PARAMHASH' ); $r->mrest_declare_status( level => 'CRIT', explanation => 'Whack-a-mole status!', ); ok( $r->status_declared, 'looks good' ); note( 'check if level is CRIT' ); is( $r->declared_status->level, 'CRIT' ); note( 'test declared_status_explanation accessor' ); is( $r->mrest_declared_status_explanation, 'Whack-a-mole status!' ); note( 'test declared_status_code accessor' ); is( $r->mrest_declared_status_code, undef ); $r->mrest_declared_status_code( 400 ); is( $r->mrest_declared_status_code, 400 ); note( 'permanent property defaults to JSON::true' ); ok( $r->declared_status->payload->{'permanent'} ); note( 'nullify declared status 2' ); $r->nullify_declared_status; ok( ! $r->status_declared ); note( 'use defined message in config/srv/MREST_Message_en.conf' ); $r->mrest_declare_status( $CELL->status_warn( 'TEST_NON_EXISTENT_RESOURCE', args => [ 'foobar' ], http_code => 334, ) ); ok( $r->status_declared, 'looks good' ); note( 'test declared_status_code accessor' ); is( $r->mrest_declared_status_code, 334 ); note( 'test declared_status_explanation accessor' ); is( $r->mrest_declared_status_explanation, 'The requested resource does not exist (foobar)' ); done_testing; Web-MREST-0.290/t/request_body_read.t000444001750000144 525114257045157 17745 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/request_body_read.t # ------------------------ # # Test our ability to read the request body # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log $meta ); use Data::Dumper; use HTTP::Request; use Encode qw( encode_utf8 ); use JSON; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit ); use utf8; sub req { my ( $method, $uri, @args ) = @_; my $body = encode_utf8( join( ' ', @args ) ); my $headers = [ 'content-type' => 'application/json', 'content-length' => length $body, ]; return HTTP::Request->new( $method, $uri, $headers, $body ); } my $request_body; my $test = initialize_unit(); my $response = $test->request( req( 'POST', 'echo', '{ "body_text" : "ŘČĹ" }' ) ); my $from_json = JSON->new->utf8(1)->decode( $response->content ); isa_ok( $response, 'HTTP::Response' ); is( $response->code, 200 ); # handler 'MyFoo::test' does not exist is( $from_json->{'payload'}->{'body_text'}, "ŘČĹ" ); done_testing; Web-MREST-0.290/t/2xx000755001750000144 014257045157 14441 5ustar00smithfarmusers000000000000Web-MREST-0.290/t/2xx/200-OK.t000444001750000144 533514257045157 15601 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/200-OK.t # ------------------------ # # Send various HTTP requests that are supposed to trigger "200 OK" # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; #use Test::Deep; use Test::JSON; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); my $test = initialize_unit(); my ( $request, $response ); my $headers = [ 'accept' => 'application/json', 'content-type' => 'application/json', ]; # # 'test/?:specs' # # GET # - resource exists $response = $test->request( llreq( 'GET', 'test/1', $headers ) ); is( $response->code, 200 ); is_valid_json( $response->content ); # # - does not exist $response = $test->request( llreq( 'GET', 'test/0', $headers ) ); is( $response->code, 404 ); is_valid_json( $response->content ); # # POST # - resource exists, post_is_create is false $response = $test->request( llreq( 'POST', 'test/1', $headers ) ); is( $response->code, 200 ); is_valid_json( $response->content ); is( $response->header( 'location' ), undef ); done_testing; Web-MREST-0.290/t/2xx/201-Created.t000444001750000144 547614257045157 16646 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/201-Created.t # ------------------------ # # Send HTTP requests to trigger "201 Created" (and perform related tests) # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use HTTP::Request; use Test::Deep; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); my $test = initialize_unit(); my ( $request, $response ); my $headers = [ 'accept' => 'application/json', 'content-type' => 'application/json', ]; # # 'test/?:specs' # # POST # # - resource does not exist $response = $test->request( llreq( 'POST', 'test/0', $headers ) ); is( $response->code, 404, "specs value 0 should trigger 404" ); # - resource exists, post_is_create is true $response = $test->request( llreq( 'POST', 'test/create', $headers ) ); is( $response->code, 201, "specs value 'create' should trigger 201" ); my $expected = '/test/create'; is( $response->header( 'location' ), $expected ); # - resource exists, post_is_create is false $response = $test->request( llreq( 'POST', 'test/1', $headers ) ); is( $response->code, 200 ); is( $response->header( 'location' ), undef ); done_testing; Web-MREST-0.290/t/4xx000755001750000144 014257045157 14443 5ustar00smithfarmusers000000000000Web-MREST-0.290/t/4xx/400-Bad-Request.t000444001750000144 434214257045157 17405 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/400-Bad-Request.t # ------------------------ # # Test various URIs that should trigger a 400 # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use HTTP::Request::Common qw( GET PUT POST DELETE HEAD ); use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit req ); my $test = initialize_unit(); my $status = req( $test, 400, 'POST', 'test', 'bad, bad JSON' ); is( $status->level, 'ERR' ); like( $status->code, qr/malformed JSON string/ ); #diag( Dumper( $status ) ); done_testing; Web-MREST-0.290/t/4xx/401-Unauthorized.t000444001750000144 467414257045157 17763 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/401-Unauthorized.t # ------------------------ # # Send HTTP requests to trigger "401 Unauthorized" # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; #use Test::Deep; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); my $test = initialize_unit( 'class' => 'Web::MREST::Test::Unauthorized' ); foreach my $method ( qw( GET POST PUT DELETE ) ) { my $response = $test->request( llreq( $method, 'test' ) ); my $response_code = $response->code; if ( $response_code != 401 ) { diag( Dumper( $response ) ); diag( "Received response code $response_code, which is not 401! Bailing out." ); BAIL_OUT(0); } is( $response->code, 401 ); } done_testing; Web-MREST-0.290/t/4xx/403-Forbidden.t000444001750000144 470314257045157 17171 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/403-Forbidden.t # ------------------------ # # Send HTTP requests to trigger "403 Forbidden" # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; #use Test::Deep; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); my $test = initialize_unit( 'class' => 'Web::MREST::Test::Forbidden' ); # # 'forbidden' should return 403 on every request # foreach my $method ( qw( GET POST PUT DELETE ) ) { my $response = $test->request( llreq( $method, 'test' ) ); my $response_code = $response->code; if ( $response_code != 403 ) { diag( "Received response code $response_code, which is not 403! Bailing out." ); BAIL_OUT(0); } is( $response->code, 403 ); } done_testing; Web-MREST-0.290/t/4xx/405-Method-Not-Allowed.t000444001750000144 546014257045157 20643 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/405-Method-Not-Allowed.t # ------------------------ # # Send HTTP requests to trigger "405 Method Not Allowed" (i.e., negative tests only) # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use Test::Deep; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); my $test = initialize_unit(); my ( $request, $response ); # # check MREST_SUPPORTED_HTTP_METHODS # cmp_deeply( $site->MREST_SUPPORTED_HTTP_METHODS, bag( qw( GET PUT POST DELETE TRACE CONNECT OPTIONS ) ), 'does MREST_SUPPORTED_HTTP_METHODS contain what we expect', ); # # 'bugreport' is defined for 'GET' only, so we check that all remaining # methods produce 405 # foreach my $method ( qw( PUT POST DELETE TRACE CONNECT OPTIONS ) ) { $response = $test->request( llreq( $method, 'bugreport' ) ); my $response_code = $response->code; is( $response_code, 405 ); if ( $response_code != 405 ) { diag( "Received response code $response_code, which is not 405! Bailing out." ); BAIL_OUT(0); } is( $response->header( 'allow' ), 'GET' ); } done_testing; Web-MREST-0.290/t/4xx/406-Not-Acceptable.t000444001750000144 455414257045157 20065 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/406-Not-Acceptable.t # ------------------------ # # Send HTTP requests to trigger "406 Not Acceptable" (i.e., negative tests only) # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use Test::Deep; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); use parent 'Web::MREST::Resource'; my $test = initialize_unit(); my ( $request, $response ); # # send an Accept header for a non-provided content type # $response = $test->request( llreq( 'GET', 'bugreport', [ 'Accept' => 'foo/bar', 'Content-Type' => 'application/json' ] ) ); is( $response->code, 406 ); #diag( Dumper $response ); done_testing; Web-MREST-0.290/t/4xx/413-Request-Entity-Too-Large.t000444001750000144 432414257045157 21766 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/413-Request-Entity-Too-Large.t # ------------------------ # # Acting like I am an application, define a resource for POST and send # a request body that is too large. # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $meta ); use Data::Dumper; use HTTP::Request::Common qw( GET PUT POST DELETE ); use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit req ); my $test = initialize_unit(); # send a request req( $test, 413, 'POST', 'test', '{ "foo" : "' . 'a' x 10001 . '" }' ); done_testing; Web-MREST-0.290/t/4xx/414-Request-URI-Too-Long.t000444001750000144 515114257045157 21016 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/414-Request-URI-Too-Long.t # ------------------------ # # Test that a too-long URI triggers a 414. # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use HTTP::Request::Common qw( GET PUT POST DELETE ); use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit ); use parent 'Web::MREST::Resource'; my $test = initialize_unit(); is( $site->MREST_MAX_LENGTH_URI, 1000 ); #FIXME ## send a request with URI length 999 #my $response = $test->request( GET( '/' x 999 ) ); #isa_ok( $response, 'HTTP::Response' ); #is( $response->code, 200 ); # ## send a request with URI length 1000 #my $response = $test->request( GET( '/' x 1000 ) ); #isa_ok( $response, 'HTTP::Response' ); #is( $response->code, 200 ); # # send a request with URI length 1001 my $response = $test->request( GET( '/' x 1001 ) ); isa_ok( $response, 'HTTP::Response' ); is( $response->code, 414 ); done_testing; Web-MREST-0.290/t/4xx/415-Unsupported-Media-Type.t000444001750000144 774214257045157 21572 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/415-Unsupported-Media-Type.t # ------------------------ # # Test that an unsupported content type triggers a 415. # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use JSON; use Test::Deep; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); use parent 'Web::MREST::Resource'; my $test = initialize_unit(); my ( $request, $response ); # # check MREST_SUPPORTED_CONTENT_TYPES # cmp_deeply( $site->MREST_SUPPORTED_CONTENT_TYPES, bag( 'application/json' ) ); # GET request with no entity and no content-type $response = $test->request( llreq( 'GET', 'bugreport' ) ); is( $response->code, 200 ); # GET request with no entity and kosher content-type $response = $test->request( llreq( 'GET', 'bugreport', [ 'Content-Type' => 'application/json' ] ) ); is( $response->code, 200 ); # POST request with no entity and no content-type $response = $test->request( llreq( 'POST', 'test' ) ); is( $response->code, 200 ); # POST request with bogus entity and no content-type $response = $test->request( llreq( 'POST', 'test', [], ":-)" ) ); #diag( Dumper $response ); is( $response->code, 400 ); ok( $response->content ); my $status = decode_json( $response->content ); #diag( Dumper $status ); bless $status, 'App::CELL::Status'; isa_ok( $status, 'App::CELL::Status' ); is( $status->level, "ERR" ); is( $status->code, 'no Content-Type and/or no Content-Length, yet request body present' ); # POST request with bogus entity and bogus content-type $response = $test->request( llreq( 'POST', 'test', [ 'Content-Length' => 4, 'Content-Bogus' => ':-)' ], 'asdf' ) ); is( $response->code, 400 ); ok( $response->content ); like( $response->content, qr/no Content-Type and\/or no Content-Length, yet request body present/ ); # POST request with proper entity and bogus content-type $response = $test->request( llreq( 'POST', 'test', [ 'Content-Length' => 20, 'Content-Type' => ':-)' ], '{ "content" : 1234 }' ) ); #diag( Dumper $response ); is( $response->code, 415 ); ok( $response->content ); $status = decode_json( $response->content ); #diag( Dumper $status ); bless $status, 'App::CELL::Status'; isa_ok( $status, 'App::CELL::Status' ); is( $status->level, "ERR" ); is( $status->code, 'Content type ->:-)<- is not supported' ); # FIXME: more tests needed done_testing; Web-MREST-0.290/t/5xx000755001750000144 014257045157 14444 5ustar00smithfarmusers000000000000Web-MREST-0.290/t/5xx/501-Not-Implemented.t000444001750000144 565214257045157 20302 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/501-Not-Implemented.t # ------------------------ # # There are two scenarios that will trigger a 501: # # 1. B12: the request method is not found in $site->MREST_SUPPORTED_HTTP_METHODS # 2. B6: Unknown or unsupported Content-* header # #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log ); use Data::Dumper; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit llreq ); use parent 'Web::MREST::Resource'; my $test = initialize_unit(); my $response; # # send a request that will trigger 501 in 'known_methods' (B12) # $response = $test->request( llreq( 'HEAD', '/' ) ); is( $response->code, 501 ); ok( $response->content ); like( $response->content, qr/The request method HEAD is not one of the supported methods GET, PUT, POST, DELETE, TRACE, CONNECT, OPTIONS/ ); # # send a request that will trigger 501 in 'valid_content_headers' (B6) # $response = $test->request( llreq( 'GET', 'bugreport', [ 'Content-Bogus' => ':-)' ] ) ); is( $response->code, 501 ); # POST request with no entity and bogus content-type # (if request entity is empty, content-type is irrelevant and will be ignored) $response = $test->request( llreq( 'POST', 'test', [ 'Content-Bogus' => ':-)' ] ) ); is( $response->code, 501 ); done_testing; Web-MREST-0.290/t/5xx/503-Service-Unavailable.t000444001750000144 561714257045157 21125 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/503-Service-Unavailable.t # ------------------------ # # Acting like I am an application, define a mrest_service_available # method that returns false. Then send a HTTP request to the application # and test for 503 status code in the response. # #!perl use 5.012; use strict; use warnings; package Web::MREST::Test::503; use App::CELL qw( $log ); use Data::Dumper; use HTTP::Request::Common qw( GET PUT POST DELETE ); use JSON; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit req ); use parent 'Web::MREST::Resource'; sub mrest_service_available { my $self = shift; $log->info( "Entering " . __PACKAGE__ . "::mrest_service_available" ); $self->mrest_declare_status( explanation => 'Testing', permanent => 0 ); return 0; # 503 Service Unavailable } my $test = initialize_unit( 'class' => 'Web::MREST::Test::503' ); # send a request #my $response = $test->request( GET( '/' ) ); #isa_ok( $response, 'HTTP::Response' ); #is( $response->code, 503 ); my $status = req( $test, 503, 'GET', '/' ); isa_ok( $status, 'App::CELL::Status' ); is( $status->level, 'ERR' ); is( $status->code, 'Testing' ); ok( ! $status->payload->{'permanent'} ); #diag( Dumper( $status->payload ) ); done_testing; Web-MREST-0.290/t/dispatch000755001750000144 014257045157 15517 5ustar00smithfarmusers000000000000Web-MREST-0.290/t/dispatch/bugreport.t000444001750000144 444014257045157 20054 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/bugreport.t - test the 'bugreport' resource # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST::Test qw( initialize_unit req ); use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # ok( $site->MREST_REPORT_BUGS_TO, 'the site param is set to something' ); my $status = req( $test, 200, 'GET', 'bugreport' ); is( $status->level, 'OK' ); ok( $status->payload ); is_deeply( $status->payload, { 'report_bugs_to' => $site->MREST_REPORT_BUGS_TO } ); # wrap up done_testing; Web-MREST-0.290/t/dispatch/docu.t000444001750000144 601614257045157 16776 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/docu.t - test the 'docu', 'docu/pod', and 'docu/html' resources # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST::Test qw( initialize_unit req ); use Test::Deep; use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # my $status; # 'docu' foreach my $method ( qw( DELETE GET POST PUT ) ) { $status = req( $test, 200, 'GET', 'docu' ); is( $status->level, 'OK' ); ok( $status->payload ); cmp_deeply( $status->payload, { 'description' => 'Access on-line documentation (via POST to appropriate subresource)', 'resource_name' => 'docu', 'parent' => '/', 'children' => bag( 'docu/pod', 'docu/html', 'docu/text' ), } ); } # 'docu/pod' # 'docu/html' foreach my $spec ( [ 'docu/pod', 'POD' ], [ 'docu/html', 'HTML' ] ) { $status = req( $test, 200, 'POST', $spec->[0], '"docu"' ); is( $status->level, 'OK' ); ok( $status->payload ); cmp_deeply( $status->payload, { 'resource' => 'docu', 'format' => $spec->[1], 'documentation' => re('.+'), } ); } foreach my $resource ( 'docu/pod', 'docu/html' ) { foreach my $method ( qw( GET PUT DELETE ) ) { req( $test, 405, $method, $resource ); } } # wrap up done_testing; Web-MREST-0.290/t/dispatch/echo.t000444001750000144 443414257045157 16764 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/echo.t - test the 'echo' resource # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST::Test qw( initialize_unit req ); use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # my $status = req( $test, 200, 'POST', 'echo', '"asdf"' ); is( $status->level, 'OK' ); is( $status->payload, "asdf" ); $status = req( $test, 200, 'POST', 'echo', '{ "foobar" : 123 }' ); is( $status->level, 'OK' ); is_deeply( $status->payload, { 'foobar' => 123 } ); # wrap up done_testing; Web-MREST-0.290/t/dispatch/noop.t000444001750000144 460014257045157 17014 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/noop.t - test the 'noop' resource # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST::Test qw( initialize_unit req ); use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # foreach my $method ( qw( GET POST PUT DELETE ) ) { my $status = req( $test, 200, 'GET', 'noop' ); is( $status->level, 'OK' ); is( $status->code, 'MREST_DISPATCH_NOOP' ); is_deeply ( $status->payload, { 'parent' => '/', 'children' => undef, 'resource_name' => 'noop', 'description' => 'A resource that does nothing' } ); } # wrap up done_testing; Web-MREST-0.290/t/dispatch/param.t000444001750000144 700314257045157 17141 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/echo.t - test the 'param' resource # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Data::Dumper; use Test::More; use Test::Warnings; use Web::MREST::Test qw( initialize_unit req ); # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # my $status = req( $test, 200, 'GET', 'param/core/MREST_HOST' ); is( $status->level, 'OK' ); is_deeply( $status->payload, { 'MREST_HOST' => 'localhost' } ); # PUT is create $status = req( $test, 201, 'PUT', 'param/meta/BUBBA', '{ "foobar" : 123 }' ); is( $status->level, 'OK' ); is( $status->{'location_header'}, 'param/meta/BUBBA' ); # GET it to confirm it is there $status = req( $test, 200, 'GET', 'param/meta/BUBBA' ); is( $status->level, 'OK' ); is_deeply( $status->payload, { 'BUBBA' => { 'foobar' => 123 } } ); # PUT is modify $status = req( $test, 200, 'PUT', 'param/meta/BUBBA', '{ "foobar" : null }' ); is( $status->level, 'OK' ); is( $status->code, 'CELL_OVERWRITE_META_PARAM' ); # GET it to confirm it was modified $status = req( $test, 200, 'GET', 'param/meta/BUBBA' ); is( $status->level, 'OK' ); is_deeply( $status->payload, { 'BUBBA' => { 'foobar' => undef } } ); # overwrite to null $status = req( $test, 200, 'PUT', 'param/meta/BUBBA', 'null' ); is( $status->level, 'OK' ); is( $status->code, 'CELL_OVERWRITE_META_PARAM' ); # GET it to confirm it was modified $status = req( $test, 200, 'GET', 'param/meta/BUBBA' ); is( $status->level, 'OK' ); is_deeply( $status->payload, { 'BUBBA' => undef } ); # DELETE it, since it was only there for testing purposes $status = req( $test, 200, 'DELETE', 'param/meta/BUBBA' ); is( $status->level, 'OK' ); # not there anymore $status = req( $test, 404, 'GET', 'param/meta/BUBBA' ); $status = req( $test, 404, 'DELETE', 'param/meta/BUBBA' ); # wrap up done_testing; Web-MREST-0.290/t/dispatch/root_resource.t000444001750000144 476114257045157 20743 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/root_resource.t - test the root ('') resource # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST::Test qw( initialize_unit req ); use Test::Deep; use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # foreach my $method ( qw( GET POST PUT DELETE ) ) { my $status = req( $test, 200, 'GET', '' ); is( $status->level, 'OK' ); is( $status->code, 'MREST_DISPATCH_NOOP' ); cmp_deeply( $status->payload, { 'parent' => undef, 'children' => bag( 'configinfo', 'param/:type/:param', 'docu', 'echo', 'test/?:specs', 'version', 'bugreport', 'noop' ), 'resource_name' => '/', 'description' => 'The root resource', } ); } # wrap up done_testing; Web-MREST-0.290/t/dispatch/version.t000444001750000144 435314257045157 17533 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015-2015, 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. # ************************************************************************* # ------------------------ # t/resources/version.t - test the 'version' resource # ------------------------ #!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $site ); use Web::MREST::Test qw( initialize_unit req ); use Test::More; use Test::Warnings; # instantiate Plack::Test object my $test = initialize_unit(); # # run the tests # my $status = req( $test, 200, 'GET', 'version' ); is( $status->level, 'OK' ); my $version = Web::MREST->version; is_deeply( $status->payload, { 'application' => 'Web::MREST', 'version' => $version, } ); # wrap up done_testing;