http://www.perlmonks.org?node_id=547251

tcf03 has asked for the wisdom of the Perl Monks concerning the following question:

I have the following code snippet:
use warnings; use strict; use IPC::Run qw( run timeout ); my @command = ('ls', '-la'); #print "cmd = @command\n"; my ( $buff ); my $exit = '0'; run \@command, \$buff, timeout(10) or $exit = 1; print "exit code = $exit\n";
And the exit code is always 1 - the command runs OK yet I cannot seem to get a valid return value. If I use '$?' to grab the return I get back '-1'. Any ideas?

update OK the previous code works fine when run as a stand alone script, If I run it in the original script I get very different results...

the test script:
#!/usr/bin/perl use warnings; use strict; use IPC::Run qw( run timeout ); my $return = ( suba("XYZ") == 0 ) ? "success" : "failure"; print "return = $return\n"; sub suba { my $job = shift; if ( $job =~ /^XYZ/ ) { my @return = subb(); my $exit = shift @return; print "exit = $exit\n"; print "$_\n" for @return; } } sub subb { my @command = ('ls', '-la'); my ( $buff, $in, $err ); my $exit; run \@command, \$in, \$buff, \$err, timeout(10) and $exit = $?; print "exit = $exit\n"; my @return; push (@return, $exit, $buff); print "$_\n" for @return; return @return; }

The Server script:
#!/usr/bin/perl #$Id: Meru-Server.pl,v 1.2 2006/05/03 13:26:33 tfiedler Exp $ use strict; use warnings; use IPC::Run qw( run timeout ); use IO::Socket::INET; use Crypt::CBC; use Carp; my $cipher = Crypt::CBC->new( -key => 'S3cr#tabcDeSal35', -cipher => ' +Blowfish' ); my $port = 62750; my $LOG; $SIG{CHLD} = 'IGNORE'; $SIG{INT} = 'IGNORE'; my $listener = IO::Socket::INET->new(LocalPort => $port, Listen => 10, Proto => 'tcp', Reuse => 1); confess "Error creating a listener on port 62570: $@\n" unless $listener; open $LOG, "+>>", "Log.txt" or carp "Unable to open Log.txt: $@\n"; print "[Listening on port $port]\n"; while ( my $connection = $listener->accept) { my $child; confess "Cannot fork a process: $!\n" unless defined ( $child = fork() ); if ( $child == 0 ) { $listener->close; $connection->print("\n"); $connection->print("connected\n"); my $receive; if ( defined( $connection->recv($receive, 100,0) ) ) { chomp($receive); my $command = $cipher->decrypt($receive); print "processing \"$receive\" => \"$command\"\n"; print $LOG scalar(localtime), " $$ received: $receive\n"; print $LOG scalar(localtime), " $$ decrypted: $command\n"; $connection->print("your command was received\n"); my $return = ( execute_command("$command") == 0 ) ? "succe +ss" : "failure"; print $LOG scalar(localtime), " $$ \"$command\" $return\n" +; $connection->print("Your command ended in $return\n"); $connection->print("Goodbye\n"); $connection->print("1970__"); } } else { print $LOG scalar(localtime), " $$ Connect from ", $connection +->peerhost, "\n"; print "Connection from ", $connection->peerhost, "\n"; $connection->close(); } } sub execute_command { my $line = shift; my @info = ( grep /\|/, $line ) ? split /\|/, $line : $line; #my @info = split /\|/, $line || $line; my $job = $info[0]; print $LOG scalar(localtime), " $$ job = $job info = @info\n"; my $return = 2; print "job = $job\n"; $return = ( ListKillProc(@info) == 0 ) ? 0 : 1 if ( $job =~ /^ListKillProc/ ); $return = ( unlockuser(@info) == 0 ) ? 0 : 1 if ( $job =~ /^unlockuser/ ); $return = ( changepass(@info) == 0 ) ? 0 : 1 if ( $job =~ /^changepass/ ); $return = ( showprintersall(@info) == 0 ) ? 0 : 1 if ( $job =~ /^showprintersall/ ); $return = ( showprintersuser(@info) == 0 ) ? 0 : 1 if ( $job =~ /^showprintersuser/ ); $return = ( showprinter(@info) == 0 ) ? 0 : 1 if ( $job =~ /^showprinter/ ); $return = ( killprint(@info) == 0 ) ? 0 : 1 if ( $job =~ /^killprint/ ); print "return before = $return\n"; if ( $job =~ /^APP/ ) { my @return = APP(); my $exit = shift @return; print "exit = $exit\n"; print @return; return $exit; } print $LOG scalar(localtime), " $$ execution return code = $return +\n"; return $return; } sub APP { my @command = ('ls', '-la'); print $LOG scalar(localtime), " $$ cmd = @command\n"; my ( $buff, $in, $err ); my $exit; run \@command, \$in, \$buff, \$err, timeout(10) and $exit = $?; print "exit = $exit\n"; print $LOG scalar(localtime), " $$ exit code =", $exit, "\n"; #print $out if $out; my @return; push (@return, $exit, $buff); print "$_\n" for @return; return @return; } sub AUTOLOAD { print "I dont know how to do $_[0]\n"; print $LOG scalar(localtime), " $$ Uh Oh we hit the Autoloader: no + match for $_[0]\n"; return 1; }

The client script
#!/usr/bin/perl #$Id: menu.pl,v 1.3 2006/05/03 13:27:47 tfiedler Exp $ use strict; use warnings; use IO::Socket::INET; use Crypt::CBC; my $cipher = Crypt::CBC->new( -key => 'S3cr#tabcDeSal35', -cipher => ' +Blowfish'); $SIG{INT} = 'IGNORE'; sub do_menu { my( $menu ) = @_; while(1) { my( $menu ) = @_; # display the menu print "\n"; print $_+1, '. ', $menu->[$_]{'label'}, "\n" for 0 .. $#{$menu}; print '0. ', ( @_ > 1 ? 'Return' : 'Exit' ), "\n"; # get the user's input local @ARGV; print STDERR '> '; local $_ = <>; chomp; /\d/ && !/\D/ or next; $_ == 0 and last; # item 0 is special defined $menu->[$_-1] or warn("Invalid choice\n"), next; my $op = $menu->[$_-1]{'op'}; my $arg = $menu->[$_-1]{'arg'}; if ( $op eq 'submenu' ) { do_menu( $arg, @_ ); # maintain the stack! } elsif ( $op eq 'exec_cmd' ) { execute_command( $arg ); } else { warn "Unrecognized op '$op'\n"; } } } my @printers_menu = ( { label => 'Show all Printers', op => 'exec_cmd', arg => 'showprintersall', }, { label => 'Show user print jobs', op => 'exec_cmd', arg => 'showprintersuser', }, { label => 'Show single printer', op => 'exec_cmd', arg => 'showprinter', }, { label => 'Kill a print job', op => 'exec_cmd', arg => 'killprint', }, ); my @accounts_menu = ( { label => 'Unlock user account', op => 'exec_cmd', arg => 'unlockuser', }, { label => 'Change account password', op => 'exec_cmd', arg => 'changepass', }, ); my @main_menu = ( { label => 'List and Kill UDT* processes by user', op => 'exec_cmd', arg => 'ListKillProc', }, { label => 'List and Kill Print Jobs...', op => 'submenu', arg => \@printers_menu, }, { label => 'Manage user accounts...', op => 'submenu', arg => \@accounts_menu, }, { label => 'Run App', op => 'exec_cmd', arg => 'APP', }, ); sub execute_command { warn "Executing command @_\n"; my $command = $_[0]; my @stack = &build_stack($command); my $STACK = join'|', @stack; my $cryptostack = $cipher->encrypt($STACK); if ($STACK =~ /^\d/) { print "Houston we have a problem... STACK = $STACK\n"; return 1; } my $return = ( send_stack($cryptostack) == 0 ) ? "successful" : "u +nsuccessful" ; print "transmission of data was $return\n"; } sub build_stack { my $command = @_; my @needed = (); my $set = \&set_item; my ( $username, $password, $password2, $jobid, $printer ); push (@needed, @_); return @needed if grep ( /^(APP|showprintersall)/, @_ ); if ( grep /^(showprintersuser|unlockuser|ListKillProc|changepass)/ +, @_ ) { $username = $set->('username'); push (@needed, $username); } if ( grep /^changepass/, @_ ) { $password = $set->('password'); $password2 = $set->('password2'); return 0 if ( $password ne $password2 ); push (@needed, $password); } if ( grep /^showprinter/, @_ ) { $printer = $set->('printer'); push (@needed, $printer); } if ( grep /^killprint/, @_ ) { $jobid = $set->('jobid'); push (@needed, $jobid); } return @needed; } sub set_item { print "Enter @_: "; my $item = <stdin>; chomp($item); return $item; } sub send_stack { my $send = shift; my $host = shift || "localhost"; my $port = shift || 62750; my $sock = IO::Socket::INET ->new( PeerAddr => $host, PeerPort => $port, Proto => 'tcp' ); $sock->print($send); my $rtrn = 1; while (my $receive = <$sock>) { if ($receive =~ /^1970__/) { $rtrn = 0; last; } chomp($receive); print "$receive\n"; } return $rtrn; } sub AUTOLOAD { print "Sorry, I dont know how to do @_"; return 1; } do_menu( \@main_menu );

The problem is that in the test script everything executes as I would expect it to. When I run the server code using the code from my test - I get the following output at the server console
[Listening on port 62750] processing "Salted__ ##&o#uw##" => "APP" job = APP return before = 2 Connection from 127.0.0.1 Use of uninitialized value in concatenation (.) or string at ./Menu-Se +rver.pl line 136. exit = Use of uninitialized value in print at ./Menu-Server.pl line 137. Use of uninitialized value in concatenation (.) or string at ./Menu-Se +rver.pl line 144. total 10976 drwxr-x--- 4 tfiedler tfiedler 4096 May 4 09:42 . drwxr-x--- 4 tfiedler tfiedler 4096 Apr 27 14:53 .. -rw-r----- 1 tfiedler tfiedler 11115686 May 3 10:02 cbkwanzaa.wmv -rwxr-x--- 1 tfiedler tfiedler 2659 May 1 16:29 client-test.pl -rwxr-x--- 1 tfiedler tfiedler 659 May 4 09:05 ipcruntest.pl -rw-r----- 1 tfiedler tfiedler 364 May 3 13:31 ipctest.pl -rw-r----- 1 tfiedler tfiedler 31945 May 4 09:43 Log.txt -rw-r----- 1 tfiedler tfiedler 16384 May 4 09:29 .Log.txt.swp -rwxr-x--- 1 tfiedler tfiedler 3982 May 3 13:12 menu.pl -rwxr-x--- 1 tfiedler tfiedler 3993 May 4 09:41 Menu-Server.pl drwxr-x--- 2 tfiedler tfiedler 4096 May 1 08:09 ms1help -rw-r----- 1 tfiedler tfiedler 14544 Apr 27 14:51 perlscript.zip drwxr-x--- 2 tfiedler tfiedler 4096 May 3 09:28 RCS -rwxr-x--- 1 tfiedler tfiedler 1775 May 2 13:56 server-test.pl Use of uninitialized value in concatenation (.) or string at ./Menu-Se +rver.pl line 116. exit = total 10976 drwxr-x--- 4 tfiedler tfiedler 4096 May 4 09:42 . drwxr-x--- 4 tfiedler tfiedler 4096 Apr 27 14:53 .. -rw-r----- 1 tfiedler tfiedler 11115686 May 3 10:02 cbkwanzaa.wmv -rwxr-x--- 1 tfiedler tfiedler 2659 May 1 16:29 client-test.pl -rwxr-x--- 1 tfiedler tfiedler 659 May 4 09:05 ipcruntest.pl -rw-r----- 1 tfiedler tfiedler 364 May 3 13:31 ipctest.pl -rw-r----- 1 tfiedler tfiedler 31945 May 4 09:43 Log.txt -rw-r----- 1 tfiedler tfiedler 16384 May 4 09:29 .Log.txt.swp -rwxr-x--- 1 tfiedler tfiedler 3982 May 3 13:12 menu.pl -rwxr-x--- 1 tfiedler tfiedler 3993 May 4 09:41 Menu-Server.pl drwxr-x--- 2 tfiedler tfiedler 4096 May 1 08:09 ms1help -rw-r----- 1 tfiedler tfiedler 14544 Apr 27 14:51 perlscript.zip drwxr-x--- 2 tfiedler tfiedler 4096 May 3 09:28 RCS -rwxr-x--- 1 tfiedler tfiedler 1775 May 2 13:56 server-test.pl Use of uninitialized value in numeric eq (==) at ./Menu-Server.pl line + 57.

Im not seeing how $exit is initialized in the test code, but not in the server code.
Below is the output from the test code
exit = 0 0 total 10976 drwxr-x--- 4 tfiedler tfiedler 4096 May 4 09:45 . drwxr-x--- 4 tfiedler tfiedler 4096 Apr 27 14:53 .. -rw-r----- 1 tfiedler tfiedler 0 May 4 09:47 1 -rw-r----- 1 tfiedler tfiedler 11115686 May 3 10:02 cbkwanzaa.wmv -rwxr-x--- 1 tfiedler tfiedler 2659 May 1 16:29 client-test.pl -rwxr-x--- 1 tfiedler tfiedler 659 May 4 09:05 ipcruntest.pl -rw-r----- 1 tfiedler tfiedler 364 May 3 13:31 ipctest.pl -rw-r----- 1 tfiedler tfiedler 32031 May 4 09:43 Log.txt -rw-r----- 1 tfiedler tfiedler 16384 May 4 09:29 .Log.txt.swp -rwxr-x--- 1 tfiedler tfiedler 3982 May 3 13:12 menu.pl -rwxr-x--- 1 tfiedler tfiedler 3993 May 4 09:41 Menu-Server.pl drwxr-x--- 2 tfiedler tfiedler 4096 May 1 08:09 ms1help -rw-r----- 1 tfiedler tfiedler 14544 Apr 27 14:51 perlscript.zip drwxr-x--- 2 tfiedler tfiedler 4096 May 3 09:28 RCS -rwxr-x--- 1 tfiedler tfiedler 1775 May 2 13:56 server-test.pl exit = 0 total 10976 drwxr-x--- 4 tfiedler tfiedler 4096 May 4 09:45 . drwxr-x--- 4 tfiedler tfiedler 4096 Apr 27 14:53 .. -rw-r----- 1 tfiedler tfiedler 0 May 4 09:47 1 -rw-r----- 1 tfiedler tfiedler 11115686 May 3 10:02 cbkwanzaa.wmv -rwxr-x--- 1 tfiedler tfiedler 2659 May 1 16:29 client-test.pl -rwxr-x--- 1 tfiedler tfiedler 659 May 4 09:05 ipcruntest.pl -rw-r----- 1 tfiedler tfiedler 364 May 3 13:31 ipctest.pl -rw-r----- 1 tfiedler tfiedler 32031 May 4 09:43 Log.txt -rw-r----- 1 tfiedler tfiedler 16384 May 4 09:29 .Log.txt.swp -rwxr-x--- 1 tfiedler tfiedler 3982 May 3 13:12 menu.pl -rwxr-x--- 1 tfiedler tfiedler 3993 May 4 09:41 Menu-Server.pl drwxr-x--- 2 tfiedler tfiedler 4096 May 1 08:09 ms1help -rw-r----- 1 tfiedler tfiedler 14544 Apr 27 14:51 perlscript.zip drwxr-x--- 2 tfiedler tfiedler 4096 May 3 09:28 RCS -rwxr-x--- 1 tfiedler tfiedler 1775 May 2 13:56 server-test.pl return = success
Any help is appreciated - sorry for such a long post, but I am unable to reproduce the results in a test.

Ted
--
"That which we persist in doing becomes easier, not that the task itself has become easier, but that our ability to perform it has improved."
  --Ralph Waldo Emerson