4

Tenho instalado o Open WebMail, tenho varias contas mais em algumas contas assim que é enviado um e-mail para elas, retorna o erro abaixo, mais eles recebem a mensagem, alguém já viu e ou imagina o que pode ser?

De: Mail Delivery System [[email protected]]

Para: [email protected]

Assunto: Undelivered Mail Returned to Sender


This is the Postfix program at host sbmproxy.empresa.intra.

I'm sorry to have to inform you that your message could not be delivered to one or more recipients. It's attached below.

For further assistance, please send mail to <postmaster>

If you do so, please include this problem report. You can delete your own text from the attached returned message.

          The Postfix program

<[email protected]>: Command died with status 32: "
    /srv/www/cgi-bin/openwebmail/vacation.pl -t60s -a [email protected]
    -a [email protected]  joao". Command output: Sendmail died
    unexpectedly: Broken pipe

Segue código do vacation.pl:

#!/usr/bin/perl
#
# vacation.pl - vacation program
#
# Larry Wall <lwall.AT.jpl-devvax.jpl.nasa.gov>
# updates by Tom Christiansen <tchrist.AT.convex.com>
# updates by Chung-Kie Tung <tung.AT.turtle.ee.ncku.edu.tw>
# updates by Scott Mazur <scott.AT.littlefish.ca> - added -p path option
#

#
# syntax:
#
#   vacation.pl [ -I|-i ]
#      init vacation db
#
#   vacation.pl [ -j ] [ -a alias ] [-f ifile] [ -tN ] [-d] [-p homepath] username
#      used in ~/.forward file to auto-generate reply message
#
#    username     A message will be replied only if the username
#                 appears as an recipient in To: or Cc:
#
#    -j           Do not check whether the username appears as an
#                 recipient in the To: or the Cc: line.
#
#    -a alias     Indicate that alias is one of the valid names of the
#                 username, so the reply will be generated if the alias
#                 appears in To: or Cc:
#
#    -f ifile     Specify a file containing ignored users. Mails sent
#                 from the ignored users won't be auto-replied
#
#    -tN          Change the interval between repeat replies to  the
#                 same  sender.   The default is 1 week.  A trailing
#                 s, m, h, d, or w scales  N  to  seconds,  minutes,
#                 hours, days, or weeks respectively.
#
#    -p homepath  Specify a directory for the user home.
#                 (mostly for virtual user with no real unix home)
#
#    -d           log debug information to /tmp/vacation.debug
#
#   The options -a and -f can be specified for more than one times.
#
#
#   .forward file will contain a line of the form:
#
#      \username, "|/usr/local/bin/vacation.pl -t1d username"
#
#   .vacation.msg should include a header with at least Subject: line
#
#   For example:
#
#      Subject: I am on vacation
#
#      I am on vacation until July 22.
#      If you have something urgent,
#      please contact cilen (cilen@somehost).
#      --tung
#
#   If the string $SUBJECT appears in the .vacation.msg file, it
#   is  replaced  with  the subject of the original message when
#   the reply is sent; thus, a .vacation.msg file such as
#
#      Subject: I am on vacation
#
#      I am on vacation until July 22.
#      Your mail regarding "$SUBJECT" will be read when I return.
#      If you have something urgent,
#      please contact cilen (cilen@somehost).
#      --tung
#
#   will include the subject of the message in the reply.
#

use strict;
use Fcntl qw(:DEFAULT :flock);

foreach (qw(ENV BASH_ENV CDPATH IFS TERM)) {delete $ENV{$_}}; $ENV{PATH}='/bin:/usr/bin'; # secure ENV

my $myname = $0;
if ($myname !~ m!^/! || ! -x $myname) {
   print "Please execute vacation.pl with full path.\n";
   exit 1;
}

my $sendmail;
if ( -x '/usr/sbin/sendmail') {
   $sendmail='/usr/sbin/sendmail';
} elsif ( -x '/usr/lib/sendmail') {
   $sendmail='/usr/lib/sendmail';
} else {
   die "Sendmail binary not found";
}

my $usage = qq|Usage: vacation.pl -i\n|.
            qq|       vacation.pl [-j] [-a alias] [-tN] username\n|;

my $timeout = 7 * 24 * 60 * 60;      # unit: second, default 1 week

my %scale = (           # set-up time scale suffix ratios
         's', 1,
         'm', 60,
         'h', 60 * 60,
         'd', 24 * 60 * 60,
         'w', 7 * 24 * 60 * 60,
         );

my @ignores = (
           'daemon',
           'postmaster',
           'mailer-daemon',
           'mailer',
           'root',
           );
my @aliases = ();

my ($opt_i, $opt_d, $opt_j, $home_path)=(0,0,0,0);

########## MAIN ##################################################

if (defined $ENV{'GATEWAY_INTERFACE'}) {    # cgi mode
   my $clientip=clientip();
   my $info=$ENV{'HTTP_ACCEPT_LANGUAGE'}; $info.=', ' if ($info ne '');
   $info.=$ENV{'HTTP_USER_AGENT'}; $info=" ($info)" if ($info ne '');
   log_debug("$clientip$info is cracking the system by calling vacation.pl as CGI?");
   sleep 10;
   die "This program should not be called as CGI!\n";
}

# parse options, handle initialization or interactive mode
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
   $_ = shift;
   if (/^-I/i) {  # eric allman's source has both cases
      $opt_i=1;
   } elsif (/^-d/) {      # log debug information to /tmp/vacation.debug
      $opt_d=1;
   } elsif (/^-j/) {      # don't check if user is a valid receiver
      $opt_j=1;
   } elsif (/^-f(.*)/) {   # read ignorelist from file
      push(@ignores, read_list_from_file($1 ? $1 : shift));
   } elsif (/^-a(.*)/) {   # specify alias name
      push(@aliases, $1 ? $1 : shift);
   } elsif (/^-t([\d.]*)([smhdw])/) {   # specify reply once interval
      $timeout = $1;
      $timeout *= $scale{$2} if $2;
   } elsif (/^-p(.*)/) {      # use an alternate home path
      $home_path=$1;
   } else {
      die $usage;
   }
}

if ($opt_i) {
   log_debug($0, "init mode with arg: ", @ARGV,
             "ruid=$<, euid=$>, rgid=$(, egid=$)" ) if ($opt_d);
   init_mode();
} elsif (@ARGV) {
   log_debug($0, "piped mode with arg: ", @ARGV,
             "ruid=$<, euid=$>, rgid=$(, egid=$)" ) if ($opt_d);
   push(@ignores, $ARGV[0]);
   push(@aliases, $ARGV[0]);
   pipe_mode($ARGV[0]);
} else {
   log_debug($0, "interactive mode(no arg)",
             "ruid=$<, euid=$>, rgid=$(, egid=$)") if ($opt_d);
   interactive_mode();
}
exit 0;


########## INIT MODE #############################################
sub init_mode {
   my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];
   my $uid=(getpwnam($user))[2];
   if ($uid != $>) {
      $<=$> if ($>==0);
      $>=$uid;
      log_debug("change to $user euid: ruid=$<, euid=$>") if ($opt_d);
   }
   my $home = $home_path || $ENV{'HOME'} || (getpwnam($user))[7] or die "No home directory for user $user\n";

   # guess real homedir if under automounter
   $home="/export$home" if ( -d "/export$home" );
   $home=untaint($home);

   chdir $home or die "Can't chdir to $home: $!\n";

   init_vacation_db();
}

sub init_vacation_db {
   my %VAC;
   unlink(".vacation", ".vacation.db", ".vacation.pag", ".vacation.dir");
   dbmopen(%VAC, ".vacation", 0600) or die "Can't open vacation dbm files: $!\n";
   %VAC=();
   dbmclose(%VAC);
}

########## INTERACTIVE MODE ######################################
sub interactive_mode {
   my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];
   my $uid=(getpwnam($user))[2];
   if ($uid != $>) {
      $<=$> if ($>==0);
      $>=$uid;
      log_debug("change to $user euid: ruid=$<, euid=$>") if ($opt_d);
   }
   my $home = $home_path || $ENV{'HOME'} || (getpwnam($user))[7] or die "No home directory for user $user\n";
   my $editor = $ENV{'VISUAL'} || $ENV{'EDITOR'} || 'vi';
   my $pager = 'more'; $pager=$ENV{'PAGER'} if (-f $ENV{'PAGER'});

   # guess real homedir if under automounter
   $home="/export$home" if ( -d "/export$home" );
   $home=untaint($home);
   chdir $home or die "Can't chdir to $home: $!\n";

   print qq|This program can be used to answer your mail automatically\n|,
         qq|when you go away on vacation.\n|;

   if (-f '.forward') {
      print "\nYou already have a $home/.forward file containing:\n",
            "------------------------------------------------------\n",
            `cat .forward`, "\n",
            "------------------------------------------------------\n";
      if (yorn("Would you like to remove it and disable the vacation feature? ")) {
         my (%VAC, @keys);
         unlink('.forward') or die "Can't unlink .forward: $!\n";
         if (dbmopen(%VAC, '.vacation', undef)) {
            if (@keys = sort { $VAC{$a} <=> $VAC{$b}; } keys %VAC) {
               require 'ctime.pl';
               print "While you were away, mail was sent to the following addresses:\n\n";
               open(PAGER, "|-") or do { exec(split(/\s+/, $pager)); exit 9 };
               foreach (@keys) {
                  my ($when) = unpack("L", $VAC{$_});
                  printf PAGER "%-20s %s", $_, ctime($when);
               }
               print PAGER "\n";
               close PAGER or die "$pager die unexpectedly: $!";;
            }
            dbmclose(%VAC);
         } else {
            unlink(".vacation", ".vacation.db", ".vacation.pag", ".vacation.dir");
         }
         print "Back to normal reception of mail.\n";
      } else {
         print "Ok, vacation feature NOT disabled.\n";
      }
      return;
   }

   if (-f '.vacation.msg') {
      print "\nYou already have a $home/.vacation.msg containing:\n",
            "------------------------------------------------------\n",
            `cat .vacation.msg`, "\n",
            "------------------------------------------------------\n";
      if ( yorn("Would you like to edit it? ") ) {
         system $editor, '.vacation.msg';
      }
   } else {
      create_default_vacation_msg();
      print qq|\n|,
            qq|I've created a default vacation message in ~/.vacation.msg.\n|,
            qq|This message will be automatically returned to anyone sending you mail\n|,
            qq|while you're out.\n|,
            qq|\n|,
            qq|Press return when ready to continue, and you will enter your favorite\n|,
            qq|editor ($editor) to edit the messasge to your own tastes.\n|;
      local $| = 1;
      print "Press return to continue: ";
      <STDIN>;
      system $editor, '.vacation.msg';
   }

   print qq|\nTo enable the vacation feature a ".forward" file will be created.\n|;
   if (yorn("Would you like to enable the vacation feature now? ")) {
      init_vacation_db();
      create_dot_forward($user, $myname) if (! -f ".forward");
      create_default_vacation_msg() if (! -f ".vacation.msg");
      print qq|\n|,
            qq|Ok, vacation feature ENABLED.\n|,
            qq|Please remember to turn it off when you get back from vacation.\n|,
            qq|Bon voyage!\n|;
   } else {
      print qq|Ok, vacation feature NOT enabled.\n|;
   }

   return;
}

sub create_dot_forward {
   my ($user, $vacation)=@_;
   open(FOR, ">.forward") or die "Can't create .forward: $!\n";
   print FOR qq!\\$user, "|$vacation $user"\n!;
   close FOR;
   return;
}

sub create_default_vacation_msg {
   open(MSG, ">.vacation.msg") or die "Can't create .vacation.msg: $!\n";
   print MSG qq|Subject: This is an autoreply...[Re: \$SUBJECT]\n|,
             qq|\n|,
             qq|I will not be reading my mail for a while.\n|,
             qq|Your mail regarding '\$SUBJECT' will be read when I return.\n|;
   close MSG;
   return;
}

sub yorn {
   my $answer;
   for (;;) {
      print $_[0]; $answer = <STDIN>;
      last if $answer =~ /^[yn]/i;
      print qq|Please answer "yes" or "no" ('y' or 'n')\n|;
   }
   return($answer =~ /^y/i);
}

########## PIPE MODE #############################################
sub pipe_mode {
   my $user = $_[0];
   my ($uid,$home) = (getpwnam($user))[2,7];
   if ($uid != $>) {
      $<=$> if ($>==0);
      $>=$uid;
      log_debug("change to $user euid: ruid=$<, euid=$>") if ($opt_d);
   }
   $home = $home_path if ($home_path);
   if (!$home) {
      log_debug("Error! No home directory for user $user\n") if ($opt_d);
      die "No home directory for user $user\n";
   }

   # guess real homedir if under automounter
   $home="/export$home" if ( -d "/export$home" );
   $home=untaint($home);
   if (! chdir $home) {
      log_debug("Error! Can't chdir to $home: $!\n") if ($opt_d);
      die "Can't chdir to $home: $!\n";
   }

   my ($header, $from, $subject, $to, $cc);

   $/ = ''; # paragraph mode, readin until blank line
   $header = <STDIN>;
   $header =~ s/\n\s+/ /g; # fix continuation lines
   $/ = "\n";

   ($from) = ($header =~ /^From\s+(\S+)/);   # that's the Unix-style From line
   if ($from eq "") {
      log_debug("Error! No 'From ' line!\n") if ($opt_d);
      die "No 'From ' line!\n";
   }

   if ($header =~ /^Precedence:\s*(bulk|junk)/im || $from =~ /-REQUEST@/i ) {
      log_debug("Junk mail, autoreply canceled\n") if ($opt_d);
      exit 0;
   }
   for (@ignores) {
      if ($from =~ /^$_$/i ) {
         log_debug("Message from ignored user $_, autoreply canceled\n") if ($opt_d);
         exit 0;
      }
   }

   ($subject) = ($header =~ /^Subject: +(.*)$/im);
   $subject = "(No subject)" unless $subject;
   $subject =~ s/\s+$//;
   $subject= decode_mimewords($subject);

   ($to) = ($header =~ /^To:\s+(.*)$/im);
   ($cc) = ($header =~ /^Cc:\s+(.*)$/im);
   $to .= ', '.$cc if $cc;

   if (!$opt_j) {
      my $found=0;
      foreach my $name (@aliases) {
         if ($to =~ /\b$name\b/i) {
            $found=1; $to=$name; last;
         }
      }
      if (!$found) {
         log_debug("User", @aliases, "not found in to: and cc:, autoreply canceled\n") if ($opt_d);
         exit 0;
      }
   }

   my (%VAC, $now, $lastdate);
   $now = time;
   if (!dbmopen(%VAC, ".vacation", 0600)) {
      unlink(".vacation", ".vacation.db", ".vacation.pag", ".vacation.dir");
      dbmopen(%VAC, ".vacation", 0600) or die "Can't open vacation dbm files: $!\n";
   }
   $lastdate = $VAC{$from};
   if ($lastdate ne '') {
      ($lastdate) = unpack("L",$lastdate);
      if ($lastdate) {
        if ($now < $lastdate + $timeout) {
           log_debug("Time too short from last reply, autoreply canceled\n") if ($opt_d);
           exit 0;
        }
      } else { # unpack failed, data format error!
        log_debug("Error! Invalid data format in .vacation dbm\n") if ($opt_d);
        exit 1;
      }
   }
   $VAC{$from} = pack("L", $now);
   dbmclose(%VAC);

   create_default_vacation_msg() if (! -f ".vacation.msg");
   my $msg;
   if (open(MSG,'.vacation.msg')) {
      local $/; undef $/; $msg = <MSG>; # read whole file at once
      close MSG;
   }
   $msg=adjust_replymsg($msg, $from, $subject);

   open(MAIL, "|-") or
      do { open(STDERR, ">/dev/null"); exec($sendmail, "-oi", "-f $to", "$from"); exit 9 };
   print MAIL $msg;
   close MAIL or die "Sendmail died unexpectedly: $!\n";

   log_debug("Auto reply for message $subject is sent to $from\n") if ($opt_d);
}

sub read_list_from_file {
   my $file=$_[0];
   die "File $file doesn't exist!\n" if (! -f "$file");

   my @list=();
   if ( sysopen(FILE, $file, O_RDONLY) ) {
      while (<FILE>) {
         push(@list, split);
      }
      close(FILE);
   }
   return(@list);
}

# add proper header to .vacation.msg
# it assumes each header in .vacation.msg takes only 1 line
sub adjust_replymsg {
   my ($msg, $from, $subject)=@_;
   my ($header, $body)=("","");
   my ($has_subject, $has_to, $has_precedence)=(0,0,0);
   my $inheader=1;

   foreach (split(/\n/,$msg)) {
      if ($inheader==0) {
         $body.="$_\n";
         next;
      }
      if (/^Subject: /i) {
         $has_subject=1;
         $header.="$_\n";
      } elsif (/^X\-Spam\-Level\:\ \*\*\*\*\*\*/) {
         # don't reply to this spammy spam message
         log_debug("Abort message $subject due to X-Spam-Level header threshold exceeded.\n") if ($opt_d);
         exit 0; # exit success status
      } elsif (/^To: /i) {
         $has_to=1;
         $header.="$_\n";
      } elsif (/^Precedence: /i) {
         $has_precedence=1;
         $header.="$_\n";
      } elsif (/^[A-Za-z0-9\-]+: /i) {
         $header.="$_\n";
      } else {
         $inheader=0;
         $body.="$_\n";
      }
   }

   if (!$has_to) {
      $header=qq|To: $from\n|.$header;
   }
   if (!$has_subject) {
      $header=qq|Subject: This is an autoreply...[Re: $subject]\n|.$header;
   }
   if (!$has_precedence) {
      $header=$header.qq|Precedence: junk\n|;
   }

   if ($body=~/^\n/) {
      $msg=$header.$body;
   } else {
      $msg=$header."\n".$body;
   }

   # replace '$SUBJECT' token with real subject in original message
   $msg =~ s/\$SUBJECT/$subject/g;   # Sun's vacation does this
   return($msg);
}

########## MIME and DEBUG routines ###############################

# decode_mimewords, decode_base64 and _decode_q are blatantly snatched
# from parts of the MIME-Base64 Perl modules.
sub decode_mimewords {
    my $encstr = shift;
    my %params = @_;
    my @tokens;
    $@ = '';           ### error-return

    ### Collapse boundaries between adjacent encoded words:
    $encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs;
    pos($encstr) = 0;
    ### print STDOUT "ENC = [", $encstr, "]\n";

    ### Decode:
    my ($charset, $encoding, $enc, $dec);
    while (1) {
    last if (pos($encstr) >= length($encstr));
    my $pos = pos($encstr);               ### save it

    ### Case 1: are we looking at "=?..?..?="?
    if ($encstr =~    m{\G             # from where we left off..
                =\?([^?]*)     # "=?" + charset +
                 \?([bq])      #  "?" + encoding +
                 \?([^?]+)     #  "?" + data maybe with spcs +
                 \?=           #  "?="
                }xgi) {
        ($charset, $encoding, $enc) = ($1, lc($2), $3);
        $dec = (($encoding eq 'q') ? _decode_Q($enc) : _decode_B($enc));
        push @tokens, [$dec, $charset];
        next;
    }

    ### Case 2: are we looking at a bad "=?..." prefix?
    ### We need this to detect problems for case 3, which stops at "=?":
    pos($encstr) = $pos;               # reset the pointer.
    if ($encstr =~ m{\G=\?}xg) {
        $@ .= qq|unterminated "=?..?..?=" in "$encstr" (pos $pos)\n|;
        push @tokens, ['=?'];
        next;
    }

    ### Case 3: are we looking at ordinary text?
    pos($encstr) = $pos;               # reset the pointer.
    if ($encstr =~ m{\G                # from where we left off...
             ([\x00-\xFF]*?    #   shortest possible string,
              \n*)             #   followed by 0 or more NLs,
                 (?=(\Z|=\?))      # terminated by "=?" or EOS
            }xg) {
        length($1) or die "mime: empty token";
        push @tokens, [$1];
        next;
    }

    ### Case 4: bug!
    die "mime: unexpected case:\n($encstr) pos $pos";
    }
    return (wantarray ? @tokens : join('',map {$_->[0]} @tokens));
}

sub _decode_B {
   local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]

   my $str = shift;
   my $res = "";

   $str =~ tr|A-Za-z0-9+=/||cd;         # remove non-base64 chars
   $str =~ s/=+$//;                  # remove padding
   $str =~ tr|A-Za-z0-9+/| -_|;         # convert to uuencoded format
   while ($str =~ /(.{1,60})/gs) {
      my $len = chr(32 + length($1)*3/4); # compute length byte
      $res .= unpack("u", $len . $1 );   # uudecode
   }
   $res;
}

sub _decode_Q {
   my $str = shift;
   $str =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;  # RFC-1522, Q rule 1
   $str =~ s/_/\x20/g;                        # RFC-1522, Q rule 2
   $str;
}

sub clientip {
   my $clientip;
   if (defined $ENV{'HTTP_CLIENT_IP'}) {
      $clientip=$ENV{'HTTP_CLIENT_IP'};
   } elsif (defined $ENV{'HTTP_X_FORWARDED_FOR'} &&
            $ENV{'HTTP_X_FORWARDED_FOR'} !~ /^(?:10\.|172\.(?:1[6-9]|2[0-9]|3[0-1])\.|192\.168\.|127\.0\.)/ ) {
      $clientip=(split(/,/,$ENV{'HTTP_X_FORWARDED_FOR'}))[0];
   } else {
      $clientip=$ENV{'REMOTE_ADDR'}||"127.0.0.1";
   }
   return $clientip;
}

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

sub log_debug {
   my @msg=@_;
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
   my ($today, $time);

   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime;
   $today=sprintf("%4d%02d%02d", $year+1900, $mon+1, $mday);
   $time=sprintf("%02d%02d%02d",$hour,$min, $sec);

   open(Z, ">> /tmp/vacation.debug");

   # unbuffer mode
   select(Z); local $| = 1;
   select(STDOUT);

   print Z "$today $time ", join(" ",@msg), "\n";
   close(Z);

   chmod(0666, "/tmp/vacation.debug");
}
4
  • Depois do -a adicione -j -d, vamos ver o que acontece! Commented 28/10/2016 às 16:49
  • Mais esse é um retorno automático do web-mail, você quer que eu vá até esse arquivo ? Commented 28/10/2016 às 16:54
  • Isso, esse retorno ai informa onde ocorreu o problema. Commented 28/10/2016 às 17:28
  • Realmente não consegui encontrar,adicionei a pergunta o vacation.pl Commented 28/10/2016 às 18:12

1 Resposta 1

3
+50

... mas eles recebem a mensagem, alguém já viu e ou imagina o que pode ser?

O trecho de código problemático talvez esteja nessa sub-rotina:

sub pipe_mode {
   ...
   open(MAIL, "|-") or do { .... };
   print MAIL $msg;

   close MAIL or die "Sendmail died unexpectedly: $!\n";
}

Quando você usa |- na função open, indica que deve-se criar um fork do identificador de arquivo aberto, que neste caso é mail para escrita. | é um sinônimo de pipe.

O pipe estabelece uma ponte entre dois processos. Um processo é responsável pela escrita e o outro pela leitura dos dados.

O stdout do programa principal estará conectado ao escritor, e o stdin de mail ao leitor.

O erro Broken pipe ocorre quando o escritor tenta enviar pela ponte mas no outro lado não há um leitor. Quando isso acontece, o Kernel envia o sinal SIGPIPE para o escritor encerrar o programa.

( pipe 7 )

If all file descriptors referring to the read end of a pipe have been closed, then a write will cause a SIGPIPE signal to be generated for the calling process. If the calling process is ignoring this signal, then write fails with the error EPIPE.

Nota: Como pode ser visto acima, se você preferir ignorar o SIGPIPE, tentativas posteriores de escrita resultará no erro EPIPE.

De acordo com a documentação da função open:

Be careful to check the return values from both open and close. If you're writing to a pipe, you should also trap SIGPIPE.

Otherwise, think of what happens when you start up a pipe to a command that doesn't exist: the open will in all likelihood succeed (it only reflects the fork()'s success), but then your output will fail--spectacularly. Perl can't know whether the command worked, because your command is actually running in a separate process. [...]


Para ignorar o SIGPIPE, você pode fazer:

#!/usr/bin/perl

use strict;
use warnings;
# ..
$SIG{PIPE} = "IGNORE";
# ...

sub pipe_mode {
   # ...
   open(MAIL, "|-") or
      do { open(STDERR, ">/dev/null"); exec($sendmail, "-oi", "-f $to", "$from"); exit 9 };
   print MAIL $msg;
   close MAIL or warn "Sendmail died unexpectedly: $?"; # $? Retorna o status, use o warn! 
   # ...
}

Use o warn ao invés de die, assim quando o close não obtiver sucesso, o script não irá ser finalizado, somente exibirá um aviso.

1
  • Não foi exatamente mais foi a base,muito obrigado, depois posto o que foi feito para a correção final, muito obrigado pelas dicas. Commented 4/11/2016 às 3:15

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .