code snippet of DSSAFE.pm
# ... | |
@EXPORT = qw(open popen ppopen close system psystem exec backtick pbacktick | |
maketemp untaint is_tainted); | |
# ... | |
sub __parsecmd { | |
my $cmd = shift; | |
my @args = quotewords('\s+', 1, $cmd); | |
my @env = (); # currently not used. pending review. | |
my @xargs = (); # arguments of the command | |
my ($xcmd, $fout, $fin, $ferr, $mout, $min, $merr, $rd2); | |
while (@args) { | |
my $arg = shift @args; | |
next if (length($arg) == 0); | |
unless (defined $xcmd) { | |
if ($arg =~ /^(\w+)=(.+)$/) { | |
push @env, {$1 => $2}; | |
next; | |
} elsif ($arg =~ /^[^\/a-zA-Z]/) { | |
__log("Invalid command: $cmd"); # must be / or letter | |
return undef; | |
} | |
$xcmd = untaint($arg); | |
next; | |
} | |
if ($arg =~ /^(2|1)>&(2|1)$/) { | |
$rd2 = $2; | |
} elsif ($arg =~ /^(1|2)?(>>?)([^>].*)?$/) { | |
if ($1 and $1 == 2) { | |
($merr, $ferr) = ($2, $3 || untaint(shift @args)); | |
} else { | |
($mout, $fout) = ($2, $3 || untaint(shift @args)); | |
} | |
} elsif ($arg =~ /^(<)(.+)?$/) { | |
($min, $fin) = ($1, $2 || untaint(shift @args)); | |
} elsif ($arg =~ /^(>&)(.+)?$/) { | |
$fout = $ferr = $2 || untaint(shift @args); | |
$mout = $merr = ">"; | |
} elsif ($arg =~ /^(\'|\")(.*)(\'|\")$/) { | |
push @xargs, $2; # skip checking meta between quotes | |
# } elsif ($arg =~ /[\$\&\*\(\)\{\}\[\]\`\;\|\?\n~<>]/) { | |
} elsif ($arg =~ /[\&\*\(\)\{\}\[\]\`\;\|\?\n~<>]/) { | |
__log("Meta characters not allowed: ($arg) $cmd"); | |
return undef; | |
} elsif ($arg =~ /\W\$/) { | |
__log("Meta characters not allowed: ($arg) $cmd"); | |
} else { | |
push @xargs, untaint($arg); | |
} | |
} | |
if ($rd2) { | |
# redirect both 2 and 1 to the same place | |
if (defined $fout) { | |
($ferr, $merr) = ($fout, $mout); | |
} elsif (defined $ferr) { | |
($fout, $mout) = ($ferr, $merr); | |
} elsif ($rd2 == 1) { | |
open STDERR, ">&STDOUT" or die "cannot dup STDERR to STDOUT:$!\n"; | |
select STDERR; $|=1; | |
select STDOUT; $|=1; | |
} elsif ($rd2 == 2) { | |
open STDOUT, ">&STDERR" or die "cannot dup STDOUT to STDERR:$!\n"; | |
select STDOUT; $|=1; | |
select STDERR; $|=1; | |
} | |
} | |
unless ($xcmd) { | |
__log("Command parsing error: $cmd"); | |
return undef; | |
} | |
# need to untaint $cmd. otherwise the whole hash will be tainted. | |
# but $cmd will never be used for exec anyway, only for debug. | |
my $params = { cmd => untaint($cmd), xcmd => $xcmd, xargs => \@xargs }; | |
$params->{fstdout} = $fout if $fout; | |
$params->{mstdout} = $mout if $mout; | |
$params->{fstderr} = $ferr if $ferr; | |
$params->{mstderr} = $merr if $merr; | |
$params->{fstdin} = $fin if $fin; | |
$params->{mstdin} = $min if $min; | |
return $params; | |
} | |
# ... | |
sub system { | |
return CORE::system(@_) if (@_ > 1); | |
my $params = __parsecmd(join(' ', @_)); | |
return -1 unless ($params); | |
# We want SIGINT and SIGQUIT to be ignored in the parent | |
# while the child is running. However, we want the child | |
# to get these signals -- so we declare a block around | |
# the code that ignores SIGINT such that the child will | |
# exec with the signals turned on. | |
{ | |
local $SIG{INT} = 'IGNORE'; | |
local $SIG{QUIT} = 'IGNORE'; | |
flush STDOUT; flush STDERR; flush STDIN; | |
my $pid = fork; | |
unless (defined $pid) { | |
__log("system: cannot fork $!"); | |
return -1; | |
} | |
if ($pid) { | |
waitpid $pid, 0; | |
return $?; | |
} | |
} | |
return __execo $params; | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment