head	1.18;
access;
symbols;
locks; strict;
comment	@# @;


1.18
date	2013.05.08.16.55.46;	author roderick;	state Exp;
branches;
next	1.17;

1.17
date	2006.12.05.13.01.56;	author roderick;	state Exp;
branches;
next	1.16;

1.16
date	2004.08.19.20.40.47;	author roderick;	state Exp;
branches;
next	1.15;

1.15
date	2002.09.16.14.31.28;	author roderick;	state Exp;
branches;
next	1.14;

1.14
date	2002.07.12.16.16.47;	author roderick;	state Exp;
branches;
next	1.13;

1.13
date	2002.01.21.19.54.45;	author roderick;	state Exp;
branches;
next	1.12;

1.12
date	2001.12.10.19.06.50;	author roderick;	state Exp;
branches;
next	1.11;

1.11
date	2001.11.27.14.41.36;	author roderick;	state Exp;
branches;
next	1.10;

1.10
date	2001.11.27.13.33.05;	author roderick;	state Exp;
branches;
next	1.9;

1.9
date	2001.04.03.18.37.56;	author roderick;	state Exp;
branches;
next	1.8;

1.8
date	2000.09.24.14.50.19;	author roderick;	state Exp;
branches;
next	1.7;

1.7
date	99.11.04.15.36.43;	author roderick;	state Exp;
branches;
next	1.6;

1.6
date	99.04.06.02.24.25;	author roderick;	state Exp;
branches;
next	1.5;

1.5
date	98.10.08.18.31.56;	author roderick;	state Exp;
branches;
next	1.4;

1.4
date	97.01.05.00.02.56;	author roderick;	state Exp;
branches;
next	1.3;

1.3
date	96.10.10.19.01.02;	author roderick;	state Exp;
branches;
next	1.2;

1.2
date	96.06.19.16.15.53;	author roderick;	state Exp;
branches;
next	1.1;

1.1
date	96.01.18.16.40.52;	author roderick;	state Exp;
branches;
next	;


desc
@@


1.18
log
@Prefer $EMAIL as default recipient.
@
text
@#!/usr/bin/perl -w
use strict;

# $Id: mail-output,v 1.17 2006-12-05 08:01:56-05 roderick Exp roderick $
#
# Roderick Schertler <roderick@@argon.org>

# 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.17 $ =~ /(\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 = <<EOF;
usage: $Me [switch]... command [arg]...
switches:
     --debug		turn debugging on
 -e, --empty		send mail even if the command doesn't output anything
 -f, --failure-only	only send the mail if the command exits non-zero
     --help		show this and then die
 -r, --recip <addr>	set recipient (default you), can be used multiple times
     --sendmail <prog>	use <prog> to send the mail
 -s, --subject <subj>	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 "can't figure out your login name\n"
	unless @@Recip;
    debug "recip = [", join("] [", @@Recip), "]";

    if (defined $Sendmail) {
	have_prog $Sendmail
	    or xdie "--sendmail program $Sendmail doesn't exist\n";
    }
    else {
	$Sendmail = have_prog @@Sendmail;
	if (!defined $Sendmail) {
	    local $" = ', ';
	    xdie "can't 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 "can't 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'll check my own errors, thankyouverymuch.
	exec @@cmd		or xdie "can't 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 "can't 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;

__END__

=head1 NAME

mail-output - run a command and mail back the output

=head1 SYNOPSIS

B<mail-output>
[B<--debug>]
[B<--empty>|B<-e>]
[B<--failure-only>|B<-f>]
[B<--help>]
[B<--recip>|B<-r> I<addr>]...
[B<--sendmail> I<prog>]
[B<--subject>|B<-s> I<subj>]
[B<--version>]
B<command> [I<arg>]...

=head1 DESCRIPTION

I<mail-output> runs the given I<command> and mails you any output it
generates.  (If there isn't any output no mail is sent.)  If the command
exits with a non-zero status mail is always generated.

I<mail-output> ignores hangup (C<HUP>) signals, so the program it
runs should do the same.  If stdin is a terminal, it's re-opened on
F</dev/null> instead.

I used to hold the output in an unlinked temporary file, but I switched to
using a named one so you can look at the it before the command finishes.
The file's location and name can vary, but usually it'll be called something
like F<mail-output.*> in C<$TMPDIR> or F</tmp>.

=head1 OPTIONS

=over 4

=item B<--debug>

Turn debugging on.

=item B<--empty>

=item B<-e>

Send mail even if the command doesn't output anything and returns 0.

=item B<--failure-only>

=item B<-f>

Don't send the message unless the command exits with a non-zero status.

=item B<--help>

Show the usage message and die.

=item B<--recip> I<address>

=item B<-r> I<address>

Send the mail to I<address>.  Multiple instances of this switch can be
used to send the mail to more than one person, but only put one I<address>
for each instance of B<--recip>.  If you don't use this switch the mail
will be sent back to you.  If you do use this switch then the mail will
only go to the I<address>s you specify.

=item B<--sendmail> I<prog>

Use I<prog> to send the mail.  This program should take the message on
standard input and the recipients as arguments.  If you don't give this
switch B<mail-output> searches for F<sendmail> on your $PATH and in the
usual locations.

=item B<--subject> I<subj>

=item B<-s> I<subj>

Set the subject used for the mail.  The default subject includes the
name of the command run.

=item B<--version>

Show the version number and exit.

=head1 AUTHOR

Roderick Schertler <roderick@@argon.org>

=cut
@


1.17
log
@Add --failure-only.

Add -e, -r switch aliases.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.16 2004-08-19 16:40:47-04 roderick Exp roderick $
d41 1
a41 1
my $Version	= q$Revision: 1.16 $ =~ /(\d\S+)/ ? $1 : '?';
d87 2
a88 1
    push @@Recip, $ENV{LOGNAME} || $ENV{USER} || getlogin || getpwuid($<)
@


1.16
log
@Don't trap ignored signals.

Ignore HUP signals.

Open STDIN on /dev/null if it's a tty.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.15 2002-09-16 10:31:28-04 roderick Exp roderick $
d35 1
d41 1
a41 1
my $Version	= q$Revision: 1.15 $ =~ /(\d\S+)/ ? $1 : '?';
d44 8
a51 7
    'debug!'	=> \$Debug,
    'empty'	=> \$Empty,
    'help!'	=> sub { usage() },
    'recip=s@@'	=> \@@Recip,
    'sendmail=s' => \$Sendmail,
    'subject|s=s' => \$Subject,
    'version'	=> sub { print "$Me version $Version\n"; exit },
d58 2
a59 1
     --empty		send mail even if the command doesn't output anything
d61 1
a61 1
     --recip <addr>	set recipient (default you), can be used multiple times
d136 1
d149 2
d167 16
a182 5
    if ($final_pos != $body_pos) {
    	if ($Debug) {
	    seek $out_fh, 0, 0 or xwarn "error seeking in $Out_file:";
	    print while <$out_fh>;
	}
d217 2
a218 1
[B<--empty>]
d220 1
a220 1
[B<--recip> I<addr>]...
d222 1
a222 1
[B<--subject> I<subj>]
d251 2
d255 6
d267 2
d283 2
@


1.15
log
@s/RJS/RS/
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.14 2002-07-12 12:16:47-04 roderick Exp roderick $
d23 1
a23 1
use sigtrap qw(die normal-signals);	# process END in these cases
d40 1
a40 1
my $Version	= q$Revision: 1.14 $ =~ /(\d\S+)/ ? $1 : '?';
d102 5
d213 4
@


1.14
log
@Allow -s for --subject.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.13 2002-01-21 14:54:45-05 roderick Exp roderick $
d27 1
a27 1
use RJS::Handy		qw($Me getopt have_prog safe_tmp rfc822_dt xdie);
d40 1
a40 1
my $Version	= q$Revision: 1.13 $ =~ /(\d\S+)/ ? $1 : '?';
@


1.13
log
@Use rfc822_dt rather than scalar localtime.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.12 2001-12-10 14:06:50-05 roderick Exp roderick $
d40 1
a40 1
my $Version	= q$Revision: 1.12 $ =~ /(\d\S+)/ ? $1 : '?';
d48 1
a48 1
    'subject=s'	=> \$Subject,
d55 7
a61 7
    --debug		turn debugging on
    --empty		send mail even if the command doesn't output anything
    --help		show this and then die
    --recip <addr>	set recipient (default you), can be used multiple times
    --sendmail <prog>	use <prog> to send the mail
    --subject <subj>	set message subject
    --version		show the version ($Version) and exit
@


1.12
log
@Nicify error message when sendmail isn't found.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.11 2001-11-27 09:41:36-05 roderick Exp roderick $
d27 1
a27 1
use RJS::Handy		qw($Me getopt have_prog safe_tmp xdie);
d40 1
a40 1
my $Version	= q$Revision: 1.11 $ =~ /(\d\S+)/ ? $1 : '?';
d122 1
a122 1
    	    "X-Started-At: ", scalar localtime, "\n",
@


1.11
log
@Clean up for public release.

Search for sendmail on the $PATH and in the usual locations.

Add --empty, --sendmail.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.10 2001-11-27 08:33:05-05 roderick Exp roderick $
d40 1
a40 1
my $Version	= q$Revision$ =~ /(\d\S+)/ ? $1 : '?';
d96 1
@


1.10
log
@Use sysseek() before doing system($Mail).

Add debugging statements.
@
text
@d1 1
a1 1
#!/usr/bin/perl5 -w
d4 25
a28 1
# $Id: mail-output,v 1.9 2001-04-03 14:37:56-04 roderick Exp roderick $
d30 1
a30 10
# I used to hold the output in an unlinked temporary file, but I switched
# to using a named one so you can look at the output before the command
# finishes.

use sigtrap qw(die normal-signals);

use Proc::SyncExec	qw (fork_retry);
use Proc::WaitStat	qw (waitstat waitstat_die);
use RJS::Handy		qw ($Me xwarn xdie getopt safe_tmp);
use String::ShellQuote	qw (shell_quote);
d33 1
a34 1
my @@Option_spec	= qw (help debug! recip=s@@ subject=s);
d36 1
d38 1
a38 1
my $Mail	= 'sendmail';
d40 1
d42 9
a50 6
END {
    if (defined $Out_file && !unlink $Out_file) {
	xwarn "error unlinking $Out_file:";
	$? ||= 1;
    }
}
d55 8
a62 5
    --help
    --debug
    --recip <mailid>
    --subject <subject>
Use \`perldoc $Me\' to see the the full documenation.
d65 3
a67 2
sub usage {
    die $Usage;
d71 8
a78 1
    print "debug: ", @@_, "\n" if $Debug;
d82 1
a82 5
    getopt @@Option_spec or usage	if @@ARGV;
    usage				if $::opt_help or $::opt_help;
    $Debug	= $::opt_debug		if defined $::opt_debug;
    @@Recip	= @@::opt_recip		if @@::opt_recip;
    $Subject	= $::opt_subject	if defined $::opt_subject;
d84 1
a84 1
    push @@Recip, $ENV{LOGNAME} || $ENV{USER} || getlogin || getpwuid ($<)
d87 1
d89 12
a100 1
    debug "recip: [", join("] [", @@Recip), "]";
d111 2
a112 4
    select $out_fh;
    $| = 1;
    select STDOUT;
    $| = 1;
d132 1
d135 7
a141 5
    waitpid ($pid, 0) == -1 and xdie "waitpid returned -1?! ($!)\n";

    unless ($? == 0) {
	print $out_fh "$Me: non-zero exit (", waitstat ($?), ") from @@cmd\n"
	    or xdie "error writing to $Out_file:";
d147 8
d156 4
d162 1
a162 1
    	# $Mail program.
d166 2
a167 2
    	system $Mail, @@Recip;
	waitstat_die $?, $Mail;
d173 7
d192 9
a200 1
B<mail-output> [I<switch>]... B<command> [I<arg>]...
d208 5
d217 37
a253 1
=item B<-recip> I<mail-id>
d255 1
a255 5
Send the mail to I<mail-id>.  Multiple instances of this switch can be
used to send the mail to more than one person, but only put one
I<mail-id> for each instance of B<-recip>.  If you don't use this switch
the mail will be sent back to you.  If you do use this switch then the
mail will only go to the I<mail-id>s you specify.
@


1.9
log
@Use shell_quote on the subject.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.8 2000-09-24 10:50:19-04 roderick Exp roderick $
d60 2
d75 1
d88 1
d105 7
a111 2
    if (tell($out_fh) != $body_pos) {
	seek $out_fh, 0, 0 or xdie "error seeking in $Out_file:";
@


1.8
log
@A number of routines moved out of RJS::Handy a long time ago but were
grandfathered, switch to the new locations.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.7 1999-11-04 10:36:43-05 roderick Exp roderick $
d15 1
d76 1
a76 1
    $Subject = "$Me: @@cmd" if !defined $Subject;
@


1.7
log
@Add --subject switch.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.6 1999-04-05 22:24:25-04 roderick Exp roderick $
d12 1
a12 1
use RJS::Handy		qw ($Me xwarn xdie getopt fork_retry safe_tmp);
d14 1
@


1.6
log
@Use safe_tmp rather than tmpfile.

Put the headers in the file then invoke sendmail with it as stdin,
rather than piping to sendmail.

Add X-Started-At header.
@
text
@d4 1
a4 1
# $Id: mail-output,v 1.5 1998-10-08 14:31:56-04 roderick Exp roderick $
d17 1
a17 1
my @@Option_spec	= qw (help debug! recip=s@@);
d21 1
d33 4
a36 3
    -help
    -debug
    -recip <mailid>
d53 1
d74 2
a75 1
    (my $subject = "@@cmd") =~ s/\n.*//s;
d78 1
a78 1
	    "Subject: $Me: $subject\n",
@


1.5
log
@Use RJS::Handy rather than IBC::Handy.
@
text
@d2 7
d10 1
a10 1
# $Id: mail-output,v 1.4 1997-01-04 19:02:56-05 roderick Exp roderick $
d12 2
a13 6
use strict;
use RJS::Handy qw ($Me xwarn xdie getopt popen_noshell tmpfile
		   fork_retry exitstat exitstat_die);
BEGIN {
    require 'flush.pl';
}
d18 1
d22 7
d63 16
a78 1
    my $output = tmpfile;
a79 2
    # I'm not using open3() here just because I can't both pass it
    # filehandle refs and tell it to dup rather than pipe.
d82 1
a82 2
	# Yuck, how do you dup a glob ref?
	my $fd = fileno $output;
d90 2
a91 2
	print $output "$Me: non-zero exit (", exitstat ($?), ") from @@cmd\n"
	    or xdie 'error writing to output:';
d94 7
a100 16
    flush $output;
    if (-s $output) {
	seek $output, 0, 0 or xdie 'error seeking on output:';
	my ($mail, $pid) = popen_noshell 'w', $Mail, @@Recip;
	my $recip = join ", ", @@Recip;
	$recip =~ s/\n(^[\040\t])/\n\t$1/g;
	(my $subject = "@@cmd") =~ s/\n.*//s;
	print $mail
		"To: $recip\n",
		"Subject: $Me: $subject\n",
		"\n"
	    or xdie "error writing to $Mail:";
	print $mail $_ or xdie "error writing to $Mail:"
	    while defined($_ = <$output>);
	close $mail;
	exitstat_die $?, $Mail;
@


1.4
log
@Use defined() when testing <HANDLE> as a boolean.
@
text
@d3 1
a3 1
# $Id: mail-output,v 1.3 1996-10-10 15:01:02-04 roderick Exp roderick $
d6 1
a6 1
use IBC::Handy qw ($Me xwarn xdie getopt popen_noshell tmpfile
@


1.3
log
@Don't die if C<close $mail> fails, it's a pclose().
@
text
@d3 1
a3 1
# $Id: mail-output,v 1.2 1996-06-19 12:15:53-04 roderick Exp roderick $
d84 1
a84 1
	    while <$output>;
@


1.2
log
@Exec the command directly instead of passing it to sh.
@
text
@d3 1
a3 1
# $Id: mail-output,v 1.1 1996/01/18 16:40:52 roderick Exp roderick $
d7 1
a7 1
		   fork_retry exitstat);
d24 1
a24 1
Use `perldoc $Me' to see the the full documenation.
d85 2
a86 2
	close $mail or xdie "error closing $Mail:";
	$? and xdie "non-zero exit (", exitstat ($?), ") from $Mail\n";
@


1.1
log
@Initial revision
@
text
@d3 1
a3 1
# $Id$
d49 2
a50 2
    my $cmd = "@@ARGV";
    my $cmd_name = $ARGV[0];
d62 1
a62 1
	exec 'sh', '-c', $cmd	or xdie "can't exec sh:";
d67 1
a67 1
	print $output "$Me: non-zero exit (", exitstat ($?), ") from $cmd\n"
d77 1
a77 1
	(my $subject = $cmd) =~ s/\n.*//s;
@