Re: system() call mis-directs?

[jcb]

Check the values of $sensor for which the error occurs. Do they contain other bits of shell syntax such as ampersands, semicolons, or a trailing backslash? Any of those could cause the shell to misparse the remainder of the command.

Try instead: (obviously untested)

my $result = system(q[./upgrade.pl "].quotemeta($sensor).q["  >>worklo
+g 2>&1]);

[haukex]

quotemeta($sensor)

Sorry, but quotemeta is not an appropriate shell quoting function - it may work in some cases, but will fail in others. I would strongly recommend e.g. ShellQuote::Any instead, or of course to avoid the shell in the first place.

[afoken]

ShellQuote::Any

The code currently looks like this:

package ShellQuote::Any;
use strict;
use warnings;

our $VERSION = '0.04';

sub import {
    my $caller = caller;

    no strict 'refs'; ## no critic
    *{"${caller}::shell_quote"} = \&shell_quote;
}

sub shell_quote {
    my ($cmd, $os) = @_;

    if ($os) {
        _require($os);
        return _is_win32($os) ? _win32_quote($cmd) : _bourne_quote($cm
+d);
    }
    else {
        _q()->($cmd);
    }
}

my $Q;
sub _q {
    return $Q if $Q;

    _require($^O);

    if ( _is_win32($^O) ) {
        $Q = \&_win32_quote;
    }
    else {
        $Q = \&_bourne_quote;
    }

    return $Q;
}

my %K;
sub _require {
    my ($os) = @_;

    return $K{$os} if $K{$os};

    my $klass = _is_win32($os) ? 'Win32/ShellQuote.pm' : 'String/Shell
+Quote.pm';
    $K{$os} = $klass;

    require "$klass"; ## no critic
}

sub _win32_quote {
    my ($cmd) = @_;
    Win32::ShellQuote::cmd_escape(join ' ', @$cmd);
}

sub _bourne_quote {
    my ($cmd) = @_;
    String::ShellQuote::shell_quote(@$cmd);
}

sub _is_win32 {
    my ($os) = @_;

    return $os =~ m!^(?:MS)?Win(?:32)?$!i ? 1 : 0;
}

1;

Just from looking at the names of the functions, it has only two modes of operation: Either Windows, or Bourne Shell. No code for handling cygwin, OS/2 or DOS, so those three will be treated as Bourne Shell, which is plain wrong.

On Windows, you simply can not win the quoting game. Any code pretending to be able to do so is broken.

Assuming that all other systems use a bourne-compatible shell as default shell is at least optimistic. Severals systems have a korn shell as default, others even use a csh. See Various system shells.

Looking at the documentation of String::ShellQuote, handling the non-Windows part, the problem is obvious without even reading the source:

BUGS

Only Bourne shell quoting is supported. I'd like to add other shells (particularly cmd.exe), but I'm not familiar with them. It would be a big help if somebody supplied the details.

It seems nobody cared during the last 10 years, and the author either had no time to RTFM, or had no idea where to search for shell man pages.

So, with ShellQuote::Any, you are essentially lost if the current default shell is no bourne shell. I did not bother to read the quoting code in String::ShellQuote. As is, it is broken anyway, and with it ShellQuote::Any. Yes, it may work on many systems in their default configuration, but it won't do its job on all systems. It does not even prevent stupid things from happening on unknown systems.

Alexander

[jcb]

I currently believe that quotemeta will work within the context of a double-quoted argument with the Bourne shell. I was concerned mostly with ensuring that any quotes embedded in $sensor would not terminate the quoted argument early (I suspect that some of the $sensor values contain characters that separate commands) and quotemeta seems to be a tool usable for this special case. If I am wrong, please provide a counter-example where quotemeta fails to cause a string to be passed exactly as written as an argument. That code was written off the top of my head and not tested so I could be very wrong here...

In this case, it is wrong anyway because $sensor consists of multiple arguments that the shell is expected to split, and I did immediately suggest finding a solution that does not involve using the shell after an example input was provided.

[Clarkman]

Thank you both!

@sundialsvc4, thank you but logs have been checked and re-checked.

@jcb, you may have nailed it.

$sensors looks like this: ABC-00-DEF-1234 --sitename=Charon .

The double hyphen is suspicious as is the '='

Will test out tomorrow and post results. Thank you !

[jcb]

Your sample does not contain any troublesome characters, but the shell splits on unquoted whitespace, which my earlier suggestion would prevent by wrapping $sensor in shell quotes before passing it to the shell. My immediate suspicion is that you may have some "odd" site names. In particular, an ampersand is both reasonable in human-readable names and special to the shell.

The best way to fix this would be to get the shell out of the picture and use the list form of system. You will also need to use open or sysopen to rearrange your filehandles so that the second child will inherit STDOUT and STDERR opened for append on the worklog file, while the first child keeps its original STDOUT somewhere to report the result from the second child.

[Clarkman]

Thanks a tremendous amount everyone. We figured it out, rather we re-factored some 6 year old code. This was the process tree showing PID and PPID at the beginning of every line:

1234 1    do-upgrades.pl.    <--- daemon
2345 1234 do-upgrades.pl     <--- forked process with system() call
2346 2345 upgrade-sensor.pl. <--- worker bee

Every time the daemon while(1) looped forever, it stopped over at waitpid:

# read everything from the pipe.
my $pipename = "sensor-fifo";
while (1) {
    chomp(my $sensor = `cat $pipename`);
    # Something in pipe; see if it is real or just empty string
    # [Omitted more sophisticated tests here]
    if ($sensor) {
      print "upgrade requested for $sensor, forking...\n";
      my $f=fork;
      if(defined ($f) and $f==0) { # I'm a child
          # Here you can the shell meta-characters 
          my $result = system("${perlhome}/upgrade-sensor.pl $sensor >
+> ${workpath}/worklog 2>&1");
          # System is a blocking call, meaning that the 
          # intermediate process does not exit.
          print "result for $sensor was $result.\n";
          exit(0);
      } elsif (defined ($f)==0) { # Fork failed
        print "Fork failed for $sensor!\n";
      }
      # else I'm the parent
    }
    print "waiting on child $$ to complete $sensor.\n";
    1 while waitpid(-1, WNOHANG)>0; # reaps children
    print "Finished waiting.\n";

}

The meaning of the intermediate process was not clear. Upon completion of the system() call, it prints and exits. Its sole purpose seems to allow catching the $result into the daemon's log, but we don't care. So we switched over to exec():

# read everything from the pipe.
my $pipename = "sensor-fifo";
while (1) {
    chomp(my $sensor = `cat $pipename`);
    my @args = split / /,$sensor;
    # Something in pipe; see if it is real or just empty string
    # [Omitted more sophisticated tests here]
    if ($sensor) {
      print "upgrade requested for $sensor, forking...\n";
      my $f=fork;
      if(defined ($f) and $f==0) { # I'm a child
        exec ("${perlhome}/upgrade-sensor.pl", @args)
      } elsif (defined ($f)==0) { # Fork failed
        print "Fork failed for $sensor!\n";
      }
      # else I'm the parent
    }
    print "waiting on child $$ to complete $sensor.\n";
    1 while waitpid(-1, WNOHANG)>0; # reaps children
    print "Finished waiting.\n";

}

Now the process tree looks like this:

1234 1    do-upgrades.pl.    <--- daemon
2346 1234 upgrade-sensor.pl. <--- worker bee

Much simpler. From running the daemon on the command line, we now saw that the output of the fork/exec'd upgrade-sensor.pl process was writing into the daemon's log. More specifically, the daemon's log created thus, when the daemon was launched:

/usr/bin/nohup ${RFS_HOME}/do-upgrades.pl > ${WORK_PATH}/do.log &

(Still need to write an init.d/ controller). What we did to make it work (we think) was to kill off dup handles, and re-open. We added the two close commands at the head of the upgrade-sensor.pl script, and now logs are properly separated. Love inheriting code!

close (STDERR);
close (STDOUT);
my $logabspath =  $logpath . "/" . $logfile;
open (STDOUT, "| tee -ai $logabspath");
open (STDERR, "| tee -ai $logabspath");
print "\n\n----------------------------------------------\n";

What we don't know is whether this is correct, or not. It works on two hosts the same way:

$ uname -a
Linux toolchain 4.4.0-130-generic #156-Ubuntu SMP Thu Jun 14 08:53:28 
+UTC 2018 x86_64 x86_64 x86_64 GNU/Linux

$ uname -a
Linux oldtoolchain 2.6.32-754.17.1.el6.x86_64 #1 SMP Tue Jul 2 12:42:4
+8 UTC 2019 x86_64 x86_64 x86_64 GNU/Linux

so that's good. But these messages are not coming from our code, rather the first issues upon calling fork. The second issues from waitpid.

Child forked (pid=14825), 1 processes running now at ./do-upgrades.pl 
+line 49.

Unknow process 0 has exited, ignoring it at ./do-upgrades.pl line 84

Yes, it is ->Unknow<-. Thanks again - Clarkman

[Clarkman]

OK, the previously unknown elephant in the room is Proc:Queue. It overlays fork and waited, and has those print outs in it.

[jcb]

You are running some tee processes that you should not need with that. Try something more like: (untested)

# no need to close STDERR or STDOUT first; reopening will do that impl
+icitly
open STDERR, '>>', $logpath.'/'.$logfile
  or die "redirect STDERR >> $logpath/$logfile: $!"; $| = 1;
open STDOUT, '>>&=', \*STDERR
  or die "redirect STDOUT -> STDERR: $!"; $| = 1;
print "\n\n", '-' x 45, "\n";