1 ############################################################################### 2 # 3 # This file copyright (c) 2001 by Randy J. Ray <rjray@blackperl.com>, 4 # all rights reserved 5 # 6 # Copying and distribution are permitted under the terms of the Artistic 7 # License as distributed with Perl versions 5.005 and later. See 8 # http://language.perl.com/misc/Artistic.html 9 # 10 ############################################################################### 11 # 12 # $Id$ 13 # 14 # Description: This package implements a RPC server as an Apache/mod_perl 15 # content handler. It uses the RPC::XML::Server package to 16 # handle request decoding and response encoding. 17 # 18 # Functions: handler 19 # new 20 # 21 # Libraries: RPC::XML::Server 22 # 23 # Global Consts: $VERSION 24 # 25 ############################################################################### 26 27 package Apache::RPC::Server; 28 29 use5.005; 30 usestrict; 31 32 use File::Spec; 33 34 useApache; 35 use Apache::File;# For ease-of-use methods like set_last_modified 36 use Apache::Constants ':common'; 37 38 use RPC::XML::Server; 39 @Apache::RPC::Server::ISA =qw(RPC::XML::Server); 40 41 BEGIN
42 { 43 $Apache::RPC::Server::INSTALL_DIR = (File::Spec->splitpath(__FILE__))[1]; 44 %Apache::RPC::Server::SERVER_TABLE = (); 45 } 46 47 $Apache::RPC::Server::VERSION =do{my@r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r}; 48 49 1; 50 51 sub version {$Apache::RPC::Server::VERSION } 52 53 sub debug
54 { 55 my$self=shift; 56 my$fmt=shift; 57 58 my$debug=ref($self) ? $self->SUPER::debug() :1; 59 60 $fmt&&$debug&& 61 Apache::log_error(sprintf("%p ($$): $fmt", 62 (ref $self) ? $self:0,@_)); 63 64 $debug; 65 } 66 67 ############################################################################### 68 # 69 # Sub Name: handler 70 # 71 # Description: This is the default routine that Apache will look for 72 # when we set this class up as a content handler. 73 # 74 # Arguments: NAME IN/OUT TYPE DESCRIPTION 75 # $class in scalar Static name of the class we're 76 # invoked in 77 # $r in ref Blessed Apache::Request object 78 # 79 # Globals: $DEF_OBJ 80 # 81 # Environment: None. 82 # 83 # Returns: Response code 84 # 85 ############################################################################### 86 subhandler($$) 87 { 88 my$class=shift; 89 my$r=shift; 90 91 my($self,$srv,$content,$resp,$respxml); 92 93 $srv= (ref $class) ? $class:$class->get_server($r); 94 unless(ref $srv) 95 { 96 $r->log_error(__PACKAGE__ .': PANIC! '.$srv); 97 returnSERVER_ERROR; 98 } 99 100 # Set the relevant headers 101 my$hdrs=$srv->response->headers; 102 for(keys %$hdrs) {$r->header_out($_=>$hdrs->{$_}) } 103 # We're essentially done if this was a HEAD request 104 if($r->header_only) 105 { 106 # These headers are either only sent for HEAD requests or are different 107 # enough to move here from the above block 108 $r->set_last_modified($srv->started); 109 $r->send_http_header; 110 } 111 elsif($r->method eq'POST') 112 { 113 # Step 1: Do we have the correct content-type? 114 return DECLINED unless($r->header_in('Content-Type')eq'text/xml'); 115 $r->read($content,$r->header_in('Content-Length')); 116 117 # Step 2: Process the request and encode the outgoing response 118 # Dispatch will always return a RPC::XML::response 119 $resp=$srv->dispatch(\$content); 120 $respxml=$resp->as_string; 121 122 # Step 3: Form up and send the headers and body of the response 123 $r->content_type('text/xml'); 124 $r->set_content_length(length $respxml); 125 $r->no_cache(1); 126 $r->send_http_header; 127 $r->print(\$respxml); 128 } 129 else 130 { 131 # Flag this as an error, since we don't permit the other methods 132 returnDECLINED; 133 } 134 135 returnOK; 136 } 137 138 ############################################################################### 139 # 140 # Sub Name: init_handler 141 # 142 # Description: Provide a handler for the PerlChildInitHandler phase that 143 # walks through the table of server objects and updates the 144 # child_started time on each. 145 # 146 # Arguments: NAME IN/OUT TYPE DESCRIPTION 147 # $class in scalar Calling class (this is a method 148 # handler) 149 # $r in ref Apache reference object 150 # 151 # Globals: %SERVER_TABLE 152 # 153 # Environment: None. 154 # 155 # Returns: 1 156 # 157 ############################################################################### 158 subinit_handler($$) 159 { 160 my($class,$r) =@_; 161 162 $_->child_started(1)for(values %Apache::RPC::Server::SERVER_TABLE); 163 164 1; 165 } 166 167 ############################################################################### 168 # 169 # Sub Name: new 170 # 171 # Description: Create a new server object, which is blessed into this 172 # class and thus inherits most of the important bits from 173 # RPC::XML::Server. 174 # 175 # Arguments: NAME IN/OUT TYPE DESCRIPTION 176 # $class in scalar String or ref to ID the class 177 # @argz in list Type and relevance of args is 178 # variable. See text. 179 # 180 # Globals: $INSTALL_DIR 181 # 182 # Environment: None. 183 # 184 # Returns: Success: ref to new object 185 # Failure: error string 186 # 187 ############################################################################### 188 sub new
189 { 190 my$class=shift; 191 my@argz=@_; 192 193 my($R,$servid,$prefix,$self,@dirs,@files,$ret,$no_def,$debug, 194 $do_auto,$do_mtime); 195 196 ($R,$servid,$prefix) =splice(@argz,0,3); 197 push(@argz, path =>$R->location)unless(grep(/^path$/,@argz)); 198 199 # Is debugging requested? 200 $debug=$R->dir_config("${prefix}RpcDebugLevel") ||0; 201 # Check for disabling of auto-loading or mtime-checking 202 $do_auto=$R->dir_config("${prefix}RpcAutoMethods"); 203 $do_mtime=$R->dir_config("${prefix}RpcAutoUpdates"); 204 foreach($do_auto,$do_mtime) {$_= (/yes/i) ? 1:0} 205 206 # Create the object, ensuring that the defaults are not yet loaded: 207 $self=$class->SUPER::new(no_default =>1, debug =>$debug, no_http =>1, 208 host =>$R->hostname, 209 port =>$R->get_server_port, 210 auto_methods =>$do_auto, 211 auto_updates =>$do_mtime, 212 xpl_path => 213 [$Apache::RPC::Server::INSTALL_DIR ], 214 @argz); 215 return$selfunless(ref $self);# Non-ref means an error message 216 $self->started('set'); 217 218 # Check to see if we should suppress the default methods 219 $no_def=$R->dir_config("${prefix}RpcDefMethods"); 220 $no_def= ($no_def=~/no/i) ? 1:0; 221 unless($no_def) 222 { 223 $self->add_default_methods(-except =>'status.xpl'); 224 # This should find the Apache version of system.status instead 225 $self->add_method('status.xpl'); 226 } 227 228 # Determine what methods we are configuring for this server instance 229 @dirs=split(/:/,$R->dir_config("${prefix}RpcMethodDir")); 230 @files=split(/:/,$R->dir_config("${prefix}RpcMethod")); 231 # Load the directories first, then the individual files. This allows the 232 # files to potentially override entries in the directories. 233 for(@dirs) 234 { 235 $ret=$self->add_methods_in_dir($_); 236 return$retunless ref $ret; 237 } 238 for(@files) 239 { 240 $ret=$self->add_method($_); 241 return$retunless ref $ret; 242 } 243 $ret=$self->xpl_path; 244 unshift(@$ret,@dirs); 245 $self->xpl_path($ret); 246 247 $Apache::RPC::Server::SERVER_TABLE{$servid} =$self; 248 $self; 249 } 250 251 # Accessor similar to started() that has a time localized to this child process 252 sub child_started
253 { 254 my$self=shift; 255 my$set= shift ||0; 256 257 my$old=$self->{__child_started} ||$self->started ||0; 258 $self->{__child_started} = time if$set; 259 260 $old; 261 } 262 263 ############################################################################### 264 # 265 # Sub Name: get_server 266 # 267 # Description: Retrieve the server object for the specified fully-qual'd 268 # URL passed in as arg #2. Note that this isn't a class 269 # method-- it's only called by handler() and the first arg 270 # is the Apache object reference. 271 # 272 # Arguments: NAME IN/OUT TYPE DESCRIPTION 273 # $self in sc/ref Object ref or class name 274 # $r in ref Apache interface object ref 275 # 276 # Globals: %SERVER_TABLE 277 # 278 # Environment: None. 279 # 280 # Returns: object ref, either specific or the default object. Sends a 281 # text string if new() fails 282 # 283 ############################################################################### 284 sub get_server
285 { 286 my$self=shift; 287 my$r=shift; 288 289 my$prefix=$r->dir_config('RPCOptPrefix') ||''; 290 my$servid=$r->dir_config("${prefix}RpcServer") ||'<default>'; 291 292 $Apache::RPC::Server::SERVER_TABLE{$servid} || 293 $self->new($r,$servid,$prefix, 294 # These are parameters that bubble up to the SUPER::new() 295 xpl_path => [$Apache::RPC::Server::INSTALL_DIR ], 296 no_http =>1,# We, um, have that covered 297 path =>$r->location); 298 } 299 300 __END__
301 302 =pod
303 304 =head1 NAME
305 306 Apache::RPC::Server - A subclass of RPC::XML::Server class tuned for mod_perl
307 308 =head1 SYNOPSIS
309 310 # In httpd.conf: 311 PerlSetVar RpcMethodDir /var/www/rpc:/usr/lib/perl5/RPC-shared
312 PerlChildInitHandler Apache::RPC::Server->init_handler
313 ... 314 <Location /RPC> 315 SetHandler perl-script
316 PerlHandler Apache::RPC::Server
317 </Location> 318 </Location /RPC-limited> 319 SetHandler perl-script
320 PerlHandler Apache::RPC::Server
321 PerlSetVar RPCOptPrefix RpcLimit
322 PerlSetVar RpcLimitRpcServer Limited
323 PerlSetVar RpcLimitRpcMethodDir /usr/lib/perl5/RPC-shared
324 </Location> 325 326 # In the start-up Perl file: 327 use Apache::RPC::Server; 328 329 =head1 DESCRIPTION
330 331 The B<Apache::RPC::Server> module is a subclassing of B<RPC::XML::Server> that
332 is tuned and designed for use within Apache with mod_perl. 333 334 Provided are phase-handlers for the general request-processing phase
335 (C<PerlHandler>)and the child-process initialization phase
336 (C<PerlChildInitHandler>). The module should be loaded either by inclusion in a
337 server start-up Perl script or by directives in the server configuration file
338 (generally F<httpd.con>). One loaded, the configuration file may assign the
339 module to handle one or more given locations with the general set of
340 C<E<lt>LocationE<gt>> directives and familiar options. Additional configuration
341 settings specific to this module are detailed below. 342 343 Generally, externally-available methods are provided as files in the XML
344 dialect explained in L<RPC::XML::Server>. A subclass derived from this class
345 may of course use the methods provided by this class and its parent class for 346 adding and manipulating the method table. 347 348 =head1 USAGE
349 350 This module is designed to be dropped in with little(if any) modification. 351 The methods that the server publishes are provided by a combination of the
352 installation files and Apache configuration values. Details on remote method
353 syntax and semantics is covered in L<RPC::XML::Server>. 354 355 =head2 Methods
356 357 In addition to inheriting all the methods from B<RPC::XML::Server>, the
358 following methods are either added or overloaded by B<Apache::RPC::Server>: 359 360 =over 4 361 362 =item handler
363 364 This is the default content-handler routine that B<mod_perl> expects when the
365 module is defined as managing the specified location. This is provided as a
366 I<method handler>, meaning that the first argument is either an object
367 reference or a static string with the class name. This allows for other
368 packages to easily subclass B<Apache::RPC::Server>. 369 370 This routine takes care of examining the incoming request, choosing an
371 appropriate server object to actually process the request,and returning the
372 results of the remote method call to the client. 373 374 =item init_handler
375 376 This is another Apache-level handler, this one designed for installation as a
377 C<PerlChildInitHandler>. At present, its only function is to iterate over all
378 server object currently in the internal tables and invoke the C<child_started> 379 method(detailed below) on each. Setting this handler assures that each child
380 has a correct impression of when it started as opposed to the start time of the
381 server itself. 382 383 Note that this is only applied to those servers known to the master Apache
384 process. In most cases, this will only be the default server object as
385 described above. That is because of the delayed-loading nature of all servers
386 beyond the default, which are likely only in child-specific memory. There are
387 some configuration options described in the next section that can affect and 388 alter this. 389 390 =item new
391 392 This is the class constructor. It calls the superclass C<new> method, then
393 performs some additional steps. These include installing the default methods
394 (which includes an Apache-specific version of C<system.status>), adding the
395 installation directory of this module to the method search path,and adding any
396 directories or explicitly-requested methods to the server object. 397 398 This version of C<new> expects the argument list to follow one of two patterns: 399 it is either a single token "C<set-default>", which creates and initializes the
400 default server,or it has the following elements(in order): 401 402 Apache class instance(reference) 403 Server ID string of the server being created
404 Prefix(if any) to be applied to the configuration values fetched
405 (All remaining arguments are passed unchanged to C<SUPER::new()>) 406 407 The server identification string and prefix concepts are explained in more
408 detail in the next section. 409 410 =item child_started([BOOLEAN]) 411 412 This method is very similar to the C<started> method provided by
413 B<RPC::XML::Server>. When called with no argument or an argument that evaluates
414 to a false value, it returns the UNIX-style time value of when this child
415 process was started. Due to the child-management model of Apache, this may very
416 well be different from the value returned by C<started> itself. If given an
417 argument that evaluates as true, the current system time is set as the new
418 child-start time. 419 420 If the server has not been configured to set this at child initialization, then
421 the main C<started> value is returned. The name is different so that a child
422 may specify both server-start and child-start times with clear distinction. 423 424 =item version
425 426 This method behaves exactly like the B<RPC::XML::Server> method, save that the
427 version string returned is(surprisingly enough)for this module instead. 428 429 =back
430 431 =head2 Apache configuration semantics
432 433 In addition to the known directives such as C<PerlHandler>and 434 C<PerlChildInitHandler>, configuration of this system is controlled through a
435 variety of settings that are manipulated with the C<PerlSetVar>and 436 C<PerlAddVar> directives. These variables are: 437 438 =over 4 439 440 =item RPCOptPrefix [STRING] 441 442 Sets a prefix string to be applied to all of the following names before trying
443 to read their values. Useful for setting within a C<E<lt>LocationE<gt>> block
444 to ensure that no settings from a higher point in the hierarchy influence the
445 server being defined. 446 447 =item RpcServer [STRING] 448 449 Specify the name of the server to use for this location. If not passed, then
450 the default server is used. This server may also be explicitly requested by the
451 name "C<C<E<lt>defaultE<gt>>>". If more than one server are going to be created
452 within the same Apache environment, this setting should always be used outside
453 the default area so that the default server is not loaded down with extra
454 method definitions. If a sub-location changes the default server, those changes
455 will be felt by any location that uses that server. 456 457 Different locations may share the same server by specifying the name with this
458 variable. This is useful for managing varied access schemes, traffic analysis, 459 etc. 460 461 =item RpcServerDir [DIRECTORY] 462 463 This variable specifies directories to be scanned for method C<*.xpl> 464 files. To specify more than one directory, separate them with "C<:>" just as
465 with any other directory-path expression. All directories are kept(in the
466 order specified) as the search path for future loading of methods. 467 468 =item RpcServerMethod [FILENAME] 469 470 This is akin to the directory-specification option above, but only provides a
471 single method at a time. It may also have multiple values separated by
472 colons. The method is loaded into the server table. If the name is not an
473 absolute pathname, then it is searched for in the directories that currently
474 comprise the path. The directories above, however, have not been added to the
475 search path yet. This is because these directives are processed immediately
476 after the directory specifications,and thus do not need to be searched. This
477 directive is designed to allow selective overriding of methods in the
478 previously-specified directories. 479 480 =item RpcDefMethods [YES|NO] 481 482 If specified and set to "no"(case-insensitive), suppresses the loading of the
483 system default methods that are provided with this package. The absence of this
484 setting is interpreted as a "yes", so explicitly specifying such is not needed. 485 486 =item RpcAutoMethods [YES|NO] 487 488 If specified and set to "yes", enables the automatic searching for a requested
489 remote method that is unknown to the server object handling the request. If
490 set to "no"(or not set at all), then a request for an unknown function causes
491 the object instance to report an error. If the routine is still not found, the
492 error is reported. Enabling this is a security risk,and should only be
493 permitted by a server administrator with fully informed acknowledgement and 494 consent. 495 496 =item RpcNoAutoUpdate [YES|NO] 497 498 (Not yet implemented) If specified and set to "yes", enables the checking of
499 the modification time of the file from which a method was originally
500 loaded. If the file has changed, the method is re-loaded before execution is
501 handed off. As with the auto-loading of methods, this represents a security
502 risk,and should only be permitted by a server administrator with fully
503 informed acknowledgement and consent. 504 505 =item RpcDebugLevel [NUMBER] 506 507 Enable debugging by providing a numerical value that will
508 be used as the debug setting by the parent class, B<RPC::XML::Server>. 509 510 =back
511 512 =head2 Specifying methods to the server(s) 513 514 Methods are provided to an B<Apache::RPC::Server> object in three ways: 515 516 =over 4 517 518 =item Default methods
519 520 Unless suppressed by a C<RpcDefMethods> option, the methods shipped with this
521 package are loaded into the table. The B<Apache::RPC::Server> objects get a
522 slightly different version of C<system.status> than the parent class does. 523 524 =item Configured directories
525 526 All method files(those ending in a suffix of C<*.xpl>) in the directories
527 specified in the relevant C<RpcMethodDir> settings are read next. These
528 directories are also(after the next step) added to the search path the object
529 uses. 530 531 =item By specific inclusion
532 533 Any methods specified directly by use of C<RpcMethod> settings are loaded
534 last. This allows for them to override methods that may have been loaded from
535 the system defaults or the specified directories. 536 537 =back
538 539 If a request is made for an unknown method, the object will first attempt to
540 find it by searching the path of directories that were given in the
541 configuration as well as those that are part of the system(installation-level
542 directories). If it is still not found, then an error is reported back to the
543 requestor. By using this technique, it is possible to add methods to a running
544 server without restarting it. It is a potential security hole, however,and it
545 is for that reason that the previously-documented C<RpcNoNewMethods> setting is
546 provided. 547 548 =head1 DIAGNOSTICS
549 550 All methods return some type of reference on success,or an error string on
551 failure. Non-reference return values should always be interpreted as errors
552 unless otherwise noted. 553 554 Where appropriate, the C<log_error> method from the B<Apache>package 555 is called to note internal errors. 556 557 =head1 CAVEATS
558 559 This is a reference implementation in which clarity of process and readability
560 of the code took precedence over general efficiency. Much,if not all, of this
561 can be written more compactly and/or efficiently. 562 563 =head1 CREDITS
564 565 The B<XML-RPC> standard is Copyright(c)1998-2001, UserLand Software, Inc. 566 See <http://www.xmlrpc.com>for more information about the B<XML-RPC> 567 specification. 568 569 =head1 LICENSE
570 571 This module is licensed under the terms of the Artistic License that covers
572 Perl itself. See <http://language.perl.com/misc/Artistic.html>for the
573 license itself. 574 575 =head1 SEE ALSO
576 577 L<RPC::XML::Server>, L<RPC::XML> 578 579 =head1 AUTHOR
580 581 Randy J. Ray <rjray@blackperl.com>