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

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

Expand Messages
  • Paul Kulchenko
    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/
    • Show all 12 messages in this topic