Safe system call with multiple commands with perl - perl

I have a Perl script that reads some information from a web form. In order to do proper sanitation, I want to use the system syntax described here.
They suggest that you should form system commands in the following form system ("cat", "/usr/stats/$username"); so that the username variable would only get interpreted as a argument to cat.
If I had a command that had the form of system("export REPLYTO=\"$from\"; echo \"$body\" | mail -s \"$subject\""); which has multiple system commands, how can I properly sanitize the system call?

Before I start, note that you can do the export in Perl by setting $ENV{REPLY_TO}.
Option 1.
You can use String::ShellQuote's shell_quote.
use autodie qw( :all );
my $cmd = shell_quote('echo', $body) .
'|' . shell_quote('mail', '-s', $subject);
local $ENV{REPLY_TO} = $from;
system($cmd);
Option 2.
Pass everything by env var.
use autodie qw( :all );
local $ENV{REPLY_TO} = $from;
local $ENV{SUBJECT} = $subject;
local $ENV{BODY} = $body;
system('echo "$BODY" | mail -s "$SUBJECT"');
Option 3.
Get rid of echo
use autodie qw( :all );
local $ENV{REPLY_TO} = $from;
open(my $pipe, '|-', 'mail', '-s', $subject);
print($pipe $body);
close($pipe);
die "Child died from signal ".($? & 0x7F)."\n" if $? & 0x7F;
die "Child exited from error ".($? >> 8)."\n" if $? >> 8;

Related

How to pipe the content of a variable as STDIN in a qx{} statement in Perl?

I basically would like to do this:
$_ = "some content that need to be escaped &>|\"$\'`\s\\";
qx{echo $_ | foo}
There are two problems here. First the content of $_ needs to be escaped as it can contain binary data. Second, invoking echo might be slightly inefficient.
How can I simply pipe some content as STDIN to a command in Perl?
The following assume #cmd contains the program and its arguments (if any).
my #cmd = ('foo');
If you want to capture the output, you can use any of the following:
use String::ShellQuote qw( shell_quote );
my $cmd1 = shell_quote('printf', '%s', $_);
my $cmd2 = shell_quote(#cmd);
my $output = qx{$cmd1 | $cmd2};
use IPC::Run3 qw( run3 );
run3(\#cmd, \$_, \my $output);
use IPC::Run qw( run );
run(\#cmd, \$_, \my $output);
If you don't want to capture the output, you can use any of the following:
use String::ShellQuote qw( shell_quote );
my $cmd1 = shell_quote('printf', '%s', $_);
my $cmd2 = shell_quote(#cmd);
system("$cmd1 | $cmd2");
system('/bin/sh', '-c', 'printf "%s" "$0" | "$#"', $_, #cmd);
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote(#cmd);
open(my $pipe, '|-', $cmd);
print($pipe $_);
close($pipe);
open(my $pipe, '|-', '/bin/sh', '-c', '"$#"', 'dummy', #cmd);
print($pipe $_);
close($pipe);
use IPC::Run3 qw( run3 );
run3(\#cmd, \$_);
use IPC::Run qw( run );
run(\#cmd, \$_);
If you don't want to capture the output, but you don't want to see it either, you can use any of the following:
use String::ShellQuote qw( shell_quote );
my $cmd1 = shell_quote('printf', '%s', $_);
my $cmd2 = shell_quote(#cmd);
system("$cmd1 | $cmd2 >/dev/null");
system('/bin/sh', '-c', 'printf "%s" "$0" | "$#" >/dev/null', $_, #cmd);
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote(#cmd);
open(my $pipe, '|-', "$cmd >/dev/null");
print($pipe $_);
close($pipe);
open(my $pipe, '|-', '/bin/sh', '-c', '"$#" >/dev/null', 'dummy', #cmd);
print($pipe $_);
close($pipe);
use IPC::Run3 qw( run3 );
run3(\#cmd, \$_, \undef);
use IPC::Run qw( run );
run(\#cmd, \$_, \undef);
Notes:
The solutions using printf will impose a limit on the size of the data to pass to the program's STDIN.
The solutions using printf are unable to pass a NUL to the program's STDIN.
The presented solutions that use IPC::Run3 and IPC::Run don't involve a shell. This avoids problems.
You should probably use system and capture from IPC::System::Simple instead of the builtin system and qx to get "free" error checking.
This answer is a very naive approach. It's prone to deadlock. Don't use it!
ikegami explains in a comment below:
If the parent writes enough to the pipe attached to the child's STDIN, and if the child outputs enough to the pipe attached to its STDOUT before it reads from its STDIN, there will be a deadlock. (This can be as little as 4KB on some systems.) The solution involved using something like select, threads, etc. The better solution is to use a tool that has already solved the problem for you (IPC::Run3 or IPC::Run). IPC::Open2 and IPC::Open3 are too low-level to be useful in most circumstances
I'll leave the original answer, but encourage readers to pick the solution from one of the other answers instead.
You can use open2 from IPC::Open2 to read and write to the same process.
Now you don't need to care about escaping anything.
use IPC::Open2;
use FileHandle;
my $writer = FileHandle->new;
my $reader = FileHandle->new;
my $pid = open2( $reader, $writer, 'wc -c' );
# write to the pipe
print $writer 'some content that need to be escaped &>|\"$\'`\s\\';
# tell it you're done
$writer->close;
# read the out of the pipe
my $line = <$reader>;
print $line;
This will print 48.
Note that you can't use double quotes "" for the exact input you showed because the number of backslashes \ is wrong.
See perldoc open and perlipc for more information.
I like the solution provided by #simbabque since it avoids calling the Shell. Anyway, for comparison, a shorter solution can be obtained using Bash (but avoiding echo) by using a Bash Here string:
$_ = q{some content that need to be escaped &>|\"$\'`\s\\};
$_ =~ s/'/'"'"'/g; # Bash needs single quotes to be escaped
system 'bash', '-c', "foo <<< '$_'";
And, if you need to capture the output of the command:
use Capture::Tiny 'capture_stdout';
my $res = capture_stdout { system 'bash', '-c', "foo <<< '$_'" };

Perl is respecting '<' as a regular character rather an output redirection

I would like some help figuring this particular coding problem.
I have a perl script (#1) that calls another perl script(#2). In #1, I call #2 to also redirect its output to a log file. like so
my #command = ('downloadImage', '-url', $url, '>', $log);
this commands runs fine when it runs on the terminal.
Do I have to use some other kind of special character to tell perl that > is output redirection not just some regular character?
I run it as:
system(#command);
I assume the full code is:
my #command = ('downloadImage', '-url', $url, '>', $log);
system #command;
system has two modes. system $command will run $command in the shell.
# This will write 'foo' to the file 'bar'
system "echo foo > bar";
system #command is really system $program, #args. It will bypass the shell and run the $program with #args.
# This will print 'foo > bar'
system "echo", "foo", ">", "bar"
So if you want to do output redirection like that you could join #command together.
system join " ", #command;
But that can run into shell quoting issues. It's safer, faster, and more portable to do the redirection yourself in Perl using a piped open.
use strict;
use warnings;
use autodie;
open my $echo, "-|", "echo", "foo";
open my $log, ">", "some.log";
print {$log} <$echo>;
Doing
system('downloadImage', '-url', $url, '>', $log)
in Perl is the same as doing
'downloadImage' '-url' "$url" '>' "$log"
in the shell. This executes downloadImage with four arguments, one of which is >. The shell command you were trying to execute is the following:
'downloadImage' '-url' "$url" > "$log"
If you want to execute that shell command, you first need a shell. The following is how you should achieve this:
use String::ShellQuote qw( shell_quote );
my #cmd = ('downloadImage', '-url', $url);
my $shell_cmd = shell_quote(#cmd) . ' >' . shell_quote($log);
system($shell_cmd); # Short for system('/bin/sh', '-c', $shell_cmd);
However, there are lots of downsides to using a shell. Here are some alternatives:
use IPC::Open3 qw( open3 );
my #cmd = ('downloadImage', '-url', $url);
{
open(local *CHILD_STDIN, '<', '/dev/null')
or die("Can't open \"/dev/null\": $!\n");
open(local *CHILD_STDOUT, '>', $log)
or die("Can't create \"$log\": $!\n");
my $pid = open3('<&CHILD_STDIN', '>&CHILD_STDOUT', '>&STDERR', #cmd);
waitpid($pid, 0);
}
or
use IPC::Run3 qw( run3 );
my #cmd = ('downloadImage', '-url', $url);
run3(\#cmd, \undef, $log);
or
use IPC::Run qw( run );
my #cmd = ('downloadImage', '-url', $url);
run(\#cmd, '<', '/dev/null', '>', $log);

Capturing output from Perl's require

Is it possible to capture output from Perl's require?
For example:
{
local #ARGV = qw/ hello world /;
require 'myscript.pl';
}
Id like to capture any stdout that myscript.pl generates. Can imagine something like this:
{
local #ARGV = qw/ hello world /;
my $output = require 'myscript.pl';
}
Capture::Tiny makes this easier:
use Capture::Tiny 'capture_stdout';
my $output = capture_stdout {
local #ARGV = qw/hello world/;
require 'foo.pl';
};
although I would agree that this is generally not a good way to run a script.
Yes, it's possible. You need to redirect STDOUT before requireing and restore the original STDOUT afterwards.
a.pl
my $capture;
open STDOUTBACKUP, '>&STDOUT';
close STDOUT;
open STDOUT, '>', \$capture;
require 'b.pl';
close STDOUT;
open STDOUT, '>&STDOUTBACKUP';
print "CAPTURED: $capture";
b.pl
print "ModuleB";
Output is CAPTURED: ModuleB
myscript.pl appears to be a Perl script. It makes no sense to use require or do.
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote('myscript.pl', 'hello', 'world');
my $output = `$cmd`;
die("Can't execute myscript.pl: $!\n") if $? == -1;
die("myscript.pl killed by signal ".( $? & 0x7F )."\n") if $? & 0x7F;
die("myscript.pl returned error ".( $? >> 8 )."\n") if $? >> 8;
or
open(my $pipe, '-|', 'myscript.pl', 'hello', 'world')
or die("Can't execute myscript.pl: $!\n");
my $output = '';
$output .= $_ while <$pipe>;
close($pipe);
die("myscript.pl killed by signal ".( $? & 0x7F )."\n") if $? & 0x7F;
die("myscript.pl returned error ".( $? >> 8 )."\n") if $? >> 8;

Diff two remote files using Perl

I have an array of file paths:
#files = ('/home/.../file.txt', '/home/.../file2.txt',...);
I have multiple remote machines, with a similar filestructure. How can I diff these remote files using Perl?
I thought of using Perl backticks, ssh and using diff, but I am having issues with sh (it doesn't like diff <() <()).
Is there a good Perl way of comparing at least two remote files?
Use rsync to copy the remote files to the local machine, then use diff to find out the differences:
use Net::OpenSSH;
my $ssh1 = Net::OpenSSH->new($host1);
$ssh1->rsync_get($file, 'master');
my $ssh2 = Net::OpenSSH->new($host2);
system('cp -R master remote');
$ssh2->rsync_get($file, 'remote');
system('diff -u master remote');
You can use the Perl Module on CPAN called Net::SSH::Perl to run remote commands.
Link: http://metacpan.org/pod/Net::SSH::Perl
Example from the Synopsis:
use Net::SSH::Perl;
my $ssh = Net::SSH::Perl->new($host);
$ssh->login($user, $pass);
my($stdout, $stderr, $exit) = $ssh->cmd($cmd);
You command would look something like
my $cmd = "diff /home/.../file.txt /home/.../file2.txt";
edit: The files are on different servers.
You can still use Net::SSH::Perl to read the files.
#!/bin/perl
use strict;
use warnings;
use Net::SSH::Perl;
my $host = "First_host_name";
my $user = "First_user_name";
my $pass = "First_password";
my $cmd1 = "cat /home/.../file1";
my $ssh = Net::SSH::Perl->new($host);
$ssh->login($user, $pass);
my($stdout1, $stderr1, $exit1) = $ssh->cmd($cmd1);
#now stdout1 has the contents of the first file
$host = "Second_host_name";
$user = "Second_user_name";
$pass = "Second_password";
my $cmd2 = "cat /home/.../file2";
$ssh = Net::SSH::Perl->new($host);
$ssh->login($user, $pass);
my($stdout2, $stderr2, $exit2) = $ssh->cmd($cmd2);
#now stdout2 has the contents of the second file
#write the contents to local files to diff
open(my $fh1, '>', "./temp_file1") or DIE "Failed to open file 1";
print $fh1 $stdout1;
close $fh1;
open(my $fh2, '>', "./temp_file2") or DIE "Failed to open file 2";
print $fh2 $stdout2;
close $fh2;
my $difference = `diff ./temp_file1 ./temp_file2`;
print $difference . "\n";
I haven't tested this code, but you could do something like this. Remember to download the Perl Module Net::SSH::Perl to run remote commands.
Diff is not implemented in the Perl Core Modules, but there another called Text::Diff on CPAN so maybe that would work too. Hope this helps!

Do we have an autochomp in Perl?

This is what my Perl code looks like for monitoring a Unix folder :
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions;
my $date = `date`; chomp $date;
my $datef = `date +%Y%m%d%H%M.%S`; chomp $datef;
my $pwd = `pwd`; chomp $pwd;
my $cache = catfile($pwd, "cache");
my $monitor = catfile($pwd, "monme");
my $subject = '...';
my $msg = "...";
my $sendto = '...';
my $owner = '...';
sub touchandmail {
`touch $cache -t "$datef"`;
`echo "$msg" | mail -s "$subject" $owner -c $sendto`;
}
while(1) {
$date = `date`; chomp $date;
$datef = `date +%Y%m%d%H%M.%S`; chomp $datef;
if (! -e "$cache") {
touchandmail();
} elsif ("`find $monitor -newer $cache`" ne "") {
touchandmail();
}
sleep 300;
}
To do a chomp after every assignment does not look good. Is there some way to do an "autochomp"?
I am new to Perl and might not have written this code in the best way. Any suggestions for improving the code are welcome.
Don't use the shell, then.
#! /usr/bin/perl
use warnings;
use strict;
use Cwd;
use POSIX qw/ strftime /;
my $date = localtime;
my $datef = strftime "%Y%m%d%H%M.%S", localtime;
my $pwd = getcwd;
The result is slightly different: the output of the date command contains a timezone, but the value of $date above will not. If this is a problem, follow the excellent suggestion by Chas. Owens below and use strftime to get the format you want.
Your sub
sub touchandmail {
`touch $cache -t "$datef"`;
`echo "$msg" | mail -s "$subject" $owner -c $sendto`;
}
will fail silently if something goes wrong. Silent failures are nasty. Better would be code along the lines of
sub touchandmail {
system("touch", "-t", $datef, $cache) == 0
or die "$0: touch exited " . ($? >> 8);
open my $fh, "|-", "mail", "-s", $subject, $owner, "-c", $sendto
or die "$0: could not start mail: $!";
print $fh $msg
or warn "$0: print: $!";
unless (close $fh) {
if ($! == 0) {
die "$0: mail exited " . ($? >> 8);
}
else {
die "$0: close: $!";
}
}
}
Using system rather than backticks is more expressive of your intent because backticks are for capturing output. The system(LIST) form bypasses the shell and having to worry about quoting arguments.
Getting the effect of the shell pipeline echo ... | mail ... without the shell means we have to do a bit of the plumbing work ourselves, but the benefit—as with system(LIST)—is not having to worry about shell quoting. The code above uses many-argument open:
For three or more arguments if MODE is '|-', the filename is interpreted as a command to which output is to be piped, and if MODE is '-|', the filename is interpreted as a command that pipes output to us. In the two-argument (and one-argument) form, one should replace dash ('-') with the command. See Using open for IPC in perlipc for more examples of this.
The open above forks a mail process, and $fh is connected to its standard input. The parent process (the code still running touchandmail) performs the role of echo with print $fh $msg. Calling close flushes the handle's I/O buffers plus a little extra because of how we opened it:
If the filehandle came from a piped open, close returns false if one of the other syscalls involved fails or if its program exits with non-zero status. If the only problem was that the program exited non-zero, $! will be set to 0. Closing a pipe also waits for the process executing on the pipe to exit—in case you wish to look at the output of the pipe afterwards—and implicitly puts the exit status value of that command into $? and ${^CHILD_ERROR_NATIVE}.
More generally, the IO::All module does indeed provide the equivalent of an autochomp:
use IO::All;
# for getting command output:
my #date = io("date|")->chomp->slurp;
#$date[0] contains the chomped first line of the output
or more generally:
my $fh = io("file")->chomp->tie;
while (<$fh>) {
# no need to chomp here ! $_ is pre-chomped
}
Granted, for this particular case of date I would agree with the other answerers that you are probably better off using one of the DateTime modules, but if you are simply reading in a file and want all your lines to be chomped, then IO::All with the chomp and tie options applied is very convenient.
Note also that the chomp trick doesn't work when slurping the entire contents of the handle into a scalar directly (that's just the way it is implemented).
Try putting it into a function:
sub autochomp {
my $command = shift;
my $retval = `$command`;
chomp $retval;
return $retval;
}
And then call that for each command you want to execute and then chomp.
Use DateTime or other of the date modules on CPAN instead of the date utility.
For example:
use DateTime;
my $dt = DateTime->now;
print $dt->strftime('%Y%m%d%H%M.%S');
It is possible to assign and chomp in a single line using the following syntax:
chomp ( my $date = `date` );
As for speaking more Perlishly, if you find yourself repeating the same thing over and over again, roll it into a sub:
sub assign_and_chomp {
my #result;
foreach my $cmd (#_) {
chomp ( my $chomped = $cmd );
push #result, $chomped;
}
return #result;
}
my ( $date , $datef , $pwd )
= assign_and_chomp ( `date` , `date +%Y%m%d%H%M.%S` , `pwd` );