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

Re: [soaplite] Re: Fwd: Process-Pool Forking SOAP Server.

Expand Messages
  • 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 1 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 2 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 3 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 4 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 5 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 6 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 7 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 8 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.