3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
6 # Stem is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # Stem is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with Stem; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 # For a license to use the Stem under conditions other than those
21 # described here, to purchase support for this software, or to purchase a
22 # commercial warranty contract, please contact Stem Systems at:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
31 use Carp qw( cluck ) ;
35 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
36 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
41 use POSIX qw( :sys_wait_h ) ;
42 use constant EXEC_ERROR => 199 ;
44 use Stem::Route qw( :cell ) ;
46 use base 'Stem::Cell' ;
50 my $child_event = Stem::Event::Signal->new(
51 'object' => bless({}),
55 ref $child_event or return
56 "Stem::Proc can't create SIG_CHLD handler: $child_event\n" ;
62 # if you pass in an optional object, then that will be the base for
63 # all the callback methods. the message and log options will not be
64 # done as they work only using the callbacks internal to Stem::Proc.
70 This is the name under which this Cell was registered.
77 This is the owner object for this Cell and it will get the callbacks.
84 This is the path to the program to run.
88 'name' => 'proc_args',
92 This is a list of the arguments to the program to be run.
96 'name' => 'spawn_now',
99 This flag means to spawn the process at constructor time. Default is to
100 spawn it when triggered via a message.
107 This flag means the process will do no standard I/O and those pipes will
115 This flag means the Cell will not read from the process and that pipe
116 will not be created. (unsupported)
120 'name' => 'no_write',
123 This flag means the Cell will not write to the process and that pipe
124 will not be created. (unsupported)
128 'name' => 'use_stderr',
131 This flag means the Cell will read from the stderr handle of the process.
132 By default the stderr pipe is not created and its output comes in on stdout.
140 This flag will cause the process to be run behind a pseudo-tty device.
144 'name' => 'exited_method',
145 'default' => 'proc_ended',
147 This method is called on the owner object when the process exits.
151 'name' => 'cell_attr',
152 'class' => 'Stem::Cell',
154 This value is the attributes for the included Stem::Cell which handles
155 cloning, async I/O and pipes.
163 my( $class ) = shift ;
165 my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
166 return $self unless ref $self ;
169 my $err = $self->find_exec_path() ;
170 return $err if $err ;
172 $self->{ 'use_stderr' } = 0 if $self->{ 'use_pty' } ;
174 $err = $self->cell_set_args(
175 'path' => $self->{'path'},
176 'proc_args' => $self->{'proc_args'},
179 return $err if $err ;
181 $self->cell_set_args( 'no_async' => 1 ) if $self->{ 'no_io' } ;
184 # cloneable and spawn_now should be mutually exclusive
187 if ( $self->{'spawn_now'} ) {
189 TraceStatus "New Spawn" ;
191 my $err = $self->cell_trigger();
192 return $err unless ref $err ;
194 $err = $self->spawn() ;
195 return $err if $err ;
204 my( $self ) = shift ;
206 my $proc_path = $self->{'path'} ;
208 return if -x $proc_path ;
210 foreach my $path ( File::Spec->path() ) {
212 my $exec_path = File::Spec->catfile( $path, $proc_path ) ;
214 next unless -f $exec_path ;
216 if ( -x $exec_path ) {
218 $self->{'path'} = $exec_path ;
223 return "$self->{'path'} is not found in $ENV{PATH}" ;
230 my $err = $self->spawn() ;
231 return $err if $err ;
234 #print Dumper \%INC ;
236 #print $self->status_cmd() ;
246 unless( $self->{'no_io'} ) {
248 $self->_parent_io() ;
251 $self->{'ppid'} = $$ ;
253 my @exec_args = @{$self->{'proc_args'}} ;
255 if ( my $pipe_args_ref = $self->cell_get_args( 'args' ) ) {
257 push( @exec_args, (ref $pipe_args_ref) ?
258 @{$pipe_args_ref} : $pipe_args_ref ) ;
262 defined $pid or die "Stem::Proc can't fork $!" ;
268 # must close the child fh in the parent so we will see a closed socket
269 # when the child exits
271 unless( $self->{'no_io'} ) {
273 close $self->{'child_fh'} ;
274 close $self->{'child_err_fh'} if $self->{'use_stderr'} ;
276 delete( $self->{'child_fh'} ) ;
277 delete( $self->{'child_err_fh'} ) ;
280 TraceStatus "forked $pid" ;
282 $self->{'pid'} = $pid ;
283 $pid_to_obj{ $pid } = $self ;
285 $self->cell_set_args( 'info' => <<INFO ) ;
287 Path: $self->{'path'}
298 unless( $self->{'no_io'} ) {
305 ## add support for setting local(%ENV)
309 #TraceStatus "Exec'ing $self->{'path'}, @exec_args" ;
311 exec $self->{'path'}, @exec_args ;
316 # back in parent (unless no exec -- FIX THAT!! unless path is
317 # required) we could do a forked stem hub by execing stem with a new
318 # config which has a portal with STDIN/STDOUT as fh's
320 my $err = $self->cell_set_args( 'aio_args' => [
321 'read_fh' => $self->{'parent_fh'},
322 'write_fh' => $self->{'parent_fh'},
323 'stderr_fh' => $self->{'parent_err_fh'},
324 'closed_method' => $self->{'exited_method'},
328 return $err if $err ;
330 $self->cell_worker_ready() ;
340 my( $parent_fh, $child_fh ) ;
343 if ( $self->{'use_pty'} ) {
346 $parent_fh = IO::Pty->new() ;
347 $child_fh = $parent_fh->slave() ;
351 $parent_fh = gensym ;
354 socketpair( $parent_fh, $child_fh,
355 AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ||
356 die "can't make socket pair $!" ;
359 bless $parent_fh, 'IO::Socket' ;
361 $self->{'parent_fh'} = $parent_fh ;
363 $parent_fh->blocking( 0 ) ;
365 $self->{'child_fh'} = $child_fh ;
368 # add pty support here
371 if ( $self->{'use_stderr'} ) {
373 my $parent_err_fh = gensym ;
374 my $child_err_fh = gensym ;
376 socketpair( $parent_err_fh, $child_err_fh,
377 AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ||
378 die "can't make socket pair $!" ;
380 $self->{'parent_err_fh'} = $parent_err_fh ;
381 $self->{'child_err_fh'} = $child_err_fh ;
389 close $self->{'parent_fh'} ;
390 close $self->{'parent_err_fh'} if $self->{'use_stderr'} ;
392 my $child_fd = fileno( $self->{'child_fh'} ) ;
394 open( \*STDIN, "<&$child_fd" ) ||
395 croak "dup open of STDIN failed $!" ;
397 open( \*STDOUT, ">&$child_fd" ) ||
398 croak "dup open of STDOUT failed $!" ;
400 if ( $self->{'use_stderr'} ) {
402 my $child_err_fd = fileno( $self->{'child_err_fh'} ) ;
404 open( \*STDERR, ">&$child_err_fd" ) ||
405 croak "dup open of STDERR failed $!" ;
409 open( \*STDERR, ">&$child_fd" ) ||
410 croak "dup open of STDERR failed $!" ;
416 my( $self, $data ) = @_ ;
418 $self->cell_write( $data ) ;
424 $_[0]->{'parent_fh'} ;
429 $_[0]->{'parent_fh'} ;
434 $_[0]->{'parent_err_fh'} ;
441 #print "PROC ended, shutting down\n" ;
448 my( $self, $msg ) = @_ ;
450 my $data = $msg->data() ;
452 return unless ref $data eq 'SCALAR' ;
454 my $signal = ${$data} ;
456 $self->signal( $signal ) ;
463 my( $self, $signal ) = @_ ;
465 $signal ||= 'SIGTERM' ;
467 TraceStatus "$self->{'pid'} received SIGTERM" ;
469 kill $signal, $self->{'pid'} ;
472 sub sig_chld_handler {
476 my $child_pid = waitpid( -1, WNOHANG ) ;
478 return if $child_pid == 0 || $child_pid == -1 ;
480 my $proc_status = $? ;
482 my ( $exit_code, $exit_signal ) ;
484 if ( WIFEXITED( $proc_status ) ) {
486 $exit_code = WEXITSTATUS( $proc_status ) ;
488 TraceStatus "EXIT: $exit_code" ;
492 $exit_signal = WTERMSIG( $proc_status ) ;
494 TraceStatus "EXIT signal: $exit_signal" ;
498 #print "EXIT CODE [$exit_code]\n" ;
500 if ( my $self = $pid_to_obj{ $child_pid } ) {
502 $self->{'exit_code'} = $exit_code ;
503 $self->{'exit_signal'} = $exit_signal ;
505 if ( defined( $exit_code ) &&
506 $exit_code == EXEC_ERROR ) {
509 Stem::Proc exec failed on path '$self->{'path'}'
518 print "reaped unknown process pid $child_pid\n"
528 ######################
529 # handle watchdog here
530 ######################
532 $self->{'exited'} = 1 ;
536 $self->shut_down() if $self->{'no_io'} ;
538 TraceStatus "Proc $self->{'pid'} exited" ;
546 #print "PROC SHUT\n" ;
548 unless( $self->{'exited'} ) {
550 kill 'SIGTERM', $self->{'pid'} ;
552 TraceStatus "kill of proc $self->{'pid'}" ;
555 return if $self->{'no_io'} ;
557 if ( my $pid = $self->{'pid'} ) {
559 delete( $pid_to_obj{ $pid } ) ;
562 $self->cell_shut_down() ;
564 close $self->{'parent_fh'} ;
565 close $self->{'parent_err_fh'} if $self->{'use_stderr'} ;