Loading ...
Sorry, an error occurred while loading the content.

Re: Fwd: Process-Pool Forking SOAP Server.

Expand Messages
  • Michael E Brown
    Paul, I believe that at least one moderate performance server should be included in the main distribution. Also, I think that it should be installed by
    Message 1 of 12 , Jun 15, 2001
    • 0 Attachment
      Paul,

      I believe that at least one moderate performance server should be included in
      the main distribution. Also, I think that it should be installed by default,
      without having to copy by hand from examples/ directory. I would not have
      bothered writing my own if I had known there were already others in
      existence. I tried both of the published modules and I coudn't get either one
      up to an acceptable level of performance.

      From my testing, the server modules included by default are not acceptable
      for real load at all, so I was desperate enough to make a go at writing my
      own module. The thing that I especially like about my module are the support
      utilities in Daemon.pm that make it easy to track your server status. Also, a
      nice feature of my Forking module is that you can dynamically add or remove
      processes. In fact, I do that with another daemon that I have that monitors
      the active connections and spawns another soap process whenever the number of
      clients gets too high.

      --
      Michael Brown

      On Friday 15 June 2001 10:36, Paul Kulchenko wrote:
      > Hi, All!
      >
      > Here is the Forking server from Michael Brown.
      >
      > Now in my collection (unpublished means not included with SOAP::Lite
      > yet):
      >
      > ForkAfterProcessing (published) from Peter Fraenkel
      > ForkOnAccept (published) from Michael Douglass
      > preforking daemon (unpublished) from Roger Foskett
      > Forking and Preforking daemon (unpublished) from Douglas Bonar
      > Forking server (unpublished) from Michael Brown
      > My own work with NetGeneric::Server (not ready)
      >
      > Now, the question is how to include all these modules into the
      > distribution? Easiest way is to include them all and let users
      > decide, but it might be not the best option, just because it may lead
      > to confusion and if we can't decide why users should :)).
      >
      > Anyway, what is all's opinion? Should I carefully review them and
      > decide? Should someone more experienced with TCP processing do it?
      > Include them all?
      >
      > Ideally I would like to have as many as needed (but not more) modules
      > that cover your requirements (forking, select, prefork, non-blocking,
      > etc.) and at the same time maintain consistent interface among
      > different transport on server side (at least between HTTP and TCP).
      > Thank you everybody for your help and support.
      >
      > Best wishes, Paul.
      >
      > --- Michael E Brown <michaelbrown@...> wrote:
      > > I've had this mail bounced from the list because I'm not
      > > subscribed. I was
      > > wondering if you could forward it to the list...
      > >
      > > ---------- Forwarded Message ----------
      > > Subject: Process-Pool Forking SOAP Server.
      > > Date: Thu, 14 Jun 2001 23:59:53 -0500
      > > From: Michael E Brown <michaelbrown@...>
      > > To: soaplite@yahoogroups.com
      > > Cc: christopher_stanton@..., michael_e_brown@...
      > >
      > >
      > > Attached are some small improvements in useability and scalability
      > > of the
      > > example soap.pl module. Please take a look and consider them for
      > > inclusion in
      > > the base SOAP::Lite package.
      > >
      > > I hope that the code is clean enough to be self-documenting :-)
      > >
      > > There is a small improvement upon the ForkAfterProcessing.pm HTTP
      > > server
      > > module. I've gotten improvements of 2min processing time --> 5sec
      > > processing time, and scaling from 5 clients to 50 clients hitting
      > > the
      > > server much more heavily.
      > >
      > > Features in the ForkingSOAP module... this is modeled after the
      > > Apache config
      > > names.
      > >
      > > 1) MaxChildren... initial size of process pool to create
      > > 2) MaxRequestsPerChild... children die after processing n requests
      > > (helps
      > > with memory leaks :-)
      > >
      > > 3) Dynamic, on the fly adjustment of number of processes. Just send
      > > SIGUSR1 to add a process, and SIGUSR2 to remove a process.
      > >
      > > 4) Reporting of # of currently active children in a separate file.
      > >
      > > 5) 'Parent' thread keeps track of children and spawns more as
      > > needed.
      > >
      > > --
      > > Michael Brown
      > >
      > > -------------------------------------------------------
      > >
      > > > package SOAP::Transport::HTTP::Daemon::ForkingSOAP;
      > >
      > > #use strict;
      > > use vars qw(@ISA);
      > > use SOAP::Transport::HTTP;
      > > use POSIX ":sys_wait_h";
      > >
      > > # Implementation and Idea by Michael Brown and Christopher Stanton
      > > # Inspired by Peter Fraenkel (Peter.Fraenkel@...) and
      > > # his ForkAfterProcessing module.
      > >
      > > @ISA = qw(SOAP::Transport::HTTP::Daemon);
      > >
      > > #Package Globals (PUBLIC)
      > > our $MaxChildren = 16;
      > > our $MaxRequestsPerChild = 50;
      > > our $DEBUG = 0;
      > > our $ChildCountFile;
      > >
      > > #Package Globals (PRIVATE)
      > > our %children;
      > > my $die;
      > >
      > > #Functions...
      > > sub handle {
      > > my $self = shift->new;
      > > my $parentpid = $$;
      > > my $oldchildcount = $MaxChildren;
      > >
      > > $SIG{TERM} = sub { foreach (keys %children){ kill(15, $_) };
      > > $die++ };
      > > $SIG{USR1} = sub { $MaxChildren++; };
      > > $SIG{USR2} = sub { $MaxChildren--; };
      > > $SIG{CHLD} = 'DEFAULT';
      > >
      > > while( ! $die ) {
      > > if( $ChildCountFile && ($oldchildcount != $MaxChildren)){
      > > print "Output new MaxChildren to $ChildCountFile\n" if $DEBUG;
      > > open CHILDCOUNT, "> $ChildCountFile" or next;
      > > print CHILDCOUNT $MaxChildren;
      > > close CHILDCOUNT;
      > > }
      > >
      > > while( scalar(keys %children) < $MaxChildren ) {
      > > my $childpid;
      > > if( $childpid = fork ) { # parent
      > > $children{ $childpid } = 1;
      > > print " child created: $childpid\n" if $DEBUG;
      > > } else { #child
      > > $SIG{TERM} = sub {exit};
      > > my $counter = 1;
      > > while (my $c = $self->accept) {
      > > while (my $r = $c->get_request) {
      > > $self->request($r);
      > > $self->SOAP::Transport::HTTP::Server::handle;
      > > $c->send_response($self->response)
      > > }
      > > $c->close;
      > > undef $c;
      > > print " Child handled request #" . $counter. "\n" if $DEBUG;
      > > exit if ++$counter > $MaxRequestsPerChild;
      > > exit if ! kill(0, $parentpid);
      > > }
      > > exit;
      > > }
      > > }
      > >
      > > $kid = waitpid(-1,&WNOHANG);
      > > delete $children{$kid} if ($kid > 0);
      > > print "Reaped child: $kid\n" if (($kid > 0) && $DEBUG);
      > > sleep 1;
      > > }
      > > }
      > >
      > > 1;
      > >
      > > > #!/opt/ali-client/bin/perl -T -w
      > >
      > > ##
      > > ## soap.pl
      > > ##
      > >
      > > #Pragmas
      > > use strict;
      > >
      > > #Perl Modules
      > > use lib '/opt/ali/lib';
      > > use Fcntl;
      > > use Getopt::Long;
      > >
      > > #My Modules
      > > use ForkingSOAP;
      > > use Daemon;
      > >
      > > #Package Global Variables
      > >
      > > #Package Lexical Variables
      > > my ($nodaemon, $help, $kill, $status, $debug);
      > > my ($more_children, $less_children);
      > > my $daemon = "SoapServer";
      > >
      > > #Security stuff
      > > delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
      > > $ENV{PATH} = '/bin:/usr/bin';
      > >
      > > #Read Command Line
      > > GetOptions('nodaemon' => \$nodaemon,
      > > 'more_children' => \$more_children,
      > > 'less_children' => \$less_children,
      > > 'debug' => \$debug,
      > > 'kill+' => \$kill,
      > > 'status' => \$status,
      > > 'help' => \$help) or die "Exiting...\n";
      > >
      > > #Set output autoflush
      > > $| = 1;
      > >
      > > if( $kill ) {
      > > print "Killing... \n";
      > > # send SIGTERM
      > > Daemon::SendSignal( daemon => $daemon, signal => 15 );
      > > exit;
      > > }
      > >
      > > if( $more_children ) {
      > > print "Signaling... \n";
      > > # send SIGUSR1
      > > Daemon::SendSignal( daemon => $daemon, signal => 10 );
      > > exit;
      > > }
      > >
      > > if( $less_children ) {
      > > print "Signaling... \n";
      > > # send SIGUSR2
      > > Daemon::SendSignal( daemon => $daemon, signal => 12 );
      > > exit;
      > > }
      > >
      > > if( $status ) {
      > > my $retval = Daemon::PrintStatus( daemon => $daemon );
      > > #shell uses opposite truth
      > > exit ! $retval;
      > > }
      > >
      > > if( ! $nodaemon ){
      > > Daemon::Daemonize( daemon => $daemon, debug => $debug );
      > > }
      > >
      > > my $pidstat = Daemon::WritePID( daemon => $daemon, $debug =>
      > > $debug );
      > > if( ! $pidstat ){
      > > #WritePID will write out an error msg for us.
      > > exit 1;
      > > }
      > >
      > > #Set Signal Handlers
      > > $SIG{PIPE} = 'IGNORE';
      > > $SIG{TERM} = sub { Daemon::UnlinkPIDFile( daemon => $daemon );
      > > exit 0; };
      > >
      > > #Initialize Daemon code.
      > > my $httpdaemon = SOAP::Transport::HTTP::Daemon::ForkingSOAP
      > > -> new (LocalPort => 1080, Reuse => 1)
      > > -> dispatch_to('MyModule');
      > >
      > > print "Contact to SOAP server at ", $httpdaemon->url, "\n";
      > >
      > > #Get # of threads to use...
      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxChildren
      > > = 5;
      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxRequestsPerChild
      > > = 50;
      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DEBUG = $debug;
      > >
      > > #This never returns...
      > > $httpdaemon->handle;
      > >
      > > #But if it does, we end up here :-)
      > > Daemon::UnlinkPIDFile( daemon => $daemon );
      > > exit 0;
      > >
      > > > ##
      > >
      > > ## Daemon.pm
      > > ##
      > >
      > > package Daemon;
      > >
      > > #Pragmas
      > > use strict;
      > >
      > > #Perl Modules
      > > use Carp;
      > > use Fcntl;
      > >
      > > #My Modules
      > >
      > > #Package Lexical Variables
      > > my $piddir = "/var/run";
      > > my $logdir = "/var/log";
      > >
      > > # param: daemon
      > > sub KillFileExists {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $killfile = "$piddir/kill-$daemon";
      > >
      > > return ( -e $killfile );
      > > }
      > >
      > > # param: daemon
      > > sub UnlinkKillFile {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $killfile = "$piddir/kill-$daemon";
      > >
      > > unlink $killfile;
      > > }
      > >
      > > # param: daemon
      > > sub UnlinkPIDFile {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $pidfile = "$piddir/$daemon.pid";
      > >
      > > unlink $pidfile or croak "unable to unlink $pidfile";
      > > }
      > >
      > > # param: daemon
      > > sub CreateKillFile {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $killfile = "$piddir/kill-$daemon";
      > >
      > > open MYOUTFILE, "> $killfile";
      > > close MYOUTFILE;
      > > }
      > >
      > > # param: daemon
      > > sub SafeKill {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > > CreateKillFile( daemon => $daemon );
      > > }
      > >
      > > # param: daemon
      > > sub SendSignal {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > > my $signal = $param->{signal};
      > >
      > > my $pidfile = "$daemon.pid";
      > >
      > > open INPUT, "<", ($piddir . $pidfile) or return undef;
      > > my $pid = <INPUT>;
      > > close INPUT;
      > > $pid =~ m/(\d+)/;
      > > $pid = $1;
      > > kill( $signal, $pid );
      > > }
      > >
      > > sub ProcessStatus {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $pidfile = "$daemon.pid";
      > >
      > > my $retval = undef;
      > > open INPUT, "<", ($piddir . $pidfile) or goto out1;
      > > my $pid = <INPUT>;
      > > close INPUT;
      > >
      > > $retval = 0;
      > > $pid =~ m/(\d+)/;
      > > $pid = $1;
      > > chomp($pid);
      > > if( kill(0, $pid) ){
      > > $retval = 1;
      > > }
      > >
      > > out1:
      > > $retval = 0 if ! -e ($piddir . $pidfile);
      > > return $retval;
      > > }
      > >
      > > # param: daemon
      > > sub PrintStatus {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $status = ProcessStatus( $param );
      > >
      > > my $printval;
      > > if( ! defined($status) ){
      > > $printval = "ERROR: Unable to open pid file.";
      > > } elsif ( $status ) {
      > > $printval = "RUNNING";
      > > } else {
      > > $printval = "STOPPED";
      > > }
      > >
      > > print $printval . "\n";
      > > return $status;
      > > }
      > >
      > > # param: debug, daemon
      > > sub Daemonize {
      > > my $param = _build_param_ref( @_ );
      > > my $debug = $param->{debug};
      > > my $daemon = $param->{daemon};
      > >
      > > my $outfile;
      > > if( $debug ) {
      > > $outfile = "$logdir/$daemon";
      > > if( ! -e $logdir ){
      > > system("mkdir -p $logdir");
      > > }
      > > } else {
      > > $outfile = '/dev/null';
      > > }
      > >
      > > #print "outfile: $outfile\n";
      > >
      > > close STDIN;
      > > open STDIN, "< /dev/null";
      > > close STDOUT;
      > > open STDOUT, "> $outfile";
      > > close STDERR;
      > > open STDERR, "> $outfile";
      > >
      > > fork and exit;
      > > }
      > >
      > > # param: daemon
      > > sub WritePID {
      > > my $param = _build_param_ref( @_ );
      > > my $daemon = $param->{daemon};
      > >
      > > my $pidfile = "$daemon.pid";
      > >
      > > my $retval = 0;
      > >
      > > retry:
      > > system("mkdir -p $piddir");
      > > if( sysopen( OUTPUT, ($piddir . $pidfile), O_CREAT | O_EXCL |
      > > O_WRONLY | O_TRUNC ) ) {
      > > print OUTPUT $$;
      > > close OUTPUT;
      > > $retval = 1;
      > > } else {
      > > my $status = ProcessStatus( $param );
      > >
      > > lock_out:
      > > if( ! defined($status) ) {
      > > print "I can't open the PID file: $piddir$pidfile";
      > > $retval = undef;
      > > } elsif ( $status ) {
      > > print "It appears that another copy of $daemon is running.";
      > > $retval = 0;
      > > } else {
      > > unlink ($piddir . $pidfile) or die "cannot remove
      > > $piddir/$pidfile\n";
      > > goto retry;
      > > }
      > > }
      > > return $retval;
      > > }
      > >
      > > sub _build_param_ref {
      > > my $nextarg = shift;
      > > my $param_ref;
      > > no warnings;
      > > if( ref($nextarg) ) {
      > > $param_ref = $nextarg;
      > > } elsif (defined($nextarg) && @_) {
      > > $param_ref = { $nextarg, @_ };
      > > } elsif (defined($nextarg) ) {
      > > $param_ref = { $nextarg => "" };
      > > } else {
      >
      > === message truncated ===
      >
      >
      > __________________________________________________
      > Do You Yahoo!?
      > Spot the hottest trends in music, movies, and more.
      > http://buzz.yahoo.com/
    • Paul Kulchenko
      Hi, Michael! ... Absolutely. I agree with you. I would like to include simple daemon, bulletproof daemon and nonblocking daemon. Your solution might work as
      Message 2 of 12 , Jun 16, 2001
      • 0 Attachment
        Hi, Michael!

        > I believe that at least one moderate performance server should be
        > included in
        > the main distribution. Also, I think that it should be installed by
        > default,
        > without having to copy by hand from examples/ directory. I would
        Absolutely. I agree with you. I would like to include simple daemon,
        bulletproof daemon and nonblocking daemon.

        Your solution might work as bulletproof choice, however some
        modifications are still required. First of all, Daemon.pm shouldn't
        be Daemon, it might be SOAP::Transport::Daemon (because it'll provide
        methods suitable for HTTP, TCP and other daemons). I would also like
        to add:
        1. changing user and group ids
        2. tainting
        3. chroot
        4. relaunch on signal

        Everything is optional, so you can choose whatever you need.

        I would like to make it less Unix-oriented if possible (esp. for
        non-blocking server, since it can run on almost any platform) and
        drop 'our', so it'll work on 5.005 also. Everything else looks fine
        for me :). I'll try to come up with TCP non-blocking server next week
        and accomodate those changes for HTTP-based server also.

        Best wishes, Paul.

        --- Michael E Brown <michaelbrown@...> wrote:
        > Paul,
        >
        > I believe that at least one moderate performance server should be
        > included in
        > the main distribution. Also, I think that it should be installed by
        > default,
        > without having to copy by hand from examples/ directory. I would
        > not have
        > bothered writing my own if I had known there were already others in
        >
        > existence. I tried both of the published modules and I coudn't get
        > either one
        > up to an acceptable level of performance.
        >
        > From my testing, the server modules included by default are not
        > acceptable
        > for real load at all, so I was desperate enough to make a go at
        > writing my
        > own module. The thing that I especially like about my module are
        > the support
        > utilities in Daemon.pm that make it easy to track your server
        > status. Also, a
        > nice feature of my Forking module is that you can dynamically add
        > or remove
        > processes. In fact, I do that with another daemon that I have that
        > monitors
        > the active connections and spawns another soap process whenever the
        > number of
        > clients gets too high.
        >
        > --
        > Michael Brown
        >
        > On Friday 15 June 2001 10:36, Paul Kulchenko wrote:
        > > Hi, All!
        > >
        > > Here is the Forking server from Michael Brown.
        > >
        > > Now in my collection (unpublished means not included with
        > SOAP::Lite
        > > yet):
        > >
        > > ForkAfterProcessing (published) from Peter Fraenkel
        > > ForkOnAccept (published) from Michael Douglass
        > > preforking daemon (unpublished) from Roger Foskett
        > > Forking and Preforking daemon (unpublished) from Douglas Bonar
        > > Forking server (unpublished) from Michael Brown
        > > My own work with NetGeneric::Server (not ready)
        > >
        > > Now, the question is how to include all these modules into the
        > > distribution? Easiest way is to include them all and let users
        > > decide, but it might be not the best option, just because it may
        > lead
        > > to confusion and if we can't decide why users should :)).
        > >
        > > Anyway, what is all's opinion? Should I carefully review them and
        > > decide? Should someone more experienced with TCP processing do
        > it?
        > > Include them all?
        > >
        > > Ideally I would like to have as many as needed (but not more)
        > modules
        > > that cover your requirements (forking, select, prefork,
        > non-blocking,
        > > etc.) and at the same time maintain consistent interface among
        > > different transport on server side (at least between HTTP and
        > TCP).
        > > Thank you everybody for your help and support.
        > >
        > > Best wishes, Paul.
        > >
        > > --- Michael E Brown <michaelbrown@...> wrote:
        > > > I've had this mail bounced from the list because I'm not
        > > > subscribed. I was
        > > > wondering if you could forward it to the list...
        > > >
        > > > ---------- Forwarded Message ----------
        > > > Subject: Process-Pool Forking SOAP Server.
        > > > Date: Thu, 14 Jun 2001 23:59:53 -0500
        > > > From: Michael E Brown <michaelbrown@...>
        > > > To: soaplite@yahoogroups.com
        > > > Cc: christopher_stanton@..., michael_e_brown@...
        > > >
        > > >
        > > > Attached are some small improvements in useability and
        > scalability
        > > > of the
        > > > example soap.pl module. Please take a look and consider them
        > for
        > > > inclusion in
        > > > the base SOAP::Lite package.
        > > >
        > > > I hope that the code is clean enough to be self-documenting :-)
        > > >
        > > > There is a small improvement upon the ForkAfterProcessing.pm
        > HTTP
        > > > server
        > > > module. I've gotten improvements of 2min processing time -->
        > 5sec
        > > > processing time, and scaling from 5 clients to 50 clients
        > hitting
        > > > the
        > > > server much more heavily.
        > > >
        > > > Features in the ForkingSOAP module... this is modeled after the
        > > > Apache config
        > > > names.
        > > >
        > > > 1) MaxChildren... initial size of process pool to create
        > > > 2) MaxRequestsPerChild... children die after processing n
        > requests
        > > > (helps
        > > > with memory leaks :-)
        > > >
        > > > 3) Dynamic, on the fly adjustment of number of processes. Just
        > send
        > > > SIGUSR1 to add a process, and SIGUSR2 to remove a process.
        > > >
        > > > 4) Reporting of # of currently active children in a separate
        > file.
        > > >
        > > > 5) 'Parent' thread keeps track of children and spawns more as
        > > > needed.
        > > >
        > > > --
        > > > Michael Brown
        > > >
        > > > -------------------------------------------------------
        > > >
        > > > > package SOAP::Transport::HTTP::Daemon::ForkingSOAP;
        > > >
        > > > #use strict;
        > > > use vars qw(@ISA);
        > > > use SOAP::Transport::HTTP;
        > > > use POSIX ":sys_wait_h";
        > > >
        > > > # Implementation and Idea by Michael Brown and Christopher
        > Stanton
        > > > # Inspired by Peter Fraenkel (Peter.Fraenkel@...) and
        > > > # his ForkAfterProcessing module.
        > > >
        > > > @ISA = qw(SOAP::Transport::HTTP::Daemon);
        > > >
        > > > #Package Globals (PUBLIC)
        > > > our $MaxChildren = 16;
        > > > our $MaxRequestsPerChild = 50;
        > > > our $DEBUG = 0;
        > > > our $ChildCountFile;
        > > >
        > > > #Package Globals (PRIVATE)
        > > > our %children;
        > > > my $die;
        > > >
        > > > #Functions...
        > > > sub handle {
        > > > my $self = shift->new;
        > > > my $parentpid = $$;
        > > > my $oldchildcount = $MaxChildren;
        > > >
        > > > $SIG{TERM} = sub { foreach (keys %children){ kill(15, $_) };
        > > > $die++ };
        > > > $SIG{USR1} = sub { $MaxChildren++; };
        > > > $SIG{USR2} = sub { $MaxChildren--; };
        > > > $SIG{CHLD} = 'DEFAULT';
        > > >
        > > > while( ! $die ) {
        > > > if( $ChildCountFile && ($oldchildcount != $MaxChildren)){
        > > > print "Output new MaxChildren to $ChildCountFile\n" if
        > $DEBUG;
        > > > open CHILDCOUNT, "> $ChildCountFile" or next;
        > > > print CHILDCOUNT $MaxChildren;
        > > > close CHILDCOUNT;
        > > > }
        > > >
        > > > while( scalar(keys %children) < $MaxChildren ) {
        > > > my $childpid;
        > > > if( $childpid = fork ) { # parent
        > > > $children{ $childpid } = 1;
        > > > print " child created: $childpid\n" if $DEBUG;
        > > > } else { #child
        > > > $SIG{TERM} = sub {exit};
        > > > my $counter = 1;
        > > > while (my $c = $self->accept) {
        > > > while (my $r = $c->get_request) {
        > > > $self->request($r);
        > > > $self->SOAP::Transport::HTTP::Server::handle;
        > > > $c->send_response($self->response)
        > > > }
        > > > $c->close;
        > > > undef $c;
        > > > print " Child handled request #" . $counter. "\n" if
        > $DEBUG;
        > > > exit if ++$counter > $MaxRequestsPerChild;
        > > > exit if ! kill(0, $parentpid);
        > > > }
        > > > exit;
        > > > }
        > > > }
        > > >
        > > > $kid = waitpid(-1,&WNOHANG);
        > > > delete $children{$kid} if ($kid > 0);
        >
        === message truncated ===


        __________________________________________________
        Do You Yahoo!?
        Spot the hottest trends in music, movies, and more.
        http://buzz.yahoo.com/
      • Michael E Brown
        ... I called it Daemon because it is a general purpose library that I am using in the rest of my project with other non-soap daemons. If you want to pull it
        Message 3 of 12 , Jun 16, 2001
        • 0 Attachment
          On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:
          > Hi, Michael!
          >
          > > I believe that at least one moderate performance server should be
          > > included in
          > > the main distribution. Also, I think that it should be installed by
          > > default,
          > > without having to copy by hand from examples/ directory. I would
          >
          > Absolutely. I agree with you. I would like to include simple daemon,
          > bulletproof daemon and nonblocking daemon.
          >
          > Your solution might work as bulletproof choice, however some
          > modifications are still required. First of all, Daemon.pm shouldn't

          I called it 'Daemon' because it is a general purpose library that I am using
          in the rest of my project with other non-soap daemons. If you want to pull it
          into your namespace, that is fine, though. It doesn't have any SOAP-specific
          stuff in it, just utilites to manage pid files and log files.

          > be Daemon, it might be SOAP::Transport::Daemon (because it'll provide
          > methods suitable for HTTP, TCP and other daemons). I would also like
          > to add:
          > 1. changing user and group ids
          > 2. tainting
          > 3. chroot
          > 4. relaunch on signal
          >
          > Everything is optional, so you can choose whatever you need.

          OK. If you think my code is a good starting point, do whatever you think
          needs to be done with it.

          I had been going about changing user/group id by making my soap.pl setuid to
          the user/group I want it to run as.

          What do you mean wrt tainting?

          As far as relaunching on a signal, I had though about passing the ForkingSOAP
          module a list of modules to 'require'. Then each time a child is spawned, it
          'require's the list of modules. This way each child starts fresh with the
          newest copy of the module. Then you could send a signal that makes the parent
          kill all it's children and respawn them. Is this approximately what you were
          thinking?
          --
          Michael Brown
        • Michael E Brown
          ... Here is a new version that incorporates two new ideas: 1) relaunch on signal and 2) Dynamic Module Loading. After you load this module, set the array
          Message 4 of 12 , Jun 16, 2001
          • 0 Attachment
            On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:


            > Your solution might work as bulletproof choice, however some
            > modifications are still required. First of all, Daemon.pm shouldn't
            > be Daemon, it might be SOAP::Transport::Daemon (because it'll provide
            > methods suitable for HTTP, TCP and other daemons). I would also like
            > to add:
            > 1. changing user and group ids
            > 2. tainting
            > 3. chroot
            > 4. relaunch on signal

            Here is a new version that incorporates two new ideas: 1) relaunch on signal
            and 2) Dynamic Module Loading.

            After you load this module, set the array @DynamicModuleList, and each child
            will load all of the modules in that array after they fork.

            The relaunch on signal is implemented as SIGHUP and SIGINT.

            SIGHUP: signals each child to finish handling any outstanding requests and
            exit. Parent process respawns each child.

            SIGINT: forcefully kills off each child. Parent process respawns each child.

            >
            > Everything is optional, so you can choose whatever you need.
            >
            > I would like to make it less Unix-oriented if possible (esp. for
            > non-blocking server, since it can run on almost any platform) and
            > drop 'our', so it'll work on 5.005 also. Everything else looks fine

            Is this the only change required for 5.005? I'll send you another version
            later tonight with this.

            > for me :). I'll try to come up with TCP non-blocking server next week
            > and accomodate those changes for HTTP-based server also.
            >
            > Best wishes, Paul.
          • Paul Kulchenko
            Hi, Michael! YOu may also check Network Programming with Perl (http://www.modperl.com/perl_networking/) and examples
            Message 5 of 12 , Jun 16, 2001
            • 0 Attachment
              Hi, Michael!

              YOu may also check Network Programming with Perl
              (http://www.modperl.com/perl_networking/) and examples
              (http://www.modperl.com/perl_networking/source/perl_networking.zip),
              esp. lib\Daemon.pm in this archive. Lincoln Stein did a great job
              incorporation almost all pieces in one module, it definitely worth a
              look.

              > Is this the only change required for 5.005?
              I believe so. I didn't try to run it yet, but I didn't notice
              anything else that doesn't work on 5.005.

              >I'll send you another version later tonight with this.
              That's quick, thanks :).

              Best wishes, Paul.

              --- Michael E Brown <michaelbrown@...> wrote:
              > On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:
              >
              >
              > > Your solution might work as bulletproof choice, however some
              > > modifications are still required. First of all, Daemon.pm
              > shouldn't
              > > be Daemon, it might be SOAP::Transport::Daemon (because it'll
              > provide
              > > methods suitable for HTTP, TCP and other daemons). I would also
              > like
              > > to add:
              > > 1. changing user and group ids
              > > 2. tainting
              > > 3. chroot
              > > 4. relaunch on signal
              >
              > Here is a new version that incorporates two new ideas: 1) relaunch
              > on signal
              > and 2) Dynamic Module Loading.
              >
              > After you load this module, set the array @DynamicModuleList, and
              > each child
              > will load all of the modules in that array after they fork.
              >
              > The relaunch on signal is implemented as SIGHUP and SIGINT.
              >
              > SIGHUP: signals each child to finish handling any outstanding
              > requests and
              > exit. Parent process respawns each child.
              >
              > SIGINT: forcefully kills off each child. Parent process respawns
              > each child.
              >
              > >
              > > Everything is optional, so you can choose whatever you need.
              > >
              > > I would like to make it less Unix-oriented if possible (esp. for
              > > non-blocking server, since it can run on almost any platform) and
              > > drop 'our', so it'll work on 5.005 also. Everything else looks
              > fine
              >
              > Is this the only change required for 5.005? I'll send you another
              > version
              > later tonight with this.
              >
              > > for me :). I'll try to come up with TCP non-blocking server next
              > week
              > > and accomodate those changes for HTTP-based server also.
              > >
              > > Best wishes, Paul.> #!/opt/ali-client/bin/perl -T -w
              > ##
              > ## soap.pl
              > ##
              >
              > #Pragmas
              > use strict;
              >
              > #Perl Modules
              > use lib '/opt/ali/lib';
              > use Fcntl;
              > use Getopt::Long;
              >
              > #My Modules
              > use ForkingSOAP;
              > use ReadConfig;
              > use Daemon;
              >
              > #Package Global Variables
              >
              > #Package Lexical Variables
              > my ($nodaemon, $help, $kill, $status, $debug);
              > my ($more_children, $less_children, $reload, $forcereload);
              > my $daemon = "SoapServer";
              >
              > #Security stuff
              > delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
              > $ENV{PATH} = '/bin:/usr/bin';
              >
              > #Read Command Line
              > GetOptions('nodaemon' => \$nodaemon,
              > 'more_children' => \$more_children,
              > 'less_children' => \$less_children,
              > 'reload' => \$reload,
              > 'forcereload' => \$forcereload,
              > 'debug' => \$debug,
              > 'kill+' => \$kill,
              > 'status' => \$status,
              > 'help' => \$help) or die "Exiting...\n";
              >
              > #Set output autoflush
              > $| = 1;
              >
              > if( $kill ) {
              > print "Killing... \n";
              > # send SIGTERM
              > Daemon::SendSignal( daemon => $daemon, signal => 15 );
              > exit;
              > }
              >
              > if( $more_children ) {
              > print "Signaling... \n";
              > # send SIGUSR1
              > Daemon::SendSignal( daemon => $daemon, signal => 10 );
              > exit;
              > }
              >
              > if( $less_children ) {
              > print "Signaling... \n";
              > # send SIGUSR2
              > Daemon::SendSignal( daemon => $daemon, signal => 12 );
              > exit;
              > }
              >
              > if( $reload ) {
              > print "Signaling... \n";
              > # send SIGHUP
              > Daemon::SendSignal( daemon => $daemon, signal => 2 );
              > exit;
              > }
              >
              > if( $forcereload ) {
              > print "Signaling... \n";
              > # send SIGINT
              > Daemon::SendSignal( daemon => $daemon, signal => 1 );
              > exit;
              > }
              >
              > if( $status ) {
              > my $retval = Daemon::PrintStatus( daemon => $daemon );
              > #shell uses opposite truth
              > exit ! $retval;
              > }
              >
              > if( ! $nodaemon ){
              > Daemon::Daemonize( daemon => $daemon, debug => $debug );
              > }
              >
              > my $pidstat = Daemon::WritePID( daemon => $daemon, $debug =>
              > $debug );
              > if( ! $pidstat ){
              > #WritePID will write out an error msg for us.
              > exit 1;
              > }
              >
              > #Set Signal Handlers
              > $SIG{PIPE} = 'IGNORE';
              > $SIG{TERM} = sub { Daemon::UnlinkPIDFile( daemon => $daemon );
              > exit 0; };
              >
              > #Initialize Daemon code.
              > my $httpdaemon = SOAP::Transport::HTTP::Daemon::ForkingSOAP
              > -> new (LocalPort => 1080, Reuse => 1)
              > -> dispatch_to('GenericDB2');
              >
              > print "Contact to SOAP server at ", $httpdaemon->url, "\n";
              >
              > #Get # of threads to use...
              > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxChildren
              > = 4;
              > #= (GenericDB2->Fetch( '/ali/_DB/soap_MaxChildren' ) || 8);
              > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxRequestsPerChild
              > = 10;
              > #= (GenericDB2->Fetch( '/ali/_DB/soap_MaxRequestsPerChild' ) ||
              > 50);
              > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DynamicModuleList
              > = ("GenericDB2");
              > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DEBUG = $debug;
              >
              > #This never returns...
              > $httpdaemon->handle;
              >
              > #But if it does, we end up here :-)
              > Daemon::UnlinkPIDFile( daemon => $daemon );
              > exit 0;
              > > package SOAP::Transport::HTTP::Daemon::ForkingSOAP;
              >
              > #use strict;
              > use vars qw(@ISA);
              > use SOAP::Transport::HTTP;
              > use POSIX ":sys_wait_h";
              >
              > # Implementation and Idea by Michael Brown and Christopher Stanton
              > # Inspired by Peter Fraenkel (Peter.Fraenkel@...) and
              > # his ForkAfterProcessing module.
              >
              > @ISA = qw(SOAP::Transport::HTTP::Daemon);
              >
              > #Package Globals (PUBLIC)
              > our $DynamicModuleList = ();
              > our $MaxChildren = 16;
              > our $MaxRequestsPerChild = 50;
              > our $DEBUG = 0;
              > our $ChildCountFile;
              >
              > #Package Globals (PRIVATE)
              > our %children;
              > my $die;
              > my $exitsoon;
              >
              > #Functions...
              > sub handle {
              > my $self = shift->new;
              > my $parentpid = $$;
              > my $oldchildcount = $MaxChildren;
              >
              > $SIG{TERM} = sub { foreach (keys %children){ kill(15, $_) };
              > $die++ };
              > $SIG{HUP} = sub { foreach (keys %children){ kill(15, $_) };
              > return 1};
              > $SIG{INT} = sub { foreach (keys %children){ kill(2, $_) }; return
              > 1};
              > $SIG{USR1} = sub { $MaxChildren++; };
              > $SIG{USR2} = sub { $MaxChildren--; };
              > $SIG{CHLD} = 'DEFAULT';
              >
              > while( ! $die ) {
              > if( $ChildCountFile && ($oldchildcount != $MaxChildren)){
              > print "Output new MaxChildren to $ChildCountFile\n" if $DEBUG;
              > open CHILDCOUNT, "> $ChildCountFile" or next;
              > print CHILDCOUNT $MaxChildren;
              > close CHILDCOUNT;
              > }
              >
              > if( scalar(keys %children) < $MaxChildren ) {
              > my $childpid;
              > if( $childpid = fork ) { # parent
              > $children{ $childpid } = 1;
              > print " child created: $childpid\n" if $DEBUG;
              > } else { #child
              > $SIG{TERM} = sub {exit};
              > $SIG{INT} = sub {$exitsoon++; return 1};
              > foreach my $module (@DynamicModuleList){
              > eval "require $module";
              > print $@ if $@;
              > }
              > my $counter = 1;
              > while (my $c = $self->accept) {
              > while (my $r = $c->get_request) {
              > $self->request($r);
              > $self->SOAP::Transport::HTTP::Server::handle;
              > $c->send_response($self->response)
              > }
              > $c->close;
              > undef $c;
              > print " Child handled request # $counter\n" if $DEBUG;
              > exit if $exitsoon;
              > exit if ++$counter > $MaxRequestsPerChild;
              > exit if ! kill(0, $parentpid);
              > }
              > exit;
              > }
              > }
              >
              > $kid = waitpid(-1,&WNOHANG);
              > delete $children{$kid} if ($kid > 0);
              > print "Reaped child: $kid\n" if (($kid > 0) && $DEBUG);
              > sleep 1;
              > }
              > }
              >
              > 1;
              > > ##
              > ## Daemon.pm
              > ##
              >
              > package Daemon;
              >
              > #Pragmas
              > use strict;
              >
              > #Perl Modules
              > use Carp;
              > use Fcntl;
              >
              > #My Modules
              > use ReadConfig;
              >
              > #Package Lexical Variables
              > my $mconfig = ReadConfig::ReadConfigPath( "ali.conf", "/etc");
              > my $piddir = $mconfig->{alivar} . "/run/";
              > my $logdir = $mconfig->{alivar} . "/log/";
              >
              > # param: daemon
              > sub KillFileExists {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $killfile = "$piddir/kill-$daemon";
              >
              > return ( -e $killfile );
              > }
              >
              > # param: daemon
              > sub UnlinkKillFile {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $killfile = "$piddir/kill-$daemon";
              >
              > unlink $killfile;
              > }
              >
              > # param: daemon
              > sub UnlinkPIDFile {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $pidfile = "$piddir/$daemon.pid";
              >
              > unlink $pidfile or croak "unable to unlink $pidfile";
              > }
              >
              > # param: daemon
              > sub CreateKillFile {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $killfile = "$piddir/kill-$daemon";
              >
              > open MYOUTFILE, "> $killfile";
              > close MYOUTFILE;
              > }
              >
              > # param: daemon
              > sub SafeKill {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              > CreateKillFile( daemon => $daemon );
              > }
              >
              > # param: daemon
              > sub SendSignal {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              > my $signal = $param->{signal};
              >
              > my $pidfile = "$daemon.pid";
              >
              > open INPUT, "<", ($piddir . $pidfile) or return undef;
              > my $pid = <INPUT>;
              > close INPUT;
              > $pid =~ m/(\d+)/;
              > $pid = $1;
              > kill( $signal, $pid );
              > }
              >
              > sub ProcessStatus {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $pidfile = "$daemon.pid";
              >
              > my $retval = undef;
              > open INPUT, "<", ($piddir . $pidfile) or goto out1;
              > my $pid = <INPUT>;
              > close INPUT;
              >
              > $retval = 0;
              > $pid =~ m/(\d+)/;
              > $pid = $1;
              > chomp($pid);
              > if( kill(0, $pid) ){
              > $retval = 1;
              > }
              >
              > out1:
              > $retval = 0 if ! -e ($piddir . $pidfile);
              > return $retval;
              > }
              >
              > # param: daemon
              > sub PrintStatus {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $status = ProcessStatus( $param );
              >
              > my $printval;
              > if( ! defined($status) ){
              > $printval = "ERROR: Unable to open pid file.";
              > } elsif ( $status ) {
              > $printval = "RUNNING";
              > } else {
              > $printval = "STOPPED";
              > }
              >
              > print $printval . "\n";
              > return $status;
              > }
              >
              > # param: debug, daemon
              > sub Daemonize {
              > my $param = _build_param_ref( @_ );
              > my $debug = $param->{debug};
              > my $daemon = $param->{daemon};
              >
              > my $outfile;
              > if( $debug ) {
              > $outfile = "$logdir/$daemon";
              > if( ! -e $logdir ){
              > system("mkdir -p $logdir");
              > }
              > } else {
              > $outfile = '/dev/null';
              > }
              >
              > #print "outfile: $outfile\n";
              >
              > close STDIN;
              > open STDIN, "< /dev/null";
              > close STDOUT;
              > open STDOUT, "> $outfile";
              > close STDERR;
              > open STDERR, "> $outfile";
              >
              > fork and exit;
              > }
              >
              > # param: daemon
              > sub WritePID {
              > my $param = _build_param_ref( @_ );
              > my $daemon = $param->{daemon};
              >
              > my $pidfile = "$daemon.pid";
              >
              > my $retval = 0;
              >
              > retry:
              > system("mkdir -p $piddir");
              > if( sysopen( OUTPUT, ($piddir . $pidfile), O_CREAT | O_EXCL |
              > O_WRONLY | O_TRUNC ) ) {
              > print OUTPUT $$;
              > close OUTPUT;
              > $retval = 1;
              > } else {
              > my $status = ProcessStatus( $param );
              >
              > lock_out:
              > if( ! defined($status) ) {
              > print "I can't open the PID file: $piddir$pidfile";
              > $retval = undef;
              > } elsif ( $status ) {
              > print "It appears that another copy of $daemon is running.";
              > $retval = 0;
              > } else {
              > unlink ($piddir . $pidfile) or die "cannot remove
              > $piddir/$pidfile\n";
              > goto retry;
              > }
              > }
              > return $retval;
              > }
              >
              > sub _build_param_ref {
              > my $nextarg = shift;
              > my $param_ref;
              > no warnings;
              > if( ref($nextarg) ) {
              > $param_ref = $nextarg;
              > } elsif (defined($nextarg) && @_) {
              > $param_ref = { $nextarg, @_ };
              > } elsif (defined($nextarg) ) {
              >
              === message truncated ===


              __________________________________________________
              Do You Yahoo!?
              Spot the hottest trends in music, movies, and more.
              http://buzz.yahoo.com/
            • Michael E Brown
              On Saturday 16 June 2001 18:22, Paul Kulchenko wrote: How do you prefer changes? Would you like me to resend the entire modules each time, or would you prefer
              Message 6 of 12 , Jun 16, 2001
              • 0 Attachment
                On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:

                How do you prefer changes? Would you like me to resend the entire modules
                each time, or would you prefer 'diff -u'?

                > Your solution might work as bulletproof choice, however some
                > modifications are still required. First of all, Daemon.pm shouldn't
                > be Daemon, it might be SOAP::Transport::Daemon (because it'll provide
                > methods suitable for HTTP, TCP and other daemons). I would also like
                > to add:
                > 1. changing user and group ids

                Use "--user username" and "--group groupname" to have the soap.pl change user
                and group ids.

                > 2. tainting
                > 3. chroot

                The method is now in the Daemon module, but I haven't added it to soap.pl
                yet. That will be the next one I send.

                > 4. relaunch on signal

                Same capabilities as the last one I sent.

                The last example I sent had some cruft from my specific implementation still
                in it. I've cleaned it out so that it is more appropriate as a general
                example now.

                --
                Michael
              • Michael E Brown
                Forgot the attachements ... ... package SOAP::Transport::HTTP::Daemon::ForkingSOAP; #use strict; use vars qw(@ISA); use SOAP::Transport::HTTP; use POSIX
                Message 7 of 12 , Jun 16, 2001
                • 0 Attachment
                  Forgot the attachements <blush>...

                  On Saturday 16 June 2001 23:47, Michael E Brown wrote:
                  > On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:
                  >
                  > How do you prefer changes? Would you like me to resend the entire modules
                  > each time, or would you prefer 'diff -u'?
                  >
                  > > Your solution might work as bulletproof choice, however some
                  > > modifications are still required. First of all, Daemon.pm shouldn't
                  > > be Daemon, it might be SOAP::Transport::Daemon (because it'll provide
                  > > methods suitable for HTTP, TCP and other daemons). I would also like
                  > > to add:
                  > > 1. changing user and group ids
                  >
                  > Use "--user username" and "--group groupname" to have the soap.pl change
                  > user and group ids.
                  >
                  > > 2. tainting
                  > > 3. chroot
                  >
                  > The method is now in the Daemon module, but I haven't added it to soap.pl
                  > yet. That will be the next one I send.
                  >
                  > > 4. relaunch on signal
                  >
                  > Same capabilities as the last one I sent.
                  >
                  > The last example I sent had some cruft from my specific implementation
                  > still in it. I've cleaned it out so that it is more appropriate as a
                  > general example now.
                  >
                  > --
                  > Michael
                  >
                  > To unsubscribe from this group, send an email to:
                  > soaplite-unsubscribe@yahoogroups.com
                  >
                  >
                  >
                  > Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/
                • Michael E Brown
                  ... Well, Lincoln Stein is a god. Of course his module (Daemon.pm) is much better than mine :-) I ll work on this a bit and get back to you... :-) -- Michael
                  Message 8 of 12 , Jun 16, 2001
                  • 0 Attachment
                    On Saturday 16 June 2001 22:07, Paul Kulchenko wrote:
                    > Hi, Michael!
                    >
                    > YOu may also check Network Programming with Perl
                    > (http://www.modperl.com/perl_networking/) and examples
                    > (http://www.modperl.com/perl_networking/source/perl_networking.zip),
                    > esp. lib\Daemon.pm in this archive. Lincoln Stein did a great job
                    > incorporation almost all pieces in one module, it definitely worth a
                    > look.

                    Well, Lincoln Stein is a god. Of course his module (Daemon.pm) is much better
                    than mine :-)

                    I'll work on this a bit and get back to you... :-)

                    --
                    Michael
                  • Michael E Brown
                    Ok, take a look. This is PRELIMINARY, and has only passed an initial sniff test, but I wanted to get some feedback on how it has been done. Attached are new
                    Message 9 of 12 , Jun 17, 2001
                    • 0 Attachment
                      Ok, take a look. This is PRELIMINARY, and has only passed an initial sniff
                      test, but I wanted to get some feedback on how it has been done.

                      Attached are new modules. They implement
                      1) change user and group id
                      2) no tainting... what did you mean by this in your list below?
                      3) chroot (not fully tested, but the infrastructure is there)
                      4) Dynamic loading of modules (no need to restart server for changes to
                      modules to take effect)
                      5) No more 'our' variables. I don't have perl5.005 to test with, though.

                      The Daemon.pm module I sent before is completely dead. In the new code, I
                      have blatantly copied Lincoln Stein's example Daemon.pm module. I have added
                      a couple of features, corrected a race, and beautified it a bit, but it
                      should still be recognizable as Lincoln's.

                      In the new API, all of the features above are completely optional. You don't
                      need to use any of them if you don't want to. Also, all of the daemonizing
                      and daemon-handling has been pulled into the ForkingSOAP module. This makes
                      the interface from soap.pl exceedingly simple. I think you would like the new
                      soap.pl. If you don't want to use any of the extended features, the new code
                      can be just as short as the example code.

                      --
                      Michael


                      On Saturday 16 June 2001 22:07, Paul Kulchenko wrote:
                      > Hi, Michael!
                      >
                      > YOu may also check Network Programming with Perl
                      > (http://www.modperl.com/perl_networking/) and examples
                      > (http://www.modperl.com/perl_networking/source/perl_networking.zip),
                      > esp. lib\Daemon.pm in this archive. Lincoln Stein did a great job
                      > incorporation almost all pieces in one module, it definitely worth a
                      > look.
                      >
                      > > Is this the only change required for 5.005?
                      >
                      > I believe so. I didn't try to run it yet, but I didn't notice
                      > anything else that doesn't work on 5.005.
                      >
                      > >I'll send you another version later tonight with this.
                      >
                      > That's quick, thanks :).
                      >
                      > Best wishes, Paul.
                      >
                      > --- Michael E Brown <michaelbrown@...> wrote:
                      > > On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:
                      > > > Your solution might work as bulletproof choice, however some
                      > > > modifications are still required. First of all, Daemon.pm
                      > >
                      > > shouldn't
                      > >
                      > > > be Daemon, it might be SOAP::Transport::Daemon (because it'll
                      > >
                      > > provide
                      > >
                      > > > methods suitable for HTTP, TCP and other daemons). I would also
                      > >
                      > > like
                      > >
                      > > > to add:
                      > > > 1. changing user and group ids
                      > > > 2. tainting
                      > > > 3. chroot
                      > > > 4. relaunch on signal
                      > >
                      > > Here is a new version that incorporates two new ideas: 1) relaunch
                      > > on signal
                      > > and 2) Dynamic Module Loading.
                      > >
                      > > After you load this module, set the array @DynamicModuleList, and
                      > > each child
                      > > will load all of the modules in that array after they fork.
                      > >
                      > > The relaunch on signal is implemented as SIGHUP and SIGINT.
                      > >
                      > > SIGHUP: signals each child to finish handling any outstanding
                      > > requests and
                      > > exit. Parent process respawns each child.
                      > >
                      > > SIGINT: forcefully kills off each child. Parent process respawns
                      > > each child.
                      > >
                      > > > Everything is optional, so you can choose whatever you need.
                      > > >
                      > > > I would like to make it less Unix-oriented if possible (esp. for
                      > > > non-blocking server, since it can run on almost any platform) and
                      > > > drop 'our', so it'll work on 5.005 also. Everything else looks
                      > >
                      > > fine
                      > >
                      > > Is this the only change required for 5.005? I'll send you another
                      > > version
                      > > later tonight with this.
                      > >
                      > > > for me :). I'll try to come up with TCP non-blocking server next
                      > >
                      > > week
                      > >
                      > > > and accomodate those changes for HTTP-based server also.
                      > > >
                      > > > Best wishes, Paul.> #!/opt/ali-client/bin/perl -T -w
                      > >
                      > > ##
                      > > ## soap.pl
                      > > ##
                      > >
                      > > #Pragmas
                      > > use strict;
                      > >
                      > > #Perl Modules
                      > > use lib '/opt/ali/lib';
                      > > use Fcntl;
                      > > use Getopt::Long;
                      > >
                      > > #My Modules
                      > > use ForkingSOAP;
                      > > use ReadConfig;
                      > > use Daemon;
                      > >
                      > > #Package Global Variables
                      > >
                      > > #Package Lexical Variables
                      > > my ($nodaemon, $help, $kill, $status, $debug);
                      > > my ($more_children, $less_children, $reload, $forcereload);
                      > > my $daemon = "SoapServer";
                      > >
                      > > #Security stuff
                      > > delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
                      > > $ENV{PATH} = '/bin:/usr/bin';
                      > >
                      > > #Read Command Line
                      > > GetOptions('nodaemon' => \$nodaemon,
                      > > 'more_children' => \$more_children,
                      > > 'less_children' => \$less_children,
                      > > 'reload' => \$reload,
                      > > 'forcereload' => \$forcereload,
                      > > 'debug' => \$debug,
                      > > 'kill+' => \$kill,
                      > > 'status' => \$status,
                      > > 'help' => \$help) or die "Exiting...\n";
                      > >
                      > > #Set output autoflush
                      > > $| = 1;
                      > >
                      > > if( $kill ) {
                      > > print "Killing... \n";
                      > > # send SIGTERM
                      > > Daemon::SendSignal( daemon => $daemon, signal => 15 );
                      > > exit;
                      > > }
                      > >
                      > > if( $more_children ) {
                      > > print "Signaling... \n";
                      > > # send SIGUSR1
                      > > Daemon::SendSignal( daemon => $daemon, signal => 10 );
                      > > exit;
                      > > }
                      > >
                      > > if( $less_children ) {
                      > > print "Signaling... \n";
                      > > # send SIGUSR2
                      > > Daemon::SendSignal( daemon => $daemon, signal => 12 );
                      > > exit;
                      > > }
                      > >
                      > > if( $reload ) {
                      > > print "Signaling... \n";
                      > > # send SIGHUP
                      > > Daemon::SendSignal( daemon => $daemon, signal => 2 );
                      > > exit;
                      > > }
                      > >
                      > > if( $forcereload ) {
                      > > print "Signaling... \n";
                      > > # send SIGINT
                      > > Daemon::SendSignal( daemon => $daemon, signal => 1 );
                      > > exit;
                      > > }
                      > >
                      > > if( $status ) {
                      > > my $retval = Daemon::PrintStatus( daemon => $daemon );
                      > > #shell uses opposite truth
                      > > exit ! $retval;
                      > > }
                      > >
                      > > if( ! $nodaemon ){
                      > > Daemon::Daemonize( daemon => $daemon, debug => $debug );
                      > > }
                      > >
                      > > my $pidstat = Daemon::WritePID( daemon => $daemon, $debug =>
                      > > $debug );
                      > > if( ! $pidstat ){
                      > > #WritePID will write out an error msg for us.
                      > > exit 1;
                      > > }
                      > >
                      > > #Set Signal Handlers
                      > > $SIG{PIPE} = 'IGNORE';
                      > > $SIG{TERM} = sub { Daemon::UnlinkPIDFile( daemon => $daemon );
                      > > exit 0; };
                      > >
                      > > #Initialize Daemon code.
                      > > my $httpdaemon = SOAP::Transport::HTTP::Daemon::ForkingSOAP
                      > > -> new (LocalPort => 1080, Reuse => 1)
                      > > -> dispatch_to('GenericDB2');
                      > >
                      > > print "Contact to SOAP server at ", $httpdaemon->url, "\n";
                      > >
                      > > #Get # of threads to use...
                      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxChildren
                      > > = 4;
                      > > #= (GenericDB2->Fetch( '/ali/_DB/soap_MaxChildren' ) || 8);
                      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxRequestsPerChild
                      > > = 10;
                      > > #= (GenericDB2->Fetch( '/ali/_DB/soap_MaxRequestsPerChild' ) ||
                      > > 50);
                      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DynamicModuleList
                      > > = ("GenericDB2");
                      > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DEBUG = $debug;
                      > >
                      > > #This never returns...
                      > > $httpdaemon->handle;
                      > >
                      > > #But if it does, we end up here :-)
                      > > Daemon::UnlinkPIDFile( daemon => $daemon );
                      > > exit 0;
                      > >
                      > > > package SOAP::Transport::HTTP::Daemon::ForkingSOAP;
                      > >
                      > > #use strict;
                      > > use vars qw(@ISA);
                      > > use SOAP::Transport::HTTP;
                      > > use POSIX ":sys_wait_h";
                      > >
                      > > # Implementation and Idea by Michael Brown and Christopher Stanton
                      > > # Inspired by Peter Fraenkel (Peter.Fraenkel@...) and
                      > > # his ForkAfterProcessing module.
                      > >
                      > > @ISA = qw(SOAP::Transport::HTTP::Daemon);
                      > >
                      > > #Package Globals (PUBLIC)
                      > > our $DynamicModuleList = ();
                      > > our $MaxChildren = 16;
                      > > our $MaxRequestsPerChild = 50;
                      > > our $DEBUG = 0;
                      > > our $ChildCountFile;
                      > >
                      > > #Package Globals (PRIVATE)
                      > > our %children;
                      > > my $die;
                      > > my $exitsoon;
                      > >
                      > > #Functions...
                      > > sub handle {
                      > > my $self = shift->new;
                      > > my $parentpid = $$;
                      > > my $oldchildcount = $MaxChildren;
                      > >
                      > > $SIG{TERM} = sub { foreach (keys %children){ kill(15, $_) };
                      > > $die++ };
                      > > $SIG{HUP} = sub { foreach (keys %children){ kill(15, $_) };
                      > > return 1};
                      > > $SIG{INT} = sub { foreach (keys %children){ kill(2, $_) }; return
                      > > 1};
                      > > $SIG{USR1} = sub { $MaxChildren++; };
                      > > $SIG{USR2} = sub { $MaxChildren--; };
                      > > $SIG{CHLD} = 'DEFAULT';
                      > >
                      > > while( ! $die ) {
                      > > if( $ChildCountFile && ($oldchildcount != $MaxChildren)){
                      > > print "Output new MaxChildren to $ChildCountFile\n" if $DEBUG;
                      > > open CHILDCOUNT, "> $ChildCountFile" or next;
                      > > print CHILDCOUNT $MaxChildren;
                      > > close CHILDCOUNT;
                      > > }
                      > >
                      > > if( scalar(keys %children) < $MaxChildren ) {
                      > > my $childpid;
                      > > if( $childpid = fork ) { # parent
                      > > $children{ $childpid } = 1;
                      > > print " child created: $childpid\n" if $DEBUG;
                      > > } else { #child
                      > > $SIG{TERM} = sub {exit};
                      > > $SIG{INT} = sub {$exitsoon++; return 1};
                      > > foreach my $module (@DynamicModuleList){
                      > > eval "require $module";
                      > > print $@ if $@;
                      > > }
                      > > my $counter = 1;
                      > > while (my $c = $self->accept) {
                      > > while (my $r = $c->get_request) {
                      > > $self->request($r);
                      > > $self->SOAP::Transport::HTTP::Server::handle;
                      > > $c->send_response($self->response)
                      > > }
                      > > $c->close;
                      > > undef $c;
                      > > print " Child handled request # $counter\n" if $DEBUG;
                      > > exit if $exitsoon;
                      > > exit if ++$counter > $MaxRequestsPerChild;
                      > > exit if ! kill(0, $parentpid);
                      > > }
                      > > exit;
                      > > }
                      > > }
                      > >
                      > > $kid = waitpid(-1,&WNOHANG);
                      > > delete $children{$kid} if ($kid > 0);
                      > > print "Reaped child: $kid\n" if (($kid > 0) && $DEBUG);
                      > > sleep 1;
                      > > }
                      > > }
                      > >
                      > > 1;
                      > >
                      > > > ##
                      > >
                      > > ## Daemon.pm
                      > > ##
                      > >
                      > > package Daemon;
                      > >
                      > > #Pragmas
                      > > use strict;
                      > >
                      > > #Perl Modules
                      > > use Carp;
                      > > use Fcntl;
                      > >
                      > > #My Modules
                      > > use ReadConfig;
                      > >
                      > > #Package Lexical Variables
                      > > my $mconfig = ReadConfig::ReadConfigPath( "ali.conf", "/etc");
                      > > my $piddir = $mconfig->{alivar} . "/run/";
                      > > my $logdir = $mconfig->{alivar} . "/log/";
                      > >
                      > > # param: daemon
                      > > sub KillFileExists {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $killfile = "$piddir/kill-$daemon";
                      > >
                      > > return ( -e $killfile );
                      > > }
                      > >
                      > > # param: daemon
                      > > sub UnlinkKillFile {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $killfile = "$piddir/kill-$daemon";
                      > >
                      > > unlink $killfile;
                      > > }
                      > >
                      > > # param: daemon
                      > > sub UnlinkPIDFile {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $pidfile = "$piddir/$daemon.pid";
                      > >
                      > > unlink $pidfile or croak "unable to unlink $pidfile";
                      > > }
                      > >
                      > > # param: daemon
                      > > sub CreateKillFile {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $killfile = "$piddir/kill-$daemon";
                      > >
                      > > open MYOUTFILE, "> $killfile";
                      > > close MYOUTFILE;
                      > > }
                      > >
                      > > # param: daemon
                      > > sub SafeKill {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > > CreateKillFile( daemon => $daemon );
                      > > }
                      > >
                      > > # param: daemon
                      > > sub SendSignal {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > > my $signal = $param->{signal};
                      > >
                      > > my $pidfile = "$daemon.pid";
                      > >
                      > > open INPUT, "<", ($piddir . $pidfile) or return undef;
                      > > my $pid = <INPUT>;
                      > > close INPUT;
                      > > $pid =~ m/(\d+)/;
                      > > $pid = $1;
                      > > kill( $signal, $pid );
                      > > }
                      > >
                      > > sub ProcessStatus {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $pidfile = "$daemon.pid";
                      > >
                      > > my $retval = undef;
                      > > open INPUT, "<", ($piddir . $pidfile) or goto out1;
                      > > my $pid = <INPUT>;
                      > > close INPUT;
                      > >
                      > > $retval = 0;
                      > > $pid =~ m/(\d+)/;
                      > > $pid = $1;
                      > > chomp($pid);
                      > > if( kill(0, $pid) ){
                      > > $retval = 1;
                      > > }
                      > >
                      > > out1:
                      > > $retval = 0 if ! -e ($piddir . $pidfile);
                      > > return $retval;
                      > > }
                      > >
                      > > # param: daemon
                      > > sub PrintStatus {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $status = ProcessStatus( $param );
                      > >
                      > > my $printval;
                      > > if( ! defined($status) ){
                      > > $printval = "ERROR: Unable to open pid file.";
                      > > } elsif ( $status ) {
                      > > $printval = "RUNNING";
                      > > } else {
                      > > $printval = "STOPPED";
                      > > }
                      > >
                      > > print $printval . "\n";
                      > > return $status;
                      > > }
                      > >
                      > > # param: debug, daemon
                      > > sub Daemonize {
                      > > my $param = _build_param_ref( @_ );
                      > > my $debug = $param->{debug};
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $outfile;
                      > > if( $debug ) {
                      > > $outfile = "$logdir/$daemon";
                      > > if( ! -e $logdir ){
                      > > system("mkdir -p $logdir");
                      > > }
                      > > } else {
                      > > $outfile = '/dev/null';
                      > > }
                      > >
                      > > #print "outfile: $outfile\n";
                      > >
                      > > close STDIN;
                      > > open STDIN, "< /dev/null";
                      > > close STDOUT;
                      > > open STDOUT, "> $outfile";
                      > > close STDERR;
                      > > open STDERR, "> $outfile";
                      > >
                      > > fork and exit;
                      > > }
                      > >
                      > > # param: daemon
                      > > sub WritePID {
                      > > my $param = _build_param_ref( @_ );
                      > > my $daemon = $param->{daemon};
                      > >
                      > > my $pidfile = "$daemon.pid";
                      > >
                      > > my $retval = 0;
                      > >
                      > > retry:
                      > > system("mkdir -p $piddir");
                      > > if( sysopen( OUTPUT, ($piddir . $pidfile), O_CREAT | O_EXCL |
                      > > O_WRONLY | O_TRUNC ) ) {
                      > > print OUTPUT $$;
                      > > close OUTPUT;
                      > > $retval = 1;
                      > > } else {
                      > > my $status = ProcessStatus( $param );
                      > >
                      > > lock_out:
                      > > if( ! defined($status) ) {
                      > > print "I can't open the PID file: $piddir$pidfile";
                      > > $retval = undef;
                      > > } elsif ( $status ) {
                      > > print "It appears that another copy of $daemon is running.";
                      > > $retval = 0;
                      > > } else {
                      > > unlink ($piddir . $pidfile) or die "cannot remove
                      > > $piddir/$pidfile\n";
                      > > goto retry;
                      > > }
                      > > }
                      > > return $retval;
                      > > }
                      > >
                      > > sub _build_param_ref {
                      > > my $nextarg = shift;
                      > > my $param_ref;
                      > > no warnings;
                      > > if( ref($nextarg) ) {
                      > > $param_ref = $nextarg;
                      > > } elsif (defined($nextarg) && @_) {
                      > > $param_ref = { $nextarg, @_ };
                      > > } elsif (defined($nextarg) ) {
                      >
                      > === message truncated ===
                      >
                      >
                      > __________________________________________________
                      > Do You Yahoo!?
                      > Spot the hottest trends in music, movies, and more.
                      > http://buzz.yahoo.com/
                      >
                      > To unsubscribe from this group, send an email to:
                      > soaplite-unsubscribe@yahoogroups.com
                      >
                      >
                      >
                      > Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/
                    • Michael E Brown
                      And this code should actually work. This has gone through a bit more testing, and all of the options that I use now work... It will go through a week of use
                      Message 10 of 12 , Jun 18, 2001
                      • 0 Attachment
                        And this code should actually work. This has gone through a bit more testing,
                        and all of the options that I use now work... It will go through a week of
                        use this week and I'll send you any updates at the end of the week.

                        Here is a list of the tested options:

                        ./soap.pl
                        --nodaemon
                        --user run as 'user' (must be root or setuid root)
                        --group run as 'group' (must be root or setuid root)
                        --more_children Add a child to process pool
                        --less_children Remove a child from process pool
                        --debug print verbose output. If in daemon mode,
                        print output to a log file.
                        --status (status is returned in $?)
                        --reload tell children to finish current connections
                        and then die (parent respawns new children)
                        --forcereload forcefully kill children (parent respawns new
                        children)
                        --chroot have children chroot to a directory before
                        processing requests.

                        chroot support is there but I have not tested it. It somewhat interferes with
                        Dynamic module loading, so I haven't tested it yet. If you use chroot and
                        dynamic module loading, you must put your modules in the chroot path.

                        From a programmatical point of view, everything is controlled through the
                        "set_options" function. This function needs a hash of name=>value pairs,
                        defined below

                        pidpath => "directory/"
                        logpath => "directory/"
                        user => "username"
                        group => "groupname"
                        chroot => "directory/"
                        daemonize => 0 | 1
                        MaxChildren => number
                        MaxRequestsPerChild => number
                        DynamicModuleList => ('list', 'of', 'modules')
                        debug => 0 | 1

                        All of these have sensible defaults.
                        --
                        Michael Brown

                        On Monday 18 June 2001 00:08, Michael E Brown wrote:
                        > Ok, take a look. This is PRELIMINARY, and has only passed an initial sniff
                        > test, but I wanted to get some feedback on how it has been done.
                        >
                        > Attached are new modules. They implement
                        > 1) change user and group id
                        > 2) no tainting... what did you mean by this in your list below?
                        > 3) chroot (not fully tested, but the infrastructure is there)
                        > 4) Dynamic loading of modules (no need to restart server for changes to
                        > modules to take effect)
                        > 5) No more 'our' variables. I don't have perl5.005 to test with, though.
                        >
                        > The Daemon.pm module I sent before is completely dead. In the new code, I
                        > have blatantly copied Lincoln Stein's example Daemon.pm module. I have
                        > added a couple of features, corrected a race, and beautified it a bit, but
                        > it should still be recognizable as Lincoln's.
                        >
                        > In the new API, all of the features above are completely optional. You
                        > don't need to use any of them if you don't want to. Also, all of the
                        > daemonizing and daemon-handling has been pulled into the ForkingSOAP
                        > module. This makes the interface from soap.pl exceedingly simple. I think
                        > you would like the new soap.pl. If you don't want to use any of the
                        > extended features, the new code can be just as short as the example code.
                        >
                        > --
                        > Michael
                        >
                        > On Saturday 16 June 2001 22:07, Paul Kulchenko wrote:
                        > > Hi, Michael!
                        > >
                        > > YOu may also check Network Programming with Perl
                        > > (http://www.modperl.com/perl_networking/) and examples
                        > > (http://www.modperl.com/perl_networking/source/perl_networking.zip),
                        > > esp. lib\Daemon.pm in this archive. Lincoln Stein did a great job
                        > > incorporation almost all pieces in one module, it definitely worth a
                        > > look.
                        > >
                        > > > Is this the only change required for 5.005?
                        > >
                        > > I believe so. I didn't try to run it yet, but I didn't notice
                        > > anything else that doesn't work on 5.005.
                        > >
                        > > >I'll send you another version later tonight with this.
                        > >
                        > > That's quick, thanks :).
                        > >
                        > > Best wishes, Paul.
                        > >
                        > > --- Michael E Brown <michaelbrown@...> wrote:
                        > > > On Saturday 16 June 2001 18:22, Paul Kulchenko wrote:
                        > > > > Your solution might work as bulletproof choice, however some
                        > > > > modifications are still required. First of all, Daemon.pm
                        > > >
                        > > > shouldn't
                        > > >
                        > > > > be Daemon, it might be SOAP::Transport::Daemon (because it'll
                        > > >
                        > > > provide
                        > > >
                        > > > > methods suitable for HTTP, TCP and other daemons). I would also
                        > > >
                        > > > like
                        > > >
                        > > > > to add:
                        > > > > 1. changing user and group ids
                        > > > > 2. tainting
                        > > > > 3. chroot
                        > > > > 4. relaunch on signal
                        > > >
                        > > > Here is a new version that incorporates two new ideas: 1) relaunch
                        > > > on signal
                        > > > and 2) Dynamic Module Loading.
                        > > >
                        > > > After you load this module, set the array @DynamicModuleList, and
                        > > > each child
                        > > > will load all of the modules in that array after they fork.
                        > > >
                        > > > The relaunch on signal is implemented as SIGHUP and SIGINT.
                        > > >
                        > > > SIGHUP: signals each child to finish handling any outstanding
                        > > > requests and
                        > > > exit. Parent process respawns each child.
                        > > >
                        > > > SIGINT: forcefully kills off each child. Parent process respawns
                        > > > each child.
                        > > >
                        > > > > Everything is optional, so you can choose whatever you need.
                        > > > >
                        > > > > I would like to make it less Unix-oriented if possible (esp. for
                        > > > > non-blocking server, since it can run on almost any platform) and
                        > > > > drop 'our', so it'll work on 5.005 also. Everything else looks
                        > > >
                        > > > fine
                        > > >
                        > > > Is this the only change required for 5.005? I'll send you another
                        > > > version
                        > > > later tonight with this.
                        > > >
                        > > > > for me :). I'll try to come up with TCP non-blocking server next
                        > > >
                        > > > week
                        > > >
                        > > > > and accomodate those changes for HTTP-based server also.
                        > > > >
                        > > > > Best wishes, Paul.> #!/opt/ali-client/bin/perl -T -w
                        > > >
                        > > > ##
                        > > > ## soap.pl
                        > > > ##
                        > > >
                        > > > #Pragmas
                        > > > use strict;
                        > > >
                        > > > #Perl Modules
                        > > > use lib '/opt/ali/lib';
                        > > > use Fcntl;
                        > > > use Getopt::Long;
                        > > >
                        > > > #My Modules
                        > > > use ForkingSOAP;
                        > > > use ReadConfig;
                        > > > use Daemon;
                        > > >
                        > > > #Package Global Variables
                        > > >
                        > > > #Package Lexical Variables
                        > > > my ($nodaemon, $help, $kill, $status, $debug);
                        > > > my ($more_children, $less_children, $reload, $forcereload);
                        > > > my $daemon = "SoapServer";
                        > > >
                        > > > #Security stuff
                        > > > delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
                        > > > $ENV{PATH} = '/bin:/usr/bin';
                        > > >
                        > > > #Read Command Line
                        > > > GetOptions('nodaemon' => \$nodaemon,
                        > > > 'more_children' => \$more_children,
                        > > > 'less_children' => \$less_children,
                        > > > 'reload' => \$reload,
                        > > > 'forcereload' => \$forcereload,
                        > > > 'debug' => \$debug,
                        > > > 'kill+' => \$kill,
                        > > > 'status' => \$status,
                        > > > 'help' => \$help) or die "Exiting...\n";
                        > > >
                        > > > #Set output autoflush
                        > > > $| = 1;
                        > > >
                        > > > if( $kill ) {
                        > > > print "Killing... \n";
                        > > > # send SIGTERM
                        > > > Daemon::SendSignal( daemon => $daemon, signal => 15 );
                        > > > exit;
                        > > > }
                        > > >
                        > > > if( $more_children ) {
                        > > > print "Signaling... \n";
                        > > > # send SIGUSR1
                        > > > Daemon::SendSignal( daemon => $daemon, signal => 10 );
                        > > > exit;
                        > > > }
                        > > >
                        > > > if( $less_children ) {
                        > > > print "Signaling... \n";
                        > > > # send SIGUSR2
                        > > > Daemon::SendSignal( daemon => $daemon, signal => 12 );
                        > > > exit;
                        > > > }
                        > > >
                        > > > if( $reload ) {
                        > > > print "Signaling... \n";
                        > > > # send SIGHUP
                        > > > Daemon::SendSignal( daemon => $daemon, signal => 2 );
                        > > > exit;
                        > > > }
                        > > >
                        > > > if( $forcereload ) {
                        > > > print "Signaling... \n";
                        > > > # send SIGINT
                        > > > Daemon::SendSignal( daemon => $daemon, signal => 1 );
                        > > > exit;
                        > > > }
                        > > >
                        > > > if( $status ) {
                        > > > my $retval = Daemon::PrintStatus( daemon => $daemon );
                        > > > #shell uses opposite truth
                        > > > exit ! $retval;
                        > > > }
                        > > >
                        > > > if( ! $nodaemon ){
                        > > > Daemon::Daemonize( daemon => $daemon, debug => $debug );
                        > > > }
                        > > >
                        > > > my $pidstat = Daemon::WritePID( daemon => $daemon, $debug =>
                        > > > $debug );
                        > > > if( ! $pidstat ){
                        > > > #WritePID will write out an error msg for us.
                        > > > exit 1;
                        > > > }
                        > > >
                        > > > #Set Signal Handlers
                        > > > $SIG{PIPE} = 'IGNORE';
                        > > > $SIG{TERM} = sub { Daemon::UnlinkPIDFile( daemon => $daemon );
                        > > > exit 0; };
                        > > >
                        > > > #Initialize Daemon code.
                        > > > my $httpdaemon = SOAP::Transport::HTTP::Daemon::ForkingSOAP
                        > > > -> new (LocalPort => 1080, Reuse => 1)
                        > > > -> dispatch_to('GenericDB2');
                        > > >
                        > > > print "Contact to SOAP server at ", $httpdaemon->url, "\n";
                        > > >
                        > > > #Get # of threads to use...
                        > > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxChildren
                        > > > = 4;
                        > > > #= (GenericDB2->Fetch( '/ali/_DB/soap_MaxChildren' ) || 8);
                        > > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::MaxRequestsPerChild
                        > > > = 10;
                        > > > #= (GenericDB2->Fetch( '/ali/_DB/soap_MaxRequestsPerChild' ) ||
                        > > > 50);
                        > > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DynamicModuleList
                        > > > = ("GenericDB2");
                        > > > $SOAP::Transport::HTTP::Daemon::ForkingSOAP::DEBUG = $debug;
                        > > >
                        > > > #This never returns...
                        > > > $httpdaemon->handle;
                        > > >
                        > > > #But if it does, we end up here :-)
                        > > > Daemon::UnlinkPIDFile( daemon => $daemon );
                        > > > exit 0;
                        > > >
                        > > > > package SOAP::Transport::HTTP::Daemon::ForkingSOAP;
                        > > >
                        > > > #use strict;
                        > > > use vars qw(@ISA);
                        > > > use SOAP::Transport::HTTP;
                        > > > use POSIX ":sys_wait_h";
                        > > >
                        > > > # Implementation and Idea by Michael Brown and Christopher Stanton
                        > > > # Inspired by Peter Fraenkel (Peter.Fraenkel@...) and
                        > > > # his ForkAfterProcessing module.
                        > > >
                        > > > @ISA = qw(SOAP::Transport::HTTP::Daemon);
                        > > >
                        > > > #Package Globals (PUBLIC)
                        > > > our $DynamicModuleList = ();
                        > > > our $MaxChildren = 16;
                        > > > our $MaxRequestsPerChild = 50;
                        > > > our $DEBUG = 0;
                        > > > our $ChildCountFile;
                        > > >
                        > > > #Package Globals (PRIVATE)
                        > > > our %children;
                        > > > my $die;
                        > > > my $exitsoon;
                        > > >
                        > > > #Functions...
                        > > > sub handle {
                        > > > my $self = shift->new;
                        > > > my $parentpid = $$;
                        > > > my $oldchildcount = $MaxChildren;
                        > > >
                        > > > $SIG{TERM} = sub { foreach (keys %children){ kill(15, $_) };
                        > > > $die++ };
                        > > > $SIG{HUP} = sub { foreach (keys %children){ kill(15, $_) };
                        > > > return 1};
                        > > > $SIG{INT} = sub { foreach (keys %children){ kill(2, $_) }; return
                        > > > 1};
                        > > > $SIG{USR1} = sub { $MaxChildren++; };
                        > > > $SIG{USR2} = sub { $MaxChildren--; };
                        > > > $SIG{CHLD} = 'DEFAULT';
                        > > >
                        > > > while( ! $die ) {
                        > > > if( $ChildCountFile && ($oldchildcount != $MaxChildren)){
                        > > > print "Output new MaxChildren to $ChildCountFile\n" if $DEBUG;
                        > > > open CHILDCOUNT, "> $ChildCountFile" or next;
                        > > > print CHILDCOUNT $MaxChildren;
                        > > > close CHILDCOUNT;
                        > > > }
                        > > >
                        > > > if( scalar(keys %children) < $MaxChildren ) {
                        > > > my $childpid;
                        > > > if( $childpid = fork ) { # parent
                        > > > $children{ $childpid } = 1;
                        > > > print " child created: $childpid\n" if $DEBUG;
                        > > > } else { #child
                        > > > $SIG{TERM} = sub {exit};
                        > > > $SIG{INT} = sub {$exitsoon++; return 1};
                        > > > foreach my $module (@DynamicModuleList){
                        > > > eval "require $module";
                        > > > print $@ if $@;
                        > > > }
                        > > > my $counter = 1;
                        > > > while (my $c = $self->accept) {
                        > > > while (my $r = $c->get_request) {
                        > > > $self->request($r);
                        > > > $self->SOAP::Transport::HTTP::Server::handle;
                        > > > $c->send_response($self->response)
                        > > > }
                        > > > $c->close;
                        > > > undef $c;
                        > > > print " Child handled request # $counter\n" if $DEBUG;
                        > > > exit if $exitsoon;
                        > > > exit if ++$counter > $MaxRequestsPerChild;
                        > > > exit if ! kill(0, $parentpid);
                        > > > }
                        > > > exit;
                        > > > }
                        > > > }
                        > > >
                        > > > $kid = waitpid(-1,&WNOHANG);
                        > > > delete $children{$kid} if ($kid > 0);
                        > > > print "Reaped child: $kid\n" if (($kid > 0) && $DEBUG);
                        > > > sleep 1;
                        > > > }
                        > > > }
                        > > >
                        > > > 1;
                        > > >
                        > > > > ##
                        > > >
                        > > > ## Daemon.pm
                        > > > ##
                        > > >
                        > > > package Daemon;
                        > > >
                        > > > #Pragmas
                        > > > use strict;
                        > > >
                        > > > #Perl Modules
                        > > > use Carp;
                        > > > use Fcntl;
                        > > >
                        > > > #My Modules
                        > > > use ReadConfig;
                        > > >
                        > > > #Package Lexical Variables
                        > > > my $mconfig = ReadConfig::ReadConfigPath( "ali.conf", "/etc");
                        > > > my $piddir = $mconfig->{alivar} . "/run/";
                        > > > my $logdir = $mconfig->{alivar} . "/log/";
                        > > >
                        > > > # param: daemon
                        > > > sub KillFileExists {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $killfile = "$piddir/kill-$daemon";
                        > > >
                        > > > return ( -e $killfile );
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub UnlinkKillFile {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $killfile = "$piddir/kill-$daemon";
                        > > >
                        > > > unlink $killfile;
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub UnlinkPIDFile {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $pidfile = "$piddir/$daemon.pid";
                        > > >
                        > > > unlink $pidfile or croak "unable to unlink $pidfile";
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub CreateKillFile {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $killfile = "$piddir/kill-$daemon";
                        > > >
                        > > > open MYOUTFILE, "> $killfile";
                        > > > close MYOUTFILE;
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub SafeKill {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > > CreateKillFile( daemon => $daemon );
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub SendSignal {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > > my $signal = $param->{signal};
                        > > >
                        > > > my $pidfile = "$daemon.pid";
                        > > >
                        > > > open INPUT, "<", ($piddir . $pidfile) or return undef;
                        > > > my $pid = <INPUT>;
                        > > > close INPUT;
                        > > > $pid =~ m/(\d+)/;
                        > > > $pid = $1;
                        > > > kill( $signal, $pid );
                        > > > }
                        > > >
                        > > > sub ProcessStatus {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $pidfile = "$daemon.pid";
                        > > >
                        > > > my $retval = undef;
                        > > > open INPUT, "<", ($piddir . $pidfile) or goto out1;
                        > > > my $pid = <INPUT>;
                        > > > close INPUT;
                        > > >
                        > > > $retval = 0;
                        > > > $pid =~ m/(\d+)/;
                        > > > $pid = $1;
                        > > > chomp($pid);
                        > > > if( kill(0, $pid) ){
                        > > > $retval = 1;
                        > > > }
                        > > >
                        > > > out1:
                        > > > $retval = 0 if ! -e ($piddir . $pidfile);
                        > > > return $retval;
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub PrintStatus {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $status = ProcessStatus( $param );
                        > > >
                        > > > my $printval;
                        > > > if( ! defined($status) ){
                        > > > $printval = "ERROR: Unable to open pid file.";
                        > > > } elsif ( $status ) {
                        > > > $printval = "RUNNING";
                        > > > } else {
                        > > > $printval = "STOPPED";
                        > > > }
                        > > >
                        > > > print $printval . "\n";
                        > > > return $status;
                        > > > }
                        > > >
                        > > > # param: debug, daemon
                        > > > sub Daemonize {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $debug = $param->{debug};
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $outfile;
                        > > > if( $debug ) {
                        > > > $outfile = "$logdir/$daemon";
                        > > > if( ! -e $logdir ){
                        > > > system("mkdir -p $logdir");
                        > > > }
                        > > > } else {
                        > > > $outfile = '/dev/null';
                        > > > }
                        > > >
                        > > > #print "outfile: $outfile\n";
                        > > >
                        > > > close STDIN;
                        > > > open STDIN, "< /dev/null";
                        > > > close STDOUT;
                        > > > open STDOUT, "> $outfile";
                        > > > close STDERR;
                        > > > open STDERR, "> $outfile";
                        > > >
                        > > > fork and exit;
                        > > > }
                        > > >
                        > > > # param: daemon
                        > > > sub WritePID {
                        > > > my $param = _build_param_ref( @_ );
                        > > > my $daemon = $param->{daemon};
                        > > >
                        > > > my $pidfile = "$daemon.pid";
                        > > >
                        > > > my $retval = 0;
                        > > >
                        > > > retry:
                        > > > system("mkdir -p $piddir");
                        > > > if( sysopen( OUTPUT, ($piddir . $pidfile), O_CREAT | O_EXCL |
                        > > > O_WRONLY | O_TRUNC ) ) {
                        > > > print OUTPUT $$;
                        > > > close OUTPUT;
                        > > > $retval = 1;
                        > > > } else {
                        > > > my $status = ProcessStatus( $param );
                        > > >
                        > > > lock_out:
                        > > > if( ! defined($status) ) {
                        > > > print "I can't open the PID file: $piddir$pidfile";
                        > > > $retval = undef;
                        > > > } elsif ( $status ) {
                        > > > print "It appears that another copy of $daemon is running.";
                        > > > $retval = 0;
                        > > > } else {
                        > > > unlink ($piddir . $pidfile) or die "cannot remove
                        > > > $piddir/$pidfile\n";
                        > > > goto retry;
                        > > > }
                        > > > }
                        > > > return $retval;
                        > > > }
                        > > >
                        > > > sub _build_param_ref {
                        > > > my $nextarg = shift;
                        > > > my $param_ref;
                        > > > no warnings;
                        > > > if( ref($nextarg) ) {
                        > > > $param_ref = $nextarg;
                        > > > } elsif (defined($nextarg) && @_) {
                        > > > $param_ref = { $nextarg, @_ };
                        > > > } elsif (defined($nextarg) ) {
                        > >
                        > > === message truncated ===
                        > >
                        > >
                        > > __________________________________________________
                        > > Do You Yahoo!?
                        > > Spot the hottest trends in music, movies, and more.
                        > > http://buzz.yahoo.com/
                        > >
                        > > To unsubscribe from this group, send an email to:
                        > > soaplite-unsubscribe@yahoogroups.com
                        > >
                        > >
                        > >
                        > > Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/
                        >
                        > To unsubscribe from this group, send an email to:
                        > soaplite-unsubscribe@yahoogroups.com
                        >
                        >
                        >
                        > Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/

                        ----------------------------------------
                        Content-Type: text/plain; charset="iso-8859-1"; name="soap.pl"
                        Content-Transfer-Encoding: base64
                        Content-Description:
                        ----------------------------------------

                        ----------------------------------------
                        Content-Type: text/plain; charset="iso-8859-1"; name="ForkingSOAP.pm"
                        Content-Transfer-Encoding: base64
                        Content-Description:
                        ----------------------------------------

                        ----------------------------------------
                        Content-Type: text/plain; charset="iso-8859-1"; name="Daemon.pm"
                        Content-Transfer-Encoding: base64
                        Content-Description:
                        ----------------------------------------
                      Your message has been successfully submitted and would be delivered to recipients shortly.