:
# This grossness allows perl to be anywhere in PATH.  Perl would
# interpret #!/bin/sh, so we must hope we get a Bourne shell.
eval 'exec perl -w -S $0 ${1+"$@"}'
  if 0;
# And this grossness allows us to invoke the script via perl -x:
#!perl -w

# abiff 3.4.5 (1999-May-21-Fri)
# by Adam M. Costello
# <amc@cs.berkeley.edu>
#
# Usage (in a .forward file):
#
# "| PATH=/usr/bin /path/to/perl -x /path/to/abiff [-c]
# [-m /path/to/makenotice.pl] user@host ..."
#
# The quote marks are literal, and necessary.  The whole thing probably
# needs to be on one long line.  The value of PATH should be minimal;
# it is only used to find the commands tty and rsh.  Any number of
# user@host arguments may be supplied.  Be sure to forward your mail
# somewhere else as well, such as \username (the backslash prevents an
# infinite alias loop).
#
# abiff looks for elligible terminals in use by each user on the
# corresponding host.  To each terminal it finds, it writes a message
# including the first few lines of the arriving mail.  The remote
# accounts must have .rhost files set up so that abiff can rsh to each
# host using the corresponding user name.  Each remote account must set
# its PATH so that the commands abiff and who can be found.
#
# Without the -c option, eligible terminals are ones with group-execute
# permission that are writable.  With the -c option, eligible terminals
# are ones with owner-execute permission that are writable.  The latter
# criterion is the same one used by normal biff (comsat).
#
# If -c is supplied, and any of the hosts in the argument list are the
# same host on which abiff is running (i.e., the host to which the mail
# was sent), then abiff will skip that host, because it assumes that
# regular biff will take care of it.  "Same host" means "same canonical
# name according to gethostbyname" (or "localhost").
#
# When -c is supplied in the .forward file, the biff command may
# be used to to turn on and off both biff and abiff notification.
# Otherwise, the commands "abiff y" and "abiff n" turn on and off abiff
# notification.  The command "abiff" outputs "is y" or "is n", depending
# on the group-execute bit of the tty.
#
# If -m is supplied, the given perl script must define the subroutine
# makenotice, which takes as its only argument a reference to an array
# of lines (containing the first $linelimit lines of the mail message),
# and returns the notice to be written to the ttys (as a single string),
# or the empty string if a default notice format is to be used, or undef
# if no notification should be done for this message.  Don't forget to
# put "1;" at the end of the file.  The function getfield is defined
# here for your convenience.
#
# I have tried to make abiff secure, but I make no guarantees.  If you
# find a security hole, please tell me!


require 5.002;
use strict;

my $linelimit = 200;
my $abiff = 'abiff';
my $ttyprefix = '/dev/';

use Getopt::Std;

sub getfield;
# $field = getfield \@msg $fieldname
# Returns a (possibly multiline) string containing all instances of the
# specified field in the header of @msg, which is an array of lines.
# Fields spanning multiple lines are joined into single lines.  The
# field name is case-insensitive and does not include the colon.

sub tty;
# ($ttypath, $permissions) = tty;

sub seekout;
# seekout "user@host" $notice;
# Writes $notice to appropriate ttys on host.  Returns TRUE iff it
# thinks it succeeded.

sub defaultnotice;
# $notice = defaultnotice \@msg;
# @msg holds the lines of a mail message.

sub background;
# background sub BLOCK;
# Forks off a process to execute BLOCK.  Returns the child process ID,
# or undef on failure.


umask 077;

if (@ARGV == 0) {
  my ($tty, $perm) = tty;
  print $perm & 010 ? "is y\n" : "is n\n";
  exit;
}

if (@ARGV == 1) {
  if ($ARGV[0] eq 'y') {
    my ($tty, $perm) = tty;
    chmod $perm | 010, $tty  or die 'chmod failed';
    exit;
  }
  if ($ARGV[0] eq 'n') {
    my ($tty, $perm) = tty;
    chmod $perm & ~010, $tty  or die 'chmod failed';
    exit;
  }
}

getopts 'B:cm:';

# Undocumented -B option means perform local notification for the given
# user name.

if ($::opt_B) {
  my @notice = <STDIN>;
  my @who = `who`;
  if ($?) { die 'who failed' };
  my $permbit = $::opt_c ? 0100 : 010;
  my ($user, $tty, $perm);

  foreach (@who) {
    ($user, $tty) = split;
    $tty = $ttyprefix . $tty;
    if ($user eq $::opt_B) {
      $perm = (stat $tty)[2] or next;
      if ($perm & $permbit && open TTY, ">$tty") {
        print TTY @notice;
        close TTY;
      }
    }
  }

  exit;
}

my $thishost;

if ($::opt_c) {
  $thishost = `hostname`
    or $thishost = `uname -n`
      or die "hostname and uname failed";
}

my @msg;

while (! eof STDIN) {
  if (@msg < $linelimit) { push @msg, scalar <STDIN> }
  else { 1 while <STDIN> }

  # The else clause is necessary to prevent a SIGPIPE in the writer
  # process, which would cause an unsuccessful exit status and probably
  # a bounced message.

}

sub getnotice {
  if (! $::opt_m) { return defaultnotice \@msg }

  do {
    local $SIG{'__WARN__'} = sub { $@ = $_[0] };
    no strict;
    do $::opt_m;
  };

  if ($@ ne '') { return "$@\a" }

  my $notice = eval {
    local $SIG{'__WARN__'} = sub { $@ = $_[0] };
    &makenotice(\@msg)
  };

  if ($@ ne '') { return "$@\a" }
  if (! defined $notice) { return undef }
  if ($notice eq '') { return defaultnotice \@msg }
  return $notice;
}

my $notice = getnotice;
defined $notice or exit;

foreach (@ARGV) {
  /^[^@]+@[^@]+$/ or die "abiff: unexpected argument $_";
  background sub { seekout $_, $notice };
}

my $pid;
do { $pid = wait } until $pid == -1;
exit;

sub tty {
  my $tty = `tty`;
  if ($?) { die 'tty failed' };
  chomp $tty;
  my $perm = (stat $tty)[2] or die "stat $tty failed";
  return $tty, $perm;
}

sub seekout {
  my ($user, $host) = split /@/, shift;

  if ($::opt_c) {
    return undef if $host eq 'localhost';
    return undef if (gethostbyname $host)[0] eq (gethostbyname $thishost)[0];
  }

  my $notice = shift;
  my $compat = $::opt_c ? '-c' : '';
  open REMOTE, "|rsh $host -l $user $abiff $compat -B $user" or return undef;
  my $r = print REMOTE $notice;
  close REMOTE;
  return $r;
}

sub defaultnotice {
  my $msgref = shift;
  my @notice;
  my $inbody = 0;

  foreach (@$msgref) {
    last if @notice >= 8;
    $inbody = 1 if /^$/;
    push @notice, $_ if $inbody ? /\S/ : /^(to|from|subject):/i;
  }

  return join '', "\n", @notice, "\a";
}

sub background {
  my $job = shift;
  my $pid = fork;
  return undef if not defined $pid;
  return $pid if $pid;
  &$job();
  exit;
}

sub getfield {
  my $msgref = shift;
  my $fieldname = shift;
  my $field = '';
  my $infield = 0;

  foreach (@$msgref) {
    last if /^$/;
    if (/^$fieldname:/i) {
      $field .= $_;
      $infield = 1;
    }
    elsif (/^\s/) {
      if ($infield) {
        chomp $field;
        my $tmp = $_;
        $tmp =~ s/^\s*/ /;
        $field .= $tmp
      }
    }
    elsif (/^\S/) {
      $infield = 0;
    }
  }

  return $field;
}