#!/usr/bin/perl -w
use strict;
use Fcntl qw(:DEFAULT :flock);

use vars qw (%spamcerr);
%spamcerr= (
   64 => "command line usage error",
   65 => "data format error",
   66 => "cannot open input",
   67 => "addressee unknown",
   68 => "host name unknown",
   69 => "service unavailable",
   70 => "internal software error",
   71 => "system error (e.g., can't fork)",
   72 => "critical OS file missing",
   73 => "can't create (user) output file",
   74 => "input/output error",
   75 => "temp failure; user is invited to retry",
   76 => "remote error in protocol",
   77 => "permission denied",
   78 => "configuration error",
);


my $pipecmd = '/usr/local/bin/spamc -c -x -t60 -u @@@USERNAME@@@';

my $msgfile = $ARGV[0]         || die "no message defined\n";
open(MSG, "<$msgfile")         || die "can't open message for reading\
+n";
my $message = join('',<MSG>);
close(MSG)                     || die "can't close msgfile $msgfile\n"
+;

my $output = pipecmd_msg($pipecmd, \$message);

print "The output returned is $output\n";
print "The status returned is $?\n";


sub pipecmd_msg {
   # refer to perlopentut and perlipc for more information.
   my ($pipecmd, $r_message)=@_;

   my $username=getpwuid($>);   # username of euid
   $pipecmd=~s/\@\@\@USERNAME\@\@\@/$username/g;

print "pipecmd: $pipecmd\n";

   my ($outfh, $outfile)=mktmpfile('spamcheck.out');
   my ($errfh, $errfile)=mktmpfile('spamcheck.err');

   chmod 0666, $outfile, $errfile;

   local $|=1; # flush all output

   # alias STDERR and STDOUT to get the output of the pipe
   open(STDERR,">&=".fileno($errfh)) or return("dup STDERR failed: $!"
+);
   open(STDOUT,">&=".fileno($outfh)) or return("dup STDOUT failed: $!"
+);

   local $SIG{PIPE} = 'IGNORE'; # don't die if the fork pipe breaks

   my ($out, $err, $errmsg);
   open(P, "|$pipecmd") or return("can't fork to pipecmd: $! pipecmd: 
+$pipecmd");
   if (ref($r_message) eq 'ARRAY') {
      print P @{$r_message} or return("can't write to pipe: $!");
   } else {
      print P ${$r_message} or return("can't write to pipe: $!");
   }
   # automatic reaping happening here? :(
   close(P); # don't warn because spamc may exit successfully on its o
+wn, breaking the pipe

   # If a message is spam, spamc will exit with 1.
   # If a message is not spam, spamc will exit with 0.
   # If there is an error, spamc will exit with some other value.
   my $exit_status = $? >> 8;
   unless ($exit_status == 1 || $exit_status == 0) {
      return("pipe problem = check spamc and spamd are working = statu
+s: $? exit_status: $exit_status");
   }

   close($errfh) or return("can't close errfh: $!");
   close($outfh) or return("can't close outfh: $!");

   sysopen(F, $errfile, O_RDONLY) or return("can't open errfile $errfi
+le: $!");
   $err = <F>;
   close(F) or return("can't close errfile $errfile: $!");
   # unlink $errfile;

   sysopen(F, $outfile, O_RDONLY) or return("can't open outfile $outfi
+le: $!");
   $out = <F>;
   close(F) or return("can't close errfile $outfile: $!");
   # unlink $outfile;

   return $err if (defined $err && $err ne '' && $err !~ m/^\s+$/s);
   return $out;
}

sub mktmpfile {
   my $fh= do { local *FH };
   for (1..5) {
      my $n=rand();
      $n=~s/^0.0*//;
      $n=substr($n,0,8);
      my $fname=untaint("./tmp.$_[0].$$-$n");
      return($fh, $fname) if (sysopen($fh, $fname, O_RDWR|O_CREAT|O_EX
+CL));
   }
   return;
}

sub untaint {
   local $_ = shift;    # this line makes param into a new variable. d
+on't remove it.
   local $1;            # fix perl $1 taintness propagation bug
   m/^(.*)$/s;
   return $1;
}
[download]

Now I'm really stumped. This code works fine on the command line as is. However, when I put the pipecmd code into my CGI the fork always exits before the close() on the P filehandle with a status of -1. Reading perlipc I see that this is the status when a process is automatically reaped. But why is it reaping automatically under CGI and not from the commandline? Is there a better way to fork to spamc and capture the STDOUT while feeding it STDIN?

Thanks!