API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Oct 14th, 2019
276
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 20.43 KB | None | 0 0
raw download clone embed print report
  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;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!