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

Re: Fwd: Process-Pool Forking SOAP Server.

Expand Messages
  • Paul Kulchenko
    Hi, All! Here is the Forking server from Michael Brown. Now in my collection (unpublished means not included with SOAP::Lite yet): ForkAfterProcessing
    Message 1 of 12 , Jun 15, 2001
    • 0 Attachment
      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/
    • Garrett Goebel
      Paul, From: Paul Kulchenko [mailto:paulclinger@yahoo.com] ... yes? ... yes? Might even be nice to have them review each others modules... ... This poor
      Message 2 of 12 , Jun 15, 2001
      • 0 Attachment
        RE: [soaplite] Re: Fwd: Process-Pool Forking SOAP Server.

        Paul,

        From: Paul Kulchenko [mailto:paulclinger@...]
        >
        > 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?

        yes?


        > Should someone more experienced with TCP processing do it?

        yes?

        Might even be nice to have them review each others modules...


        > Include them all?

        This poor undereducated perl coder's probably unfounded worry is that each one will expose a different interface, and have code that might be better shared. All of which is fine to start so long as it is eventually remedied.

      • 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 3 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 4 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 5 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 6 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 7 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 8 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 9 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 10 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 11 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 12 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.