If *nix, look at help for the open3 function. Attached as a text file is
the little run class that I use to do this. Here is an example of how to use this class to encapsulate GPG, where the passphrase gets written to stdin of the child process, and the results are reaped from the childs stderr and the decrypted contents from the childs stdin. my $in = $ARGV[0]; # filename my @cmds = ( '/usr/bin/gpg', '--decrypt', '--batch', '--passphrase-fd', '0', $in, ); # ======================================================= # SECURITY SENSITIVE. # ======================================================= # This array gets written to STDIN of the spawned process # Dont forget to include newlines! my @secrets = ( "gpgpasswordgoeshere\n", ); # ======================================================= my $run = new psRun; $run->run( die => 0, warn => 0, command => \@cmds, stdin => \@secrets ); my @results = (@{$run->{stderr}}); my @decrypted = (@{$run->{stdout}}); Regards Jeff > -----Original Message----- > From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]] > Sent: 25 September 2002 13:52 > To: [EMAIL PROTECTED] > Subject: Programming pipes to and from another program > > > Hi there, > > I hope this is a trivial newbie problem: > > I know how to open a pipe to another program: > open (OUT, "|perl .\\bogus.pl") or warn "Unable to open pipe to > bogus.pl\n"; > print OUT "Stuff\n"; > > And I know how to open a pipe from another program: > open (IN, "perl .\\bogus.pl|") or warn "Unable to open pipe from > bogus.pl\n"; > $input = <IN>; > > But when I try to do both... > open (OUT, "|perl .\\bogus.pl") or warn "Unable to open pipe to > bogus.pl\n"; > open (IN, "perl .\\bogus.pl|") or warn "Unable to open pipe from > bogus.pl\n"; > or > open (BOGUS, "|perl .\\bogus.pl|") or warn "Unable to > open pipe for > bogus.pl\n"; > > ....strange things happen. > > Is there a simple (or even complex) way to open a two way > pipe to another > program with Perl. (I don't want to use Expect or any other scripting > language if I can help it). > I'm trying to implement batch code for automating processes > over night. > Some of these require a dialog. > > TIA > Peter > > > ****** CONFIDENTIALITY NOTICE ****** > THIS E-MAIL, INCLUDING ANY ATTACHED FILES, MAY CONTAIN > CONFIDENTIAL AND > PRIVILEGED INFORMATION FOR THE SOLE USE OF THE INTENDED RECIPIENT(S). > ANY REVIEW, USE, DISTRIBUTION, OR DISCLOSURE BY OTHERS IS STRICTLY > PROHIBITED. IF YOU ARE NOT THE INTENDED RECIPIENT (OR AUTHORIZED TO > RECEIVE INFORMATION FOR THE RECIPIENT), PLEASE CONTACT THE SENDER BY > REPLY E-MAIL AND REMOVE ALL COPIES OF THIS MESSAGE. THANK YOU. > > > > > -- > To unsubscribe, e-mail: [EMAIL PROTECTED] > For additional commands, e-mail: [EMAIL PROTECTED] > >
#!/usr/bin/perl -w # ============================================================================== # psRun: Run a system command - run John run! # Use this class to run system commands # It provides access to the command's STDIN(write), STDOUT and STDERR (read) # and records exit code and signal # # No warranty or support # # Example usage: # my $run = psRun->new(); # $run->run( command => @cmd, stdin => @inputs ); # print "'@{$run->{command}}' resulted in: exit=>$run->{exit} signal=>$run->{signal}"; # print "'@{$run->{command}}' printed the following on STDERR:\n",join("\nSTDERR: ",@{$run->{stderr}},"\\n\n"; # print "'@{$run->{command}}' printed the following on STDOUT:\n",join("\nSTDOUT: ",@{$run->{stdout}},"\\n\n"; # # Other notes # new( die => 0,...) don't die of non-zero exit codes/signals by default # new( stdin => @inputs,... ) these inputs are written to all run calls by default # # run( die => 0,...) don't die of non-zero exit codes, this run only # new( stdin => @inputs,... ) these inputs for this run only, [overrides any default] # # ============================================================================== # Source Control # $Revision: 1.8 $ # $Date: 2002/05/21 11:02:12 $ # $RCSfile: psRun.pm,v $ # ============================================================================== package psRun; use strict; use English; use FileHandle; use IPC::Open3; use POSIX; use psUtils; use overload ('""' => \&toString); LogGeneral('$RCSfile: psRun.pm,v $ $Revision: 1.8 $ $Date: 2002/05/21 11:02:12 $'); 1; #------------------------------------------------------------------------------- # psRun->new() # psRun constructor sub new { my $ref = shift; my $class = ref($ref) || $ref; my $self = { defaultdie => 1, # By default we die on non-zero exit/signal defaultwarn => 1, # By default we warn if we dont die! defaultin => [], # array of items to write to child process command => [], # array of commands - note we DON'T use the shell exit => undef, # exit value of child process signal => undef, # exit signal of child process stdin => [], # child processes STDIN stdout => [], # child processes STDOUT stderr => [] # child processes STDERR }; bless $self, $class; $self->_initialise(@_); return $self; } #------------------------------------------------------------------------------- # psRun->_initialise # internal method to initialise new instance. Called by new() sub _initialise { my $self = shift; my %params = @_; $self->{command} = $params{command}; $self->{stdin} = $params{stdin}; } #------------------------------------------------------------------------------- # psRun->toString # Return a description of the last command sub toString { my $self = shift; my $descr = "psRun["; $descr .= "@{$self->{command}}" if defined $self->{command} and scalar(@{$self->{command}}); $descr .= "]"; return $descr; } #------------------------------------------------------------------------------- # psRun->DESTROY # Nothing really for this method to do sub DESTROY { my $self = shift; } #------------------------------------------------------------------------------- # psRun->run() # This is where it happens! sub run { my $self = shift; my %param = @_; $self->{die} = $self->{defaultdie}; $self->{warn} = $self->{defaultwarn}; $self->{exit} = undef; $self->{signal} = undef; $self->{stdin} = [@{$self->{defaultin}}]; $self->{stdout} = []; $self->{stderr} = []; LogFatal "No command specified (command => [...])" unless exists $param{command} and scalar(@{$param{command}}); $self->{command} = $param{command}; # Die on non-zero exit value or signal $self->{die} = $param{die} if exists $param{die}; # overrides default $self->{warn} = $param{warn} if exists $param{warn}; # overrides default # write to STDIN $self->{stdin} = $param{stdin} if exists $param{stdin}; # this run override! # Private to this method sub _read { my ($fh, $prepend) = @_; # my $BUFSIZE = (stat $fh)[11]; # returns 5120 (see syswrite in Camel book) my $BUFSIZE = 5120; # hardcoded to avoid doing stat each time round my ($total_bytes, $bytes, $line, $buffer) = (0, $BUFSIZE, "", ""); # sysread() is non-blocking. <> operator doesn't work unless all buffers # can be guaranteed to end with a line terminator. while ($bytes == $BUFSIZE ) { $line = ''; $total_bytes += ($bytes = sysread($fh, $line, $BUFSIZE )); if ( $bytes ) { $buffer .= $line; } } #print "read: '$buffer'\n"; return ($total_bytes, $buffer); } # ---------------------------------------------------------------------------- # This section is required by Perls taint checking, which occurs when # $EUID and $UID are not the same: ie setup scripts! # NOTE THAT IT DEFEATS THE DEVELOPMENT PATHS if ( $UID != $EUID ) { delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; $ENV{PATH} = join(":", qw( /usr/local/pirum/bin /usr/local/bin /usr/bin /bin /usr/local/sbin /usr/sbin /sbin )); } # ---------------------------------------------------------------------------- my $childSTDIN = FileHandle->new; my $childSTDOUT = FileHandle->new; my $childSTDERR = FileHandle->new; # This runs the process, hooking us up to its FHs LogDebug("About to run '@{$self->{command}}'"); my $childPID = open3($childSTDIN, $childSTDOUT, $childSTDERR, @{$self->{command}}) or LogFatal("Can't fork ($OS_ERROR)"); ##main::dumpValue(\$self); # Write stuff to stdin (eg GPG secret passphrase!) foreach my $in (@{$self->{stdin}}) { syswrite($childSTDIN, $in); } # Watch that child's pipes! noisy things those drums! my ($readHandles, $writeHandles, $errorHandles) = ("","",""); # non-blocking select timeouts (seconds). Arbitary my $timeout = 60; my ($line, $bytes, $total_bytes); # Accumulate the childs output for later analysis my $out=''; my $err=''; my $childLives = 1; my $childActivity = 0; while ($childLives) { # We use select to implement efficient non-blocking reads of multiple filehandles # select() lets us know when any of the handles has data ready, or has reached EOF [closed] # select returns: # -1 on error # 0 on timeout # >0 when fh[s] have some form of activity # # $readHandles & $errorHandles are arrays of single bits representing file handles by offset # We monitor STDOUT and STDERR for data ready to read, or error # Note that select() will change these to indicate which had an event vec($readHandles, fileno($childSTDOUT), 1) = 1; vec($readHandles, fileno($childSTDERR), 1) = 1; $errorHandles = $readHandles; $childActivity = select($readHandles, undef, $errorHandles, 60); next if $childActivity == 0; # No file handles ready - timed out # There has been some child activity: # 1) Data to read on one or more handles # 2) One or more handles has been closed # 3) Out-of-Bounds data error on on or more handles # We use this to detect the situation where both fhs have now reached # eof. This does not appear to be considered an error. # sysreads reads zero bytes and returns immediately when fh is at EOF $total_bytes = 0; my $lines_read = 0; if (vec($readHandles, fileno($childSTDOUT), 1)) { my ($bytes, $buffer) = _read( $childSTDOUT, "stdin"); $out .= $buffer if $bytes; $total_bytes += $bytes; } if (vec($readHandles, fileno( $childSTDERR),1)) { my ( $bytes, $buffer) = _read( $childSTDERR, "stdin"); $err .= $buffer if $bytes; $total_bytes += $bytes; } if ( $total_bytes == 0 ) { # All file handles are at EOF # Indicates that the child process has tidily closed them! $childLives = 0; #print "CHILD STDIN/STDOUT have both been closed\n"; } else { # print "read $total_bytes bytes this loop\n"; } ################################################################ # $errorHandles bits are set by select # These two if statements indicate # exactly which filehandle[s] had an out-of-band data exception # Normally indocates that application has terminated - no logging needed if (vec($errorHandles, fileno( $childSTDOUT ), 1)) { LogError "CHILD STDOUT had an out-of-band data exception\n"; $childLives = 0; } if (vec($errorHandles, fileno( $childSTDERR),1)) { LogError "CHILD STDERR had an out-of-band data exception\n"; $childLives = 0; } # The two previous tests indicate exactly which file handle had the error # This statement terminates the loop last if $childActivity < 0; # Out-of-band data exception! } # Note that we eliminate PC style new-lines, # AND the new-line spaces new-line sequence seen in Barcap NY Loanet report! # Note that we did try the safer \r\n|\n\r -> \n but Loanet reports are ^M buggy! $out =~ s/\r *\r|\r//g; # eliminate PC style new-lines only from STD-ERR $err =~ s/\r//g; # We wait to ensure that the child process exit status is in $? wait; ($self->{exit}, $self->{signal}) = (($? >> 8), ($? & 255)); push @{$self->{stdout}}, split(/\n/g, $out); push @{$self->{stderr}}, split(/\n/g, $err); if ( $self->{die} and ($self->{exit} or $self->{signal})) { LogFatal "Command exited with non-zero exit or signal:\n", " command: '@{$self->{command}}'\n", " exit: $self->{exit}\n", " signal: $self->{signal}\n", " error: $err\n"; } if ( $self->{warn} and ($self->{exit} or $self->{signal})) { LogWarning "Command exited with non-zero exit or signal:\n", " command: '@{$self->{command}}'\n", " exit: $self->{exit}\n", " signal: $self->{signal}\n", " error: $err\n"; } } __END__ # ============================================================================== # Test code - just comment out the __END__ above my @cmds = ( '/usr/bin/gpg', '--decrypt', '--batch', '--passphrase-fd', '0', 't1.txt.gpg', ); # This array gets written to STDIN of the spawned process # Dont forget to include newlines! my @secrets = ( "2dogman\n", ); my $run = new psRun; $run->run( command => \@cmds, stdin => \@secrets ); LogGeneral "Dump of \$run :"; main::dumpValue(\$run); $run->run( command => ['/bin/ls','-l'], ); LogGeneral "Dump of \$run :"; main::dumpValue(\$run); __END__ # ============================================================================== # $Log: psRun.pm,v $ # Revision 1.8 2002/05/21 11:02:12 armstrj # fixes for parseReport loanet reports # # Revision 1.7 2001/11/23 15:40:56 armstrj # checkLinks - first test version # # Revision 1.6 2001/06/26 11:38:40 perryr # Added an extra LogDebug # # Revision 1.5 2001/06/22 12:51:06 armstrj # Added Quiet logging # # Revision 1.4 2001/06/22 12:36:17 perryr # Added standard error to output # # Revision 1.3 2001/06/08 12:53:18 armstrj # working version # # Revision 1.2 2001/05/28 17:14:28 armstrj # initial working verison of loadItemFile.pl # # Revision 1.1 2001/05/28 12:55:06 armstrj # Initial version # #===============================================================================
-- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]