SHARE
TWEET

Untitled

a guest Oct 14th, 2019 131 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. package DSSafe;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = "0.01";
  6.  
  7. use Fcntl;
  8. use Text::ParseWords;
  9. use Symbol;
  10. use File::Basename;
  11.  
  12. use Exporter;
  13. use vars qw(@ISA @EXPORT %EXPORT_TAGS);
  14. @ISA = qw(Exporter);
  15. @EXPORT = qw(open popen ppopen close system psystem exec backtick pbacktick
  16.              maketemp untaint is_tainted);
  17. %EXPORT_TAGS = (ds => [qw(ds_open ds_popen ds_ppopen ds_cleanup)]);
  18.  
  19. use vars qw(@__temp_files %__file_handles %__ppwrite_handles $__debug_level);
  20.  
  21. INIT {
  22.     @__temp_files = ();
  23.     %__file_handles = ();
  24.     %__ppwrite_handles = ();
  25.     $__debug_level = ();
  26.     __setenv();
  27. };
  28.  
  29. END {
  30.     ds_cleanup();
  31. }
  32.  
  33. sub __log {
  34.     my $msg = shift;
  35.     my ($pkg, $file, $line) = caller;
  36.     $file = basename($file);
  37. }
  38.  
  39. sub __exit {
  40.     my $status = shift;
  41.     exit $status;
  42. }
  43.  
  44. sub __die {
  45.     my $msg = shift;
  46.     my ($pkg, $file, $line) = caller;
  47.     $file = basename($file);
  48.     __exit(1);
  49. }
  50.  
  51. sub __setenv {
  52.     $ENV{PATH} = join(":",
  53.                       "/bin",
  54.                       "/usr/bin",
  55.                       "/usr/X11R6/bin",
  56.                       "$ENV{DSINSTALL}/bin",
  57.                       "$ENV{DSINSTALL}/perl5/bin");
  58.     $ENV{PATH} = untaint($ENV{PATH});  
  59. }
  60.  
  61. # Parse a command. Interpret shell redirects. The command passed in is
  62. # considered as a single command w/o pipes and semicolons.
  63. sub __parsecmd {
  64.     my $cmd = shift;
  65.     my @args = quotewords('\s+', 1, $cmd);
  66.  
  67.     my @env = (); # currently not used. pending review.
  68.     my @xargs = (); # arguments of the command
  69.     my ($xcmd, $fout, $fin, $ferr, $mout, $min, $merr, $rd2);
  70.  
  71.     while (@args) {
  72.         my $arg = shift @args;
  73.         next if (length($arg) == 0);
  74.         unless (defined $xcmd) {
  75.             if ($arg =~ /^(\w+)=(.+)$/) {
  76.                 push @env, {$1 => $2};
  77.                 next;
  78.             } elsif ($arg =~ /^[^\/a-zA-Z]/) {
  79.                 __log("Invalid command: $cmd"); # must be / or letter
  80.                 return undef;
  81.             }
  82.             $xcmd = untaint($arg);
  83.             next;
  84.         }
  85.         if ($arg =~ /^(2|1)>&(2|1)$/) {
  86.             $rd2 = $2;
  87.         } elsif ($arg =~ /^(1|2)?(>>?)([^>].*)?$/) {
  88.             if ($1 and $1 == 2) {
  89.                 ($merr, $ferr) = ($2, $3 || untaint(shift @args));
  90.             } else {
  91.                 ($mout, $fout) = ($2, $3 || untaint(shift @args));
  92.             }
  93.         } elsif ($arg =~ /^(<)(.+)?$/) {
  94.             ($min, $fin) = ($1, $2 || untaint(shift @args));
  95.         } elsif ($arg =~ /^(>&)(.+)?$/) {
  96.             $fout = $ferr = $2 || untaint(shift @args);
  97.             $mout = $merr = ">";
  98.         } elsif ($arg =~ /^(\'|\")(.*)(\'|\")$/) {
  99.             push @xargs, $2; # skip checking meta between quotes
  100. #               } elsif ($arg =~ /[\$\&\*\(\)\{\}\[\]\`\;\|\?\n~<>]/) {
  101.         } elsif ($arg =~ /[\&\*\(\)\{\}\[\]\`\;\|\?\n~<>]/) {
  102.             __log("Meta characters not allowed: ($arg) $cmd");
  103.             return undef;
  104.         } elsif ($arg =~ /\W\$/) {
  105.             __log("Meta characters not allowed: ($arg) $cmd");
  106.         } else {
  107.             push @xargs, untaint($arg);
  108.         }
  109.     }
  110.     if ($rd2) {
  111.         # redirect both 2 and 1 to the same place
  112.         if (defined $fout) {
  113.             ($ferr, $merr) = ($fout, $mout);
  114.         } elsif (defined $ferr) {
  115.             ($fout, $mout) = ($ferr, $merr);
  116.         } elsif ($rd2 == 1) {
  117.             open STDERR, ">&STDOUT" or die "cannot dup STDERR to STDOUT:$!\n";
  118.             select STDERR; $|=1;
  119.             select STDOUT; $|=1;
  120.         } elsif ($rd2 == 2) {
  121.             open STDOUT, ">&STDERR" or die "cannot dup STDOUT to STDERR:$!\n";
  122.             select STDOUT; $|=1;
  123.             select STDERR; $|=1;
  124.         }
  125.     }
  126.     unless ($xcmd) {
  127.         __log("Command parsing error: $cmd");
  128.         return undef;
  129.     }
  130.  
  131.     # need to untaint $cmd. otherwise the whole hash will be tainted.
  132.     # but $cmd will never be used for exec anyway, only for debug.
  133.     my $params = { cmd => untaint($cmd), xcmd => $xcmd, xargs => \@xargs };
  134.     $params->{fstdout} = $fout if $fout;
  135.     $params->{mstdout} = $mout if $mout;                                
  136.     $params->{fstderr} = $ferr if $ferr;
  137.     $params->{mstderr} = $merr if $merr;
  138.     $params->{fstdin} = $fin if $fin;
  139.     $params->{mstdin} = $min if $min;
  140.    
  141.     return $params;
  142. }
  143.  
  144. # executed by a child process or our version of exec
  145. sub __execo {
  146.     my $params = shift;
  147.  
  148.     unless ($params->{mstdout} or $params->{mstderr} or $params->{mstdin}) {
  149.         # if there is no special redirect requirements, we simply execute
  150.         goto execute;
  151.     }
  152.    
  153.     # if stdout goes into a file, we reopen STDOUT to that file
  154.     if (exists $params->{fstdout}) {
  155.         if ($params->{fstdout} eq "/dev/null") {
  156.             CORE::close(STDOUT);
  157.             unless (CORE::open(STDOUT, ">/dev/null")) {
  158.                 __die("__execo: cannot open /dev/null");
  159.             }
  160.         } else {
  161.             my $stdout = gensym;
  162.             unless (CORE::open($stdout,
  163.                                $params->{mstdout} . $params->{fstdout})) {
  164.                 __die("__execo: cannot open " . $params->{fstdout});
  165.             }
  166.             my $fd = fileno($stdout);
  167.             unless (CORE::open(*STDOUT, ">&=$fd")) {
  168.                 __die("__execo: dup STDOUT to " . $params->{fstdout});
  169.             }
  170.             CORE::close($stdout);
  171.         }
  172.     }
  173.     # if stderr goes into a file, we reopen STDERR to that file
  174.     if (exists $params->{fstderr}) {
  175.         if ($params->{fstderr} eq "/dev/null") {
  176.             CORE::close(STDERR);
  177.             unless (CORE::open(STDERR, ">/dev/null")) {
  178.                 __die("__execo: cannot open /dev/null");
  179.             }
  180.         } else {
  181.             my $stderr = gensym;
  182.             unless (CORE::open($stderr,
  183.                                $params->{mstderr} . $params->{fstderr})) {
  184.                 __die("__execo: cannot open " . $params->{fstderr});
  185.             }
  186.             my $fd = fileno($stderr);
  187.             unless (CORE::open(*STDERR, ">&=$fd")) {
  188.                 __die("__execo: dup STDERR to " . $params->{fstderr});
  189.             }
  190.             CORE::close($stderr);
  191.         }
  192.     }
  193.     # if stdin comes from a file. we need to fork a subprocess to open
  194.     # the file and pump it into us
  195.     if (exists $params->{mstdin}) {
  196.         my $pid = CORE::open(*STDIN, "-|");
  197.         unless (defined $pid) {
  198.             __die("__execo: cannot fork for STDIN input");
  199.         }
  200.         if ($pid) {
  201.         } else {
  202.             local *FILE;
  203.             unless (CORE::open(*FILE, $params->{mstdin} . $params->{fstdin})) {
  204.                 __die("__execo: cannot open " . $params->{fstdin});
  205.             }
  206.             print <FILE>;
  207.             __exit(0);
  208.         }
  209.     }
  210.  
  211.     execute:
  212.     __setenv();
  213.     if ($__debug_level > 0) {
  214.         __log("__execo $$: $params->{xcmd}, " .
  215.               join('|', @{$params->{xargs}}));
  216.         __log("__execo $$: redirects: " .
  217.               join(', ', map { "$_: " . ($params->{$_} ? $params->{$_} : "") }
  218.                    (qw(fstdout fstderr fstdin mstdout mstderr mstdin))));
  219.     }
  220.     (@{$params->{xargs}} > 0
  221.      ? CORE::exec $params->{xcmd}, @{$params->{xargs}}
  222.      : CORE::exec $params->{xcmd});
  223.  
  224.     __die("__execo $$ failed $!");
  225. }
  226.  
  227. # open regular file only (mostly)
  228. sub open ($$) {
  229.     my $fh = shift;
  230.     my $filename = shift;
  231.  
  232.     __log("open $fh, $filename");
  233.    
  234.     unless ($fh =~ /^\*(.+::)?(\w+)$/) {
  235.         __log("first parameter must be a file handle name");
  236.         return undef;
  237.     }
  238.     if ($2 eq "STDOUT" or $2 eq "STDERR" or $2 eq "STDIN") {
  239.         eval "\$fh = \*$2";
  240.         eval "CORE::close($2)";
  241.     }
  242.     $filename = ($filename =~ /\s*(.*\S)\s*/)[0];
  243.  
  244.     my $ffh;
  245.     my $first = substr($filename, 0, 1);
  246.     my $last = substr($filename, -1, 1);
  247.    
  248.     if ($first eq '>' || $first eq '<') {
  249.         # STDOUT, dup e.g. >&=2, <&=0, or dup e.g. >&STDOUT
  250.         if ($filename eq ">-" || $filename =~ /^(<|>)&=\d+$/) {
  251.             return CORE::open($fh, $filename);
  252.         }
  253.         if ($filename =~ /^>&(\w+)$/) {
  254.             unless (($1 eq "STDOUT") or ($1 eq "STDERR") or ($1 eq "STDIN")) {
  255.                 my $caller = caller;
  256.                 $filename = ">&" . $caller . "::$1";
  257.             }
  258.             return CORE::open($fh, $filename);
  259.         }
  260.         if ($filename =~ /^(>>?)\s*(.+)$/) { # e.g. >>file, >file
  261.             $ffh = ds_open($2, ($1 eq ">" ? "w" : "a"));
  262.         } elsif ($filename =~ /^(<)\s*(.+)$/) { # e.g. <file
  263.             $ffh = ds_open($2, "r");
  264.         }
  265.     } elsif ($first eq '+') {
  266.         if ($filename =~ /^\+<\s*(.+)$/) { # e.g. +< abc
  267.             $ffh = ds_open($1, "r+");
  268.         } elsif ($filename =~ /^\+(>>?)\s*(.+)$/) { # e.g. +> abc, +>>abc
  269.             $ffh = ds_open($2, ($1 eq ">>" ? "a+" : "w+"));
  270.         }
  271.     } elsif ($first eq '|' or $last eq '|') {
  272.         if ($filename eq '|-' or $filename eq '-|') {
  273.             return CORE::open($fh, $filename);
  274.         }
  275.         __log("Open with pipe is not allowed.");
  276.         return undef;
  277.     } elsif ($filename eq '-') {
  278.         return open($fh, $filename); # STDIN
  279.     } else {
  280.         $ffh = ds_open($filename, "r"); # simple file
  281.     }
  282.     unless ($ffh) {
  283.         __log("Open filename '$filename' failed");
  284.         return undef;
  285.     }
  286.     push @{$__file_handles{fileno($ffh)}}, $fh;
  287.     eval " $fh = *{\$ffh}"; # don't ask me why :)
  288.     return $ffh;
  289. }
  290.  
  291. sub popen {
  292.     my $fh = shift;
  293.     unless ($fh =~ /^\*/) {
  294.         __log("first parameter must be a file handle name");
  295.         return undef;
  296.     }
  297.     my $ffh = ds_popen(@_);
  298.     return undef unless ($ffh);
  299.     eval " $fh = *{\$ffh}";
  300.     return $ffh;
  301. }
  302.  
  303. sub ppopen {
  304.     my $fh = shift;
  305.     unless ($fh =~ /^\*/) {
  306.         __log("first parameter must be a file handle name");
  307.         return undef;
  308.     }
  309.     my $ffh = ds_ppopen(@_);
  310.     return undef unless ($ffh);
  311.     eval "$fh = *{\$ffh}";
  312.     return eval $fh . "{IO}";
  313. }
  314.  
  315. sub backtick {
  316.     local $SIG{INT} = 'IGNORE';
  317.     local $SIG{QUIT} = 'IGNORE';
  318.    
  319.     my $pipe = ds_popen(shift, "r");
  320.     return undef unless ($pipe);
  321.     my @result = <$pipe>;
  322.     CORE::close($pipe);
  323.     return (wantarray ? @result : join("", @result));
  324. }
  325.  
  326. sub pbacktick {
  327.     local $SIG{INT} = 'IGNORE';
  328.     local $SIG{QUIT} = 'IGNORE';
  329.    
  330.     my $pipe = ds_ppopen(@_, "r");
  331.     my @result = <$pipe>;
  332.     CORE::close($pipe);
  333.     return (wantarray ? @result : join("", @result));
  334. }
  335. # system3 is kind of multi-arg "system" with redirects
  336. # the last two parameter of system3 call are interpreted, the rest is passed to
  337. # multi-arg exec call which doesn't involve shell
  338. sub system3 {
  339.     my @xargs = @_;
  340.     my $cmdline = join(' ', @xargs);
  341.     my @cmd = (shift @xargs, pop @xargs, pop @xargs);
  342.     my $params = __parsecmd(join(' ', @cmd));
  343.  
  344.     return -1 unless ($params);
  345.  
  346.     $params->{xargs} = \@xargs;
  347.     $params->{cmd} = $cmdline;
  348.  
  349.     # We want SIGINT and SIGQUIT to be ignored in the parent
  350.     # while the child is running.  However, we want the child
  351.     # to get these signals -- so we declare a block around
  352.     # the code that ignores SIGINT such that the child will
  353.     # exec with the signals turned on.
  354.     {
  355.         local $SIG{INT} = 'IGNORE';
  356.         local $SIG{QUIT} = 'IGNORE';
  357.         flush STDOUT; flush STDERR; flush STDIN;
  358.  
  359.         my $pid = fork;
  360.         unless (defined $pid) {
  361.             __log("system: cannot fork $!");
  362.             return -1;
  363.         }
  364.         if ($pid) {
  365.             waitpid $pid, 0;
  366.             return $?;
  367.        }
  368.     }
  369.     return __execo $params;
  370. }
  371.  
  372. # system2 is kind of multi-arg "system" with redirects
  373. # the last parameter of system2 call is interpreted, the rest is passed to
  374. # multi-arg exec call which doesn't involve shell
  375. sub system2 {
  376.     my @xargs = @_;
  377.     my $cmdline = join(' ', @xargs);
  378.     my @cmd = (shift @xargs, pop @xargs);
  379.     my $params = __parsecmd(join(' ', @cmd));
  380.  
  381.     return -1 unless ($params);
  382.  
  383.     $params->{xargs} = \@xargs;
  384.     $params->{cmd} = $cmdline;
  385.  
  386.     # We want SIGINT and SIGQUIT to be ignored in the parent
  387.     # while the child is running.  However, we want the child
  388.     # to get these signals -- so we declare a block around
  389.     # the code that ignores SIGINT such that the child will
  390.     # exec with the signals turned on.
  391.     {
  392.         local $SIG{INT} = 'IGNORE';
  393.         local $SIG{QUIT} = 'IGNORE';
  394.         flush STDOUT; flush STDERR; flush STDIN;
  395.  
  396.         my $pid = fork;
  397.         unless (defined $pid) {
  398.             __log("system: cannot fork $!");
  399.             return -1;
  400.         }
  401.         if ($pid) {
  402.             waitpid $pid, 0;
  403.             return $?;
  404.        }
  405.     }
  406.     return __execo $params;
  407. }
  408.  
  409. # If last parameter involves redirection, use system2 call instead.
  410. # redirections don't work with CORE::system.
  411. sub system {
  412.     return CORE::system(@_) if (@_ > 1);
  413.     my $params = __parsecmd(join(' ', @_));
  414.     return -1 unless ($params);
  415.  
  416.     # We want SIGINT and SIGQUIT to be ignored in the parent
  417.     # while the child is running.  However, we want the child
  418.     # to get these signals -- so we declare a block around
  419.     # the code that ignores SIGINT such that the child will
  420.     # exec with the signals turned on.
  421.     {
  422.         local $SIG{INT} = 'IGNORE';
  423.         local $SIG{QUIT} = 'IGNORE';
  424.         flush STDOUT; flush STDERR; flush STDIN;
  425.      
  426.         my $pid = fork;
  427.         unless (defined $pid) {
  428.             __log("system: cannot fork $!");
  429.             return -1;
  430.         }
  431.         if ($pid) {
  432.             waitpid $pid, 0;
  433.             return $?;
  434.         }
  435.     }
  436.     return __execo $params;
  437. }
  438.  
  439. sub psystem {
  440.     local $SIG{INT} = 'IGNORE';
  441.     local $SIG{QUIT} = 'IGNORE';
  442.     my $pid = fork;
  443.     unless (defined $pid) {
  444.         __log("system: cannot fork $!");
  445.         return -1;
  446.     }
  447.     if ($pid) {
  448.         waitpid $pid, 0;
  449.         return $?;
  450.     }
  451.     my $r = ds_ppopen(@_, "n");
  452.     return ((defined $r) ? $r : -1);
  453. }
  454.  
  455. # exec2 is kind of multi-arg "exec" with redirects
  456. # the last parameter of exec2 call is interpreted, the rest is passed to
  457. # multi-arg exec call which doesn't involve shell
  458. sub exec2 {
  459.     my @xargs = @_;
  460.     my $cmdline = join(' ', @xargs);
  461.     my @cmd = (shift @xargs, pop @xargs);
  462.     my $params = __parsecmd(join(' ', @cmd));
  463.  
  464.     return -1 unless ($params);
  465.  
  466.     $params->{xargs} = \@xargs;
  467.     $params->{cmd} = $cmdline;
  468.  
  469.     return __execo $params;
  470. }
  471.  
  472.  
  473. sub exec {
  474.     return CORE::exec(@_) if (@_ > 1);
  475.     my $params = __parsecmd(join(' ', @_));
  476.     unless ($params) {
  477.         __log("Command parse error @{[ join(' ', @_) ]}");
  478.         return 0;
  479.     }
  480.     return __execo $params;
  481. }
  482.  
  483. # Only opens regular file. No pipes or commands. Basically fopen() in C.
  484. sub ds_open ($;$) {
  485.     my $file = shift;
  486.     my $mode = shift || "r";
  487.    
  488.     if ($file =~ /\|$/ or $file =~ /^\|/) {
  489.         __log("ds_open() only for regular file. Use popen() for pipe");
  490.         return undef;
  491.     }
  492.     if ($file =~ /[<>]+/) {
  493.         __log("Invalid file name $file");
  494.         return undef;
  495.     }
  496.  
  497.     if    ($mode eq "r" ) { $mode = O_RDONLY }
  498.     elsif ($mode eq "r+") { $mode = O_RDWR }
  499.     elsif ($mode eq "w" ) { $mode = O_WRONLY | O_TRUNC  | O_CREAT }
  500.     elsif ($mode eq "w+") { $mode = O_RDWR   | O_TRUNC  | O_CREAT }
  501.     elsif ($mode eq "a" ) { $mode = O_APPEND | O_WRONLY | O_CREAT }
  502.     elsif ($mode eq "a+") { $mode = O_APPEND | O_RDWR   | O_CREAT }
  503.     else  {
  504.         __log("Invalid mode $mode to open");
  505.         return undef;
  506.     }
  507.     # Use sysopen to avoid the meta char stuff. Also umask is automatically
  508.     # set to 0666 on the file to write.
  509.     my $fh = gensym;
  510.     unless (sysopen($fh, $file, $mode)) {
  511.         __log("Cannot open $file: $!");
  512.         return undef;
  513.     }
  514.     $__file_handles{fileno($fh)} = [ $fh ];
  515.     return $fh;
  516. }
  517.  
  518. # Open single-step pipe
  519. sub ds_popen {
  520.     my $params = __parsecmd(shift);
  521.     return undef unless ($params);
  522.    
  523.     my $type = shift || "r";
  524.     my $pipe = ($type eq "r" ? "-|" : "|-");
  525.    
  526.     flush STDOUT; flush STDERR; flush STDIN;
  527.  
  528.     local *PIPE;
  529.     my $pid = CORE::open(PIPE, $pipe);
  530.     unless (defined $pid) {
  531.         __log("Cannot open pipe");
  532.         return undef;
  533.     }
  534.     if ($pid) {
  535.         return *PIPE;
  536.     }
  537.     return __execo $params;
  538. }
  539.  
  540. # Open multi-step pipes
  541. sub ds_ppopen {
  542.     my $mode = pop @_;
  543.     unless (grep /$mode/, (qw(r w n))) {
  544.         __log "Invalid mode $mode";
  545.         return undef;
  546.     }
  547.     my @commands;
  548.     for my $i (0..$#_) {
  549.         my $params = __parsecmd($_[$i]);
  550.         return undef unless ($params);
  551.         push @commands, $params;
  552.     }
  553.     local *PIPE;        
  554.     flush STDOUT; flush STDERR; flush STDIN;
  555.    
  556.     my $pipe = ($mode eq "w" ? "|-" : "-|");
  557.     if($mode ne 'n'){
  558.         my $pid = CORE::open(PIPE, $pipe);
  559.         unless (defined $pid) {
  560.             __log("Cannot fork");
  561.             return undef;
  562.         }
  563.        
  564.         if ($pid) {
  565.             $__ppwrite_handles{fileno(*PIPE)} = 1 if ($mode eq "w");
  566.             return *PIPE;
  567.         }
  568.     }
  569.  
  570.     dopipe:
  571.     # We fork the process to exec commands in the pipe from left to right
  572.     # if it is a "write" pipe, e.g. "|a|b|c", and from right to left
  573.     # otherwise, e.g. "a|b|c|", or "a|b|c". Therefore if it is not a "write"
  574.     # pipe, the parent (e.g. "c") should dup STDIN to the pipe handle.
  575.     my $params = ($mode eq "w" ? shift @commands : pop @commands);
  576.  
  577.     my $pipe_fh = gensym;
  578.     if (@commands) {
  579.         my $pid = CORE::open($pipe_fh, $pipe);
  580.         unless (defined $pid) {
  581.             __die("Cannot fork for $params->{xcmd}");
  582.         }
  583.         if ($pid) {
  584.             my $duped;
  585.             my $fd = fileno $pipe_fh;
  586.             if ($mode eq "w") {
  587.                 unless (defined $params->{fstdout}) {
  588.                     unless ($duped = CORE::open(STDOUT, ">&=$fd")) {
  589.                         __die("Cannot dup PIPE");
  590.                     }
  591.                 }
  592.                 unless (defined $params->{fstderr}) {
  593.                     unless ($duped = CORE::open(STDERR, ">&=$fd")) {
  594.                         __die("Cannot dup PIPE");
  595.                     }
  596.                 }
  597.             } else {
  598.                 unless ($duped = CORE::open(STDIN, "<&=$fd")) {
  599.                     __die("Cannot dup STDIN");
  600.                 }
  601.             }
  602.             CORE::close($pipe_fh) if $duped;
  603.             return __execo $params;
  604.         } else {
  605.             goto dopipe; # child, fetch next command to exec.
  606.         }
  607.     } else {
  608.         return __execo $params;
  609.     }
  610. }
  611.  
  612. sub ds_cleanup {
  613.     __log("ds_cleanup...");
  614.     for my $f (@__temp_files) {
  615.         close($f->[0]);
  616.         if (-f $f->[1]) {
  617.             unlink $f->[1] or __log("Cannot unlink temp file $f->[1]: $!");
  618.         }
  619.     }
  620.     for my $f (keys %__file_handles) {
  621.         for my $fh (@{$__file_handles{$f}}) {
  622.             unless ($fh =~ /(STDOUT)|(STDERR)|(STDIN)/) {
  623.                 eval "close(\$fh); undef $fh";
  624.             }
  625.         }
  626.     }
  627. }
  628.  
  629. sub maketemp {
  630.     my $dir = shift || "/tmp";
  631.     my $tries = 0;
  632.     my $path;
  633.     my $fh = gensym;
  634.     while ($tries++ < 100) {
  635.         $path = $dir . '/ds_' . rand(time() ^ ($$ + ($$ << 15)));
  636.         $path =~ s/\.//g;
  637.         next if (-e $path);
  638.         if (CORE::open($fh, ">$path")) {
  639.             my @ret = ($fh, $path);
  640.             push @__temp_files, \@ret;
  641.             return (wantarray ? @ret : $fh);
  642.         }
  643.     }
  644.     __log("Cannot create temp files in $dir");
  645.     return undef;
  646. }
  647.  
  648. sub close ($) {
  649.     my $fh = shift;
  650.     my $fileno = fileno $fh;
  651.     CORE::close($fh);
  652.     if (defined $__ppwrite_handles{$fileno}) {
  653.         delete $__ppwrite_handles{$fileno};
  654.         select(undef, undef, undef, 0.001);
  655.     }
  656.     for my $h (@{$__file_handles{$fileno}}) {
  657.         CORE::close($h);
  658.         eval "undef $h";
  659.     }
  660.     delete $__file_handles{$fileno};
  661. }
  662.  
  663. sub fcntl {
  664.     __log "fcntl is disabled";
  665.     return undef;
  666. }
  667.  
  668. sub ioctl {
  669.     __log "ioctl is disabled";
  670.     return undef;
  671. }
  672.  
  673. sub untaint {
  674.     my $arg = shift;
  675.     my $reg = shift if @_;
  676.    
  677.     unless ($reg) {
  678.         if ($arg =~ /^([^\000-\010\013\014\016-\037\177]*)$/) {
  679.             return $1;
  680.         }
  681.         __log("String with unprintable chars detected: $arg");
  682.         return "";
  683.     }
  684.     return "";
  685. }
  686.  
  687. sub is_tainted {
  688.     local (@_, $@, $^W) = @_;
  689.     not eval { kill 0, join("", @_); 1; }
  690. }
  691.  
  692. 1;
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top