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

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

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