#!/usr/bin/perlpackageWWW::REST::Apid::Daemon;$WWW::REST::Apid::Daemon::VERSION='0.07';useWWW::REST::Apid;useDaemon::Generic;useData::Dumper;useCarp::Heavy;useCarp;subget;subauth;subrequest;our($server,$doauth,$cval,$docval,$apidoc,$authbasic,$authuri);our%tpl= (head=>qq(<html><head><title>[name] [version]</title></head><body><h1>[name] [version]</h1>),cap=>qq(<h2>[path]</h2><ul>),auth=>qq(<li>requires authentication</li>),val=>qq(<li>requires POST data:<br/><pre>[val]</pre></li>),des=>qq(</ul><p>[des]</p>),foot=>qq(</body>));# decorator syntactic sugarsubimplement {my($what,$sub) =@_;if($whateq login) {$server->{sublogin} =$sub;}}subrequest {# decoratorsmy($what,$arg) =@_;if($whateq login) {$doauth= 1;}elsif($whateq validate) {$cval=$arg;#new Data::Validate::Struct($arg);}elsif($whateq doc) {$docval=$arg;}else{die"Invalid decorator requested: ".$what;}}subaddoc {my($path,$doc) =@_;if(!$apidoc) {$apidoc=&addtpl('head');}$apidoc.=&addtpl(cap=>$path);$apidoc.=&addtpl(auth=>$path);$apidoc.=&addtpl(val=>$path);$apidoc.=&addtpl(des=>$doc);}subaddtpl {my($type,$doc) =@_;my$t=$tpl{$type};if($typeeq'cap') {$t=~ s/\[path\]/$doc/g;}elsif($typeeq'auth') {if(!$map{$doc}->{auth}) {$t='';}}elsif($typeeq'val') {if($valid{$doc}) {my$val= Dumper($valid{$doc}->{structure});$val=~ s/\$VAR1= / /;$t=~ s/\[val\]/$val/g;}else{$t='';}}elsif($typeeq'des') {$t=~ s/\[des\]/$doc/g;}elsif($typeeq'head') {$t=~ s/\[name\]/$cfg{apiname}/g;$t=~ s/\[version\]/$cfg{apiversion}/g;}return$t;}subauth {my($type,$param) =@_;if($typeeq redirect) {$authuri=$param;}elsif($typeeq basic) {$authbasic=$param;}else{die"Unknown auth type $type\n";}}subget {my($path,$sub) =@_;$server->mapuri(path=>$path,handler=>$sub,doauth=>$doauth,validate=>$cval);$doauth= 0;$cval= 0;if($docval) {&addoc($path,$docval);$docval='';}}subdodoc {($req,$res) =@_;$res->header('Content-type'=>'text/html; charset=UTF-8');$res->add_content($apidoc.$tpl{foot});return1;}subgd_preconfig {my$self=shift;my%c= ParseConfig($self->{configfile}) ordie"Could not open config: $!\n";# cwd if requestedif(exists$c{docroot}) {if(-d$c{docroot}) {chdir$c{docroot};}else{croak"Documentroot $c{docroot} doesn't exist!\n";}}# set pidfile, override Daemon::Generic behavior$self->{gd_pidfile} =$c{pidfile} ?$c{pidfile} :'/var/run/apid.pid';if($self->{gd_pidfile} !~ /^\// &&exists$c{docroot}) {if(-d$c{docroot}) {$self->{gd_pidfile} ="$c{docroot}/$pidfile";}}# set procname$0 ="APId";if(exists$c{apiname}) {my$n=$c{apiname};$n=~ s/[\s\/]//g;$0 ="APId-$n";}return%c;}subgd_postconfig {my($self,%c) =@_;%cfg=%c;$server= WWW::REST::Apid->new(%cfg,log=>sub{my($msg) =@_;printf("%s [%d] %s\n",scalarlocaltime(), $$,$msg);},foreground=>$self->{gd_foreground},);if(-e$cfg{map}) {require$cfg{map};}else{die"Could not find map file $cfg{map}!\n";}$server->lateconfig(authuri=>$authuri,authbasic=>$authbasic);if($apidoc) {$server->mapuri(path=>'/doc',handler=>sub{&dodoc});}}subgd_run {$server->run();}newdaemon(progname=>'apid',pidfile=>$pidfile,configfile=>'apid.conf',);1;=head1 NAMEapid - Generic REST API Daemon=head1 SYNOPSISUsage: apid [ -c file ] [ -f ] { command }-c file Specify configuration file (instead of apid.conf)-f Run in the foreground (don't detach)Possible commands are:start Starts a new apid if there isn't one running alreadystop Stops a running apidreload Causes a running apid to reload it's config file.Starts a new one if none is running.restart Stops a running apid if one is running. Starts a new one.check Check the configuration file and report the daemon statehelp Display this usage infoversion Display the version of apiddebug Starts a new apid in the foreground=head1 DESCRIPTIONapid is a generic http(s) daemon which can be used to provide a RESTfulweb service in front of something which isn't already web aware. If youalready have some application server or website with a service running,apid is of no use for you. However, if there's some arcane, weird orjust old computing system which is accessible by perl you want to makeavailable online as a web service, then apid might be a solution.To use apid, you have to write a perl script which maps uris to handlers,so you're totally free in what you want to achieve and how to do it.=head1 FEATURES=over=item *supports http and https.=item *authentication via POST vars or basic authentication=item *decorators which you can use to enable authentication orinput validation per uri.=item *automatically converts incoming data (post vars, json post orquery string) to a perl structure for easy access. Handlersreturn perl structures which will be converted automaticallyto json as well.=back=head1 CONFIGURATIONA config file is required for apid to work. The format is very simple,one option per line, the value separated by an equal sign. Empty linesor lines preceeded with '# are ignored.Possible parameters:host = localhostport = 4433map = my.pmapiname = My APIapiversion = 0.0.1sslcrt = server.crtsslkey = server.keyIf sslkey or sslcrt is omitted, apid will speak http, otherwise https.You can configure more aspects of ssl by using L<IO::Socket::SSL->new()>parameters.=head1 MAP SCRIPTThe map script, in the config specified with the B<map> parameter, controlsthe behavior of apid. In its simplest form it only contains a couple ofhandlers, here an example:get '/date' => sub {my $date = scalar localtime();return { date => $date };};Now, start apid:apid -c my.conf -f startAnd access the api function:% curl http://localhost:8080/date{"date":"Wed Oct 22 20:29:50 2014"}Can't be easier.=head2 AUTHENTICATIONTo use authentication, you have to implement a login function and you have totell apid which kind of auth you want.Full example:use Authen::Simple::LDAP;auth basic => 'my api';implement login => sub {my($user, $pass) = @_;my $ldap = Authen::Simple::LDAP->new(host => 'ldap.company.com',basedn => 'ou=People,dc=company,dc=net');if ( $ldap->authenticate( $user, $pass ) ) {return 1; # ok}return 0; # fail};request login;get '/date' => sub {my $date = scalar localtime();return { date => $date };};In this case we are using basic authentication which is backed by LDAP.If successfull, apid will return a cookie with a session id, whichcan be used in subsequent requests. However, with basic authenticationthis is optional, you may also leave the session cookie and just putthe auth data into every request.=head3 ENABLE BASIC AUTHENTICATIONauth basic => 'my api';The second parameter to the B<auth> decorator is the realm.=head3 ENABLE POST/REDIRECT AUTHENTICATIONauth redirect => '/login';The second parameter to the B<auth> decorator is the login uri.In this mode, an unauthenticated user is being redirected to thespecified uri, where the user has to POST the username and password,which can either be posted as a JSON string or as query string. Examples:Post auth data as JSON string:curl -d "{\"user\":{\"me\":\"mypass\"}}" http://localhost:8080/loginPost auth data directly:curl -d "user=me&pass=mypass" http://localhost:8080/loginIt is also possible to use a query string=head3 LOGIN IMPLEMENTATIONIn either case, you must implement the actual login function byusing the 'implement' decorator:implement login => sub { my($user, $pass) = @_; ... };Inside, you can use whatever you want. I'd suggest using one ofthe Authen::Simple submodules.The login handler must return true to indicate authenticationwas successfull.=head3 AUTHENTICATION DECORATORTo enable authentication for a specific uri, add the followingdecorator in front of it:request login;get '/date' => sub { .. };This has to be done for every uri handler. If you leave thedecorator for a handler it can be accessed without authentication.Example:request login;get '/date' => sub { .. };get '/uptime' => sub { .. };request login;get '/vmstat' => sub { .. };In this example, the uris /data and /vmstat require authenticationwhile /uptime can be accessed by everyone.=head2 URI MAPPINGThere's only one decorator call you use to map an uri to ahandler: B<get>. Apid doesn't distinguish between POST, PUT, DELETEor GET requests. So, however the uri have been called, your handlerwill always be called. If you need to distinguish between thevarious request types, you have to do it yourself in your handler.get '/some/uri' => sub { my $data = shift; ... return {}; };The handler gets passed the submitted data as its first and onlyparameter, if present. The data is always a perl structure.Apid expects the handler to return a perl structure as well, whichwill be converted to JSON and returned to the client.There are a couple of variables which are available to eachhandler:=over=item B<$req>This is a standard L<HTTP::Request> object. In addition, if authenticationwas enabled, it contains the username of the authenticated client:$req->{user}=item B<$res>This is a standard L<HTTP::Response> object. You may modify the HTTPreturn code or add additional headers to the response as you please.=item B<%cfg>This is a hash containing all options of the configuration file. It hasbeen parsed by L<Config::General>.=back=head2 INPUT VALIDATIONApid can validate input data automatically by using L<Data::Validate::Struct>.To enable it, use the validate decorator:request validate => { expression => 'text' };get '/ps/search' => sub {my $data = shift;return &ps2a($data->{expression});};The parameter to the decorator is the validator struct required byL<Data::Validate::Struct>. Please refer to the documentation therefor details.If input validation fails, apid will return an error message as JSONand HTTP response code 403.=head2 AUTOMATIC DOCUMENTATIONUsually you'll want to write the documentation for your APIyourself. For the lazy ones, there's a documentation decorator,which you can use to generate it.request doc => 'some text';get '/some/uri' => sub { .. };If apid encounters one or more documentation decorators it generatesa documentation which is available at /doc/.Beware, that this documentation is very basic, however it at leastexplains if the uri requires authentication, what kind or input itexpects (if validation were enabled) and if authentication is required.=head1 HELPFUL CURL COMMANDS FOR TESTINGauth to url with login requested:curl -c cookies -b cookies -k -v --user USER:PASS https://localhost:4443/foo/baraccess url when auth ok:curl -c cookies -b cookies -k -v https://localhost:4443/foo/barpost query data:curl -k -v -d "name=foo&year=2014" https://localhost:4443/foo/barpost json data:curl -k -v -d "{\"user\":{\"name\":\"foo\"}}" https://localhost:4443/foo/barpost json file 'body.json':curl -k -v -H "Content-Type: application/json" -d @body.json https://localhost:4443/foo/barpost data as query string:curl -k -v -d "https://localhost:4443/foo/bar?name=hans&age=2014"get json data:curl -k -v -d https://localhost:4443/foo/bar=head1 AUTHORT.v.Dein <tlinden@cpan.org>=head1 BUGSReport bugs to=head1 SEE ALSOL<WWW::REST::Apid>L<HTTP::Daemon>L<HTTP::Daemon::SSL>L<Daemon::Generic>L<Config::General>L<Data::Validate::Struct>=head1 COPYRIGHTCopyright (c) 2014 by T.v.Dein <tlinden@cpan.org>.All rights reserved.=head1 LICENSEThis program is free software; you can redistribute itand/or modify it under the same terms as Perl itself.=head1 VERSIONapid Version 0.07.=cut