Forking.pm 2.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
  1. package Frontier::Daemon::Forking;
  2. # $Id: Forking.pm,v 1.6 2004/01/23 19:48:33 tcaine Exp $
  3. use strict;
  4. use vars qw{@ISA $VERSION};
  5. $VERSION = '0.02';
  6. use Frontier::RPC2;
  7. use HTTP::Daemon;
  8. use HTTP::Status;
  9. @ISA = qw{HTTP::Daemon};
  10. # most of this routine comes directly from Frontier::Daemon
  11. sub new {
  12. my $class = shift;
  13. my %args = @_;
  14. my $encoding = delete $args{encoding};
  15. my $self = $class->SUPER::new( %args );
  16. return undef unless $self;
  17. my @options;
  18. push @options, encoding => $encoding
  19. if $encoding;
  20. ${*$self}{methods} = $args{methods};
  21. ${*$self}{decode} = new Frontier::RPC2(@options);
  22. ${*$self}{response} = new HTTP::Response 200;
  23. ${*$self}{response}->header( 'Content-Type' => 'text/xml' );
  24. local $SIG{CHLD} = 'IGNORE';
  25. ACCEPT:
  26. while ( my $conn = $self->accept ) {
  27. my $pid = fork;
  28. next ACCEPT if $pid;
  29. if ( not defined $pid ) {
  30. warn "fork() failed: $!";
  31. $conn = undef;
  32. }
  33. else {
  34. my $request = $conn->get_request;
  35. if ($request) {
  36. if ($request->method eq 'POST' && $request->url->path eq '/RPC2') {
  37. ${*$self}{'response'}->content(
  38. ${*$self}{'decode'}->serve(
  39. $request->content,
  40. ${*$self}{'methods'},
  41. )
  42. );
  43. $conn->send_response(${*$self}{'response'});
  44. } else {
  45. $conn->send_error(RC_FORBIDDEN);
  46. }
  47. }
  48. }
  49. exit;
  50. }
  51. }
  52. 1;
  53. __END__
  54. =head1 NAME
  55. Frontier::Daemon::Forking - receive Frontier XML RPC requests
  56. =head1 SYNOPSIS
  57. use Frontier::Daemon::Forking;
  58. Frontier::Daemon::Forking->new(
  59. methods => {
  60. rpcName => \&rpcHandler,
  61. },
  62. encoding => 'ISO-8859-1',
  63. );
  64. sub rpcHandler { return 'OK' }
  65. =head1 DESCRIPTION
  66. L<Frontier::Daemon::Forking> is a drop in replacement for L<Frontier::Daemon> when a forking HTTP/1.1 server is needed that listens on a socket for incoming requests containing Frontier XML RPC2 method calls. Most of the code was borrowed from L<Frontier::Daemon>.
  67. =head1 AUTHOR
  68. Todd Caine, [email protected]
  69. =head1 SEE ALSO
  70. L<Frontier::RPC2>, L<Frontier::Daemon>, L<HTTP::Daemon>
  71. =cut