Poor man’s IDS… part 4 – mail-output.pl

This one is a pure steal from Roderick Schertler.  the RS-Handy perl module is required to run it.  See the RS-Handy documentation here.  It is the program which mails out the reports.

NEEDS: Perl Modules

Proc::SyncExec
Proc::WaitStat
RS::Handy
String::ShellQuote

#!/usr/bin/perl -w
use strict;

# $Id: mail-output,v 1.18 2013-05-08 12:55:46-04 roderick Exp $
#
# Roderick Schertler

# Copyright (C) 2001 Roderick Schertler
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# For a copy of the GNU General Public License write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use sigtrap qw(die untrapped normal-signals); # process END in these cases

use Proc::SyncExec    qw(fork_retry);
use Proc::WaitStat    qw(waitstat waitstat_die);
use RS::Handy        qw($Me getopt have_prog safe_tmp rfc822_dt xdie);
use String::ShellQuote    qw(shell_quote);

my @Sendmail    = qw(sendmail /usr/sbin/sendmail /usr/lib/sendmail);

my $Debug    = 0;
my $Empty    = 0;
my $Exit    = 0;
my $Failure_only = 0;
my $Out_file    = undef;
my $Pid        = $$;
my @Recip    = ();
my $Sendmail    = undef;
my $Subject    = undef;
my $Version    = q$Revision: 1.18 $ =~ /(\d\S+)/ ? $1 : ‘?’;

my @Option_spec = (
    ‘debug!’        => \$Debug,
    ’empty|e’        => \$Empty,
    ‘failure-only|f’    => \$Failure_only,
    ‘help!’        => sub { usage() },
    ‘recip|r=s@’    => \@Recip,
    ‘sendmail=s’    => \$Sendmail,
    ‘subject|s=s’    => \$Subject,
    ‘version’        => sub { print “$Me version $Version\n”; exit },
);

my $Usage = <    set recipient (default you), can be used multiple times
     –sendmail    use to send the mail
 -s, –subject    set message subject
     –version        show the version ($Version) and exit
Use \`perldoc $Me\’ to see the full documenation.
EOF

sub xwarn {
    RS::Handy::xwarn @_;
    $Exit ||= 1;
}

sub debug {
    print STDERR “debug: “, @_, “\n” if $Debug;
}

sub usage {
    xwarn @_ if @_;
    # Use exit() rather than die(), as Getopt::Long does eval().
    print STDERR $Usage;
    exit 1;
}

sub init {
    getopt -bundle, @Option_spec or usage if @ARGV;

    push @Recip, $ENV{EMAIL} || $ENV{LOGNAME} || $ENV{USER}
            || getlogin || getpwuid($<)
            || xdie “cannot figure out your login name\n”
    unless @Recip;
    debug “recip = [“, join(“] [“, @Recip), “]”;

    if (defined $Sendmail) {
        have_prog $Sendmail
        or xdie “–sendmail program $Sendmail does not exist\n”;
    }
    else {
        $Sendmail = have_prog @Sendmail;
        if (!defined $Sendmail) {
            local $” = ‘, ‘;
            xdie “cannot find sendmail program (tried @Sendmail),”,
                 ” specify it with –sendmail\n”;
        }
    }
    debug “sendmail = $Sendmail”;

    $SIG{HUP} = ‘IGNORE’;
    if (-t STDIN) {
        open STDIN, “/dev/null” or xdie “cannot open /dev/null for stdin:”;
    }
}

sub main {
    init;
    @ARGV or usage;
    my @cmd = @ARGV;
    my $cmd_name = $cmd[0];

    ($Out_file, my $out_fh) = safe_tmp;

    select $out_fh;    $| = 1;
    select STDOUT;    $| = 1;

    my $recip = join “, “, @Recip;
    $recip =~ s/\n(^[\040\t])/\n\t$1/g;
    $Subject = “$Me: ” . shell_quote @cmd if !defined $Subject;
    $Subject =~ s/\n.*//s;
    print $out_fh
        “To: $recip\n”,
        “Subject: $Subject\n”,
        “X-Started-At: “, rfc822_dt, “\n”,
        “\n”
        or xdie “error writing to $Out_file:”;
    my $body_pos = tell $out_fh;
    debug “body_pos = $body_pos”;

    my $do_send = undef;
    my $pid = fork_retry;
    if (!$pid) {
        my $fd = fileno $out_fh;
        open STDOUT, “>&=$fd”    or xdie “child open of STDOUT:”;
        open STDERR, “>&STDOUT”    or xdie “child open of STDERR:”;
        $^W = 0; # I will check my own errors, thankyouverymuch.
        exec @cmd        or xdie “cannot exec $cmd_name:”;
    }
    if (waitpid($pid, 0) == -1) {
        xwarn “waitpid returned -1?! ($!)\n”;
    }
    elsif ($? != 0) {
        debug “sending enabled due to failure”;
        $do_send = 1;
        print $out_fh “$Me: non-zero exit (“, waitstat($?),
            “) from $cmd_name\n”
            or xwarn “error writing to $Out_file:”;
    }

    seek $out_fh, 0, 2 or xdie “error seeking to EOF of $Out_file:”;
    my $final_pos = tell $out_fh;
    debug “final_pos = $final_pos”;

    if ($final_pos == $body_pos && $Empty) {
        debug “no output”;
        print $out_fh “$Me: no output generated by $cmd_name\n”
            or xwarn “error writing to $Out_file:”;
        $final_pos = tell $out_fh;
    }

    if ($final_pos != $body_pos && !$Failure_only) {
        debug “sending enabled due to non-empty body”;
        $do_send = 1;
    }

    if ($Debug) {
        debug “message:”;
        seek $out_fh, 0, 0 or xwarn “error seeking in $Out_file:”;
        print while <$out_fh>;
    }

    if (!$do_send) {
        debug “not sending message”;
    }
    else {
        debug “sending message”;
        # This has to be a sysseek() rather than a seek() since it needs
        # to be done at the kernel level before I fork()/exec() the
        # $Sendmail program.
        sysseek $out_fh, 0, 0 or xdie “error seeking in $Out_file:”;
        open STDIN, “<&” . fileno $out_fh
            or xdie “cannot dup $Out_file to stdin:”;
        system $Sendmail, @Recip;
        waitstat_die $?, $Sendmail;
    }
    return 0;
}

END {
    if ($$ == $Pid && defined $Out_file && !unlink $Out_file) {
        xwarn “error unlinking $Out_file:”;
        $? ||= 1;
    }
}

$Exit = eval { main } || $Exit;
die $@ if $@;
exit $Exit;