lib/Stem/Proc.pm

   1 #  File: Stem/Proc.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   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.
  10
  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.
  15
  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
  19
  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:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 package Stem::Proc ;
  30
  31 use Carp qw( cluck ) ;
  32
  33 use strict ;
  34
  35 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
  36 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
  37
  38 use IO::Socket ;
  39 use Symbol ;
  40 use Carp ;
  41 use POSIX qw( :sys_wait_h ) ;
  42 use constant EXEC_ERROR => 199 ;
  43
  44 use Stem::Route qw( :cell ) ;
  45
  46 use base 'Stem::Cell' ;
  47
  48 my %pid_to_obj ;
  49
  50 my $child_event = Stem::Event::Signal->new(
  51         'object' => bless({}),
  52         'signal' => 'CHLD'
  53 ) ;
  54
  55 ref $child_event or return
  56         "Stem::Proc can't create SIG_CHLD handler: $child_event\n" ;
  57
  58 my $attr_spec = [
  59
  60
  61 ###############
  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.
  65 ###############
  66
  67         {
  68                 'name'          => 'reg_name',
  69                 'help'          => <<HELP,
  70 This is the name under which this Cell was registered.
  71 HELP
  72         },
  73         {
  74                 'name'          => 'object',
  75                 'type'          => 'object',
  76                 'help'          => <<HELP,
  77 This is the owner object for this Cell and it will get the callbacks.
  78 HELP
  79         },
  80         {
  81                 'name'          => 'path',
  82                 'required'      => 1,
  83                 'help'          => <<HELP,
  84 This is the path to the program to run.
  85 HELP
  86         },
  87         {
  88                 'name'          => 'proc_args',
  89                 'default'       => [],
  90                 'type'          => 'list',
  91                 'help'          => <<HELP,
  92 This is a list of the arguments to the program to be run.
  93 HELP
  94         },
  95         {
  96                 'name'          => 'spawn_now',
  97                 'type'          => 'boolean',
  98                 'help'          => <<HELP,
  99 This flag means to spawn the process at constructor time. Default is to
 100 spawn it when triggered via a message.
 101 HELP
 102         },
 103         {
 104                 'name'          => 'no_io',
 105                 'type'          => 'boolean',
 106                 'help'          => <<HELP,
 107 This flag means the process will do no standard I/O and those pipes will
 108 not be created.
 109 HELP
 110         },
 111         {
 112                 'name'          => 'no_read',
 113                 'type'          => 'boolean',
 114                 'help'          => <<HELP,
 115 This flag means the Cell will not read from the process and that pipe
 116 will not be created. (unsupported)
 117 HELP
 118         },
 119         {
 120                 'name'          => 'no_write',
 121                 'type'          => 'boolean',
 122                 'help'          => <<HELP,
 123 This flag means the Cell will not write to the process and that pipe
 124 will not be created. (unsupported)
 125 HELP
 126         },
 127         {
 128                 'name'          => 'use_stderr',
 129                 'type'          => 'boolean',
 130                 'help'          => <<HELP,
 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.
 133 HELP
 134         },
 135
 136         {
 137                 'name'          => 'use_pty',
 138                 'type'          => 'boolean',
 139                 'help'          => <<HELP,
 140 This flag will cause the process to be run behind a pseudo-tty device.
 141 HELP
 142         },
 143         {
 144                 'name'          => 'exited_method',
 145                 'default'       => 'proc_ended',
 146                 'help'          => <<HELP,
 147 This method is called on the owner object when the process exits.
 148 HELP
 149         },
 150         {
 151                 'name'          => 'cell_attr',
 152                 'class'         => 'Stem::Cell',
 153                 'help'          => <<HELP,
 154 This value is the attributes for the included Stem::Cell which handles
 155 cloning, async I/O and pipes.
 156 HELP
 157         },
 158 ] ;
 159
 160
 161 sub new {
 162
 163         my( $class ) = shift ;
 164
 165         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
 166         return $self unless ref $self ;
 167
 168
 169         my $err = $self->find_exec_path() ;
 170         return $err if $err ;
 171
 172         $self->{ 'use_stderr' } = 0 if $self->{ 'use_pty' } ;
 173
 174         $err = $self->cell_set_args(
 175                         'path'          => $self->{'path'},
 176                         'proc_args'     => $self->{'proc_args'},
 177         ) ;
 178
 179         return $err if $err ;
 180
 181         $self->cell_set_args( 'no_async' => 1 ) if  $self->{ 'no_io' } ;
 182
 183 ###########
 184 # cloneable and spawn_now should be mutually exclusive
 185 ##########
 186
 187         if ( $self->{'spawn_now'} ) {
 188
 189 TraceStatus "New Spawn" ;
 190
 191                 my $err = $self->cell_trigger();
 192                 return $err unless ref $err ;
 193
 194                 $err = $self->spawn() ;
 195                 return $err if $err ;
 196         }
 197
 198         return $self ;
 199 }
 200
 201
 202 sub find_exec_path {
 203
 204         my( $self ) = shift ;
 205
 206         my $proc_path = $self->{'path'} ;
 207
 208         return if -x $proc_path ;
 209
 210         foreach my $path ( File::Spec->path() ) {
 211
 212                 my $exec_path = File::Spec->catfile( $path, $proc_path ) ;
 213
 214                 next unless -f $exec_path ;
 215
 216                 if ( -x $exec_path ) {
 217
 218                         $self->{'path'} = $exec_path ;
 219                         return ;
 220                 }
 221         }
 222
 223         return "$self->{'path'} is not found in $ENV{PATH}" ;
 224 }
 225
 226 sub triggered_cell {
 227
 228         my( $self ) = @_ ;
 229
 230         my $err = $self->spawn() ;
 231         return $err if $err ;
 232
 233 #use Data::Dumper ;
 234 #print Dumper \%INC ;
 235
 236 #print $self->status_cmd() ;
 237
 238         return ;
 239 }
 240
 241
 242 sub spawn {
 243
 244         my( $self ) = @_ ;
 245
 246         unless( $self->{'no_io'} ) {
 247
 248                 $self->_parent_io() ;
 249         }
 250
 251         $self->{'ppid'} = $$ ;
 252
 253         my @exec_args = @{$self->{'proc_args'}} ;
 254
 255         if ( my $pipe_args_ref = $self->cell_get_args( 'args' ) ) {
 256
 257                 push( @exec_args, (ref $pipe_args_ref) ?
 258                                 @{$pipe_args_ref} : $pipe_args_ref ) ;
 259         }
 260
 261         my $pid = fork() ;
 262         defined $pid or die "Stem::Proc can't fork $!" ;
 263
 264         if ( $pid ) {
 265
 266 # in parent
 267
 268 # must close the child fh in the parent so we will see a closed socket
 269 # when the child exits
 270
 271                 unless( $self->{'no_io'} ) {
 272
 273                         close $self->{'child_fh'} ;
 274                         close $self->{'child_err_fh'} if $self->{'use_stderr'} ;
 275
 276                         delete( $self->{'child_fh'} ) ;
 277                         delete( $self->{'child_err_fh'} ) ;
 278                 }
 279
 280                 TraceStatus "forked $pid" ;
 281
 282                 $self->{'pid'} = $pid ;
 283                 $pid_to_obj{ $pid } = $self ;
 284
 285                 $self->cell_set_args( 'info' => <<INFO ) ;
 286
 287 Path:   $self->{'path'}
 288 Args:   @exec_args
 289 Pid:    $pid
 290
 291 INFO
 292
 293
 294         }
 295         else {
 296
 297 # in child
 298                 unless( $self->{'no_io'} ) {
 299
 300                         $self->_child_io() ;
 301                 }
 302
 303 ###############
 304 ###############
 305 ## add support for setting local(%ENV)
 306 ###############
 307 ###############
 308
 309 #TraceStatus "Exec'ing $self->{'path'}, @exec_args" ;
 310
 311                 exec $self->{'path'}, @exec_args ;
 312
 313                 exit EXEC_ERROR ;
 314         }
 315
 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
 319
 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'},
 325                 ]
 326         ) ;
 327
 328         return $err if $err ;
 329
 330         $self->cell_worker_ready() ;
 331
 332         return ;
 333 }
 334
 335
 336 sub _parent_io {
 337
 338         my( $self ) = @_ ;
 339
 340         my( $parent_fh, $child_fh ) ;
 341
 342
 343         if ( $self->{'use_pty'} ) {
 344
 345                 require IO::Pty ;
 346                 $parent_fh = IO::Pty->new() ;
 347                 $child_fh = $parent_fh->slave() ;
 348         }
 349         else {
 350
 351                 $parent_fh = gensym ;
 352                 $child_fh = gensym ;
 353
 354                 socketpair( $parent_fh, $child_fh,
 355                                  AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ||
 356                                         die "can't make socket pair $!" ;
 357         }
 358
 359         bless $parent_fh, 'IO::Socket' ;
 360
 361         $self->{'parent_fh'} = $parent_fh ;
 362
 363         $parent_fh->blocking( 0 ) ;
 364
 365         $self->{'child_fh'} = $child_fh ;
 366
 367 #############
 368 # add pty support here
 369 #############
 370
 371         if ( $self->{'use_stderr'} ) {
 372
 373                 my $parent_err_fh = gensym ;
 374                 my $child_err_fh = gensym ;
 375
 376                 socketpair( $parent_err_fh, $child_err_fh,
 377                                  AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ||
 378                                 die "can't make socket pair $!" ;
 379
 380                 $self->{'parent_err_fh'} = $parent_err_fh ;
 381                 $self->{'child_err_fh'} = $child_err_fh ;
 382         }
 383 }
 384
 385 sub _child_io {
 386
 387         my( $self ) = @_ ;
 388
 389         close $self->{'parent_fh'} ;
 390         close $self->{'parent_err_fh'} if $self->{'use_stderr'} ;
 391
 392         my $child_fd = fileno( $self->{'child_fh'} ) ;
 393
 394         open( \*STDIN,  "<&$child_fd" ) ||
 395                                 croak "dup open of STDIN failed $!" ;
 396
 397         open( \*STDOUT, ">&$child_fd" ) ||
 398                                 croak "dup open of STDOUT failed $!" ;
 399
 400         if ( $self->{'use_stderr'} ) {
 401
 402                 my $child_err_fd = fileno( $self->{'child_err_fh'} ) ;
 403
 404                 open( \*STDERR,  ">&$child_err_fd" ) ||
 405                                 croak "dup open of STDERR failed $!" ;
 406
 407         }
 408         else {
 409                 open( \*STDERR,  ">&$child_fd" ) ||
 410                                 croak "dup open of STDERR failed $!" ;
 411         }
 412 }
 413
 414 sub write {
 415
 416         my( $self, $data ) = @_ ;
 417
 418         $self->cell_write( $data ) ;
 419 }
 420
 421
 422 sub read_fh {
 423
 424         $_[0]->{'parent_fh'} ;
 425 }
 426
 427 sub write_fh {
 428
 429         $_[0]->{'parent_fh'} ;
 430 }
 431
 432 sub stderr_fh {
 433
 434         $_[0]->{'parent_err_fh'} ;
 435 }
 436
 437 sub proc_ended {
 438
 439         my( $self ) = @_ ;
 440
 441 #print "PROC ended, shutting down\n" ;
 442
 443         $self->shut_down() ;
 444 }
 445
 446 sub signal_cmd {
 447
 448         my( $self, $msg ) = @_ ;
 449
 450         my $data = $msg->data() ;
 451
 452         return unless ref $data eq 'SCALAR' ;
 453
 454         my $signal = ${$data} ;
 455
 456         $self->signal( $signal ) ;
 457
 458         return ;
 459 }
 460
 461 sub signal {
 462
 463         my( $self, $signal ) = @_ ;
 464
 465         $signal ||= 'SIGTERM' ;
 466
 467         TraceStatus "$self->{'pid'} received SIGTERM" ;
 468
 469         kill $signal, $self->{'pid'} ;
 470 }
 471
 472 sub sig_chld_handler {
 473
 474         while ( 1 ) {
 475
 476                 my $child_pid = waitpid( -1, WNOHANG ) ;
 477
 478                 return if $child_pid == 0 || $child_pid == -1 ;
 479
 480                 my $proc_status = $? ;
 481
 482                 my ( $exit_code, $exit_signal ) ;
 483
 484                 if ( WIFEXITED( $proc_status ) ) {
 485
 486                         $exit_code = WEXITSTATUS( $proc_status ) ;
 487
 488                         TraceStatus "EXIT: $exit_code" ;
 489
 490                 }
 491                 else {
 492                         $exit_signal = WTERMSIG( $proc_status ) ;
 493
 494                         TraceStatus "EXIT signal: $exit_signal" ;
 495
 496                 }
 497
 498 #print "EXIT CODE [$exit_code]\n" ;
 499
 500                 if ( my $self = $pid_to_obj{ $child_pid } ) {
 501
 502                         $self->{'exit_code'} = $exit_code ;
 503                         $self->{'exit_signal'} = $exit_signal ;
 504
 505                         if ( defined( $exit_code ) &&
 506                              $exit_code == EXEC_ERROR ) {
 507
 508                                 print <<ERR ;
 509 Stem::Proc exec failed on path '$self->{'path'}'
 510 ERR
 511
 512                         }
 513
 514                         $self->exited() ;
 515                 }
 516                 else {
 517 #### ERROR
 518 print "reaped unknown process pid $child_pid\n"
 519                 }
 520
 521         }
 522 }
 523
 524 sub exited {
 525
 526         my( $self ) = @_ ;
 527
 528 ######################
 529 # handle watchdog here
 530 ######################
 531
 532         $self->{'exited'} = 1 ;
 533
 534 #print "EXITED\n" ;
 535
 536         $self->shut_down() if $self->{'no_io'} ;
 537
 538         TraceStatus "Proc $self->{'pid'} exited" ;
 539 }
 540
 541
 542 sub shut_down {
 543
 544         my( $self ) = @_ ;
 545
 546 #print "PROC SHUT\n" ;
 547
 548         unless( $self->{'exited'} ) {
 549
 550                 kill 'SIGTERM', $self->{'pid'} ;
 551
 552                 TraceStatus "kill of proc $self->{'pid'}" ;
 553         }
 554
 555         return if $self->{'no_io'} ;
 556
 557         if ( my $pid = $self->{'pid'} ) {
 558
 559                 delete( $pid_to_obj{ $pid } ) ;
 560         }
 561
 562         $self->cell_shut_down() ;
 563
 564         close $self->{'parent_fh'} ;
 565         close $self->{'parent_err_fh'} if $self->{'use_stderr'} ;
 566 }
 567
 568 1 ;