#!/usr/athena/bin/perl -w

use lib "/afs/athena.mit.edu/activity/r/random-hall/soda-tab-db/perl";

use strict;
use Carp;
use Pod::Usage;
use Getopt::Mixed "nextOption";

##########################################
# pkgslip.pl
# written by mcain,rnjacobs,rsw
# for Random Hall Desk
#
my $version = "3.04";

## configuration options   

my $mailserver = "outgoing.mit.edu";
my $from = "TFD <random-desk\@mit.edu>";
#my $from = 'rnjacobs@mit.edu';

my %o;

Getopt::Mixed::init("h help>h m man>m v version>v ".
		    "p package>p e envelope>e l letter>l ".
		    "u unforwardable>u c=s custom>c ".
		    "k kyrgystan>k r reminder>r ".
		    "s sign>s") or die "pkgslip.Getopt::Mixed error\n";
while (my ($option,$value,$pretty) = nextOption()) {
    $o{$option}++ unless $value; # so that we can detect multiple
    $o{$option}=$value if $value;
}
Getopt::Mixed::cleanup();

pod2usage(-verbose => 1) and exit if $o{h};
pod2usage(-verbose => 2) and exit if $o{m};

print "PkgSlip, version $version\n\n" and exit if $o{v};

## compose message

my $items=0;
my $unfw=0;

my $message = "You have ";
my @objects = ();

if (defined $o{p}) {
    if ($o{p} == 1) {
	push @objects, "a package";
    } elsif ($o{p} > 1) {
	push @objects, "packages";
    }
}

if (defined $o{e}) {
    if ($o{e} == 1) {
	push @objects, "an envelope";
    } elsif ($o{e} > 1) {
	push @objects, "envelopes";
    }
}

if (defined $o{l}) {
    if ($o{l} == 1) {
	push @objects, "a love letter from the institvte";
	$unfw=1;
    } elsif ($o{l} > 1) {
	push @objects, "love letters from the institvte";
	$unfw=1;
    }
}

if (defined $o{k}) {
    if ($o{k} == 1) {
	push @objects, "a letter from Kyrgystan";
    } elsif ($o{k} > 1 ) {
	push @objects, "letters from Kyrgystan";
    }
}

if ($o{u}) {
    $unfw=1;
    push @objects, "unforwardable mail";
}

if (defined $o{c}) {
    push @objects, $o{c};
}

if (not @objects) {
    push @objects, "a package";
### - requested that default behavior be one package, not fail.
#      pod2usage(-verbose => 1) and exit if (not @ARGV);
#      print "pkgslip [-peluhmvs] [-c item] user [user2] [user3 ...]\n";
#      print "You need to specify some kind of item they're receiving.\n";
#      exit;
}

$message .= join " and ",@objects;

$message .= " at Random desk.\n";
if ($o{sign}) {
    chop $message;
    $message = $message . "Please sign for it.\n";
}

if ($unfw == 1) {
    $message = $message . "Some things can't be forwarded.\n";
}

if ($o{r}) {
    $message .= "The deskworker would like to remind you that\n".
	" you have $o{r} item".(($o{r}>1)?"s":"")." to pick up\n";
}

# technically, this is wrong. there are 13 accounts at MIT that are 2 characters long.
# fortunately, i can't imagine any of them getting something at rh desk.

my $deskworker = scalar getpwuid $<;
# deskworker string must exist; no usernames are less than 3 characters (on athena);
#  and it must include alphabetic characters
unless (defined $deskworker and length $deskworker >= 3 and $deskworker =~ /[a-z]/) {
    # take the first element of the split of the hesiod output
    $deskworker = (split /:/,`hesinfo $< uid`)[0];
    unless (defined $deskworker and length $deskworker >= 3 and $deskworker =~ /[a-z]/) {
	# all else fails -- use raw UID
	$deskworker = "UID $<";
    }
}

$message = $message . "Desk is open from 8 AM to 12 AM Sunday-Thursday and 8 AM to 2 AM Friday and Saturday\n\n\n";
$message = $message . "                   -The Friendly Deskworker ($deskworker)\n";

## send message

if (not @ARGV) {
    print "pkgslip [-peluhmvsk] [-c item] user [user2] [user3 ...]\n";
    print "You need to specify a recipient\n";
    exit;
}

my $subject;
if (scalar @objects == 1) {
    $subject = $objects[0] . " at desk";
} else {
    $subject = "multiple items at desk";
}

# verify each recipient exists...
foreach my $test (@ARGV) {
    `hesinfo $test passwd 2>/dev/null`;
    die "pkgslip.hesiod: Recipient $test does not exist on athena.\n"
	if $? != 0;

}

my $to = join ",",@ARGV;

sub which {
    my $cmd = shift;
    my @paths = ("/usr/sbin","/usr/lib","/usr/libexec","/usr/etc","/sbin","/usr/ucb","/usr/ucblib");
    for my $prefix (@paths) {
	return "$prefix/$cmd" if ( -x "$prefix/$cmd" );
    }
}

open SMTP,'| '.which("sendmail").' -t -frandom-desk@mit.edu'
    or die "pkgslip.smtp: Sendmail spawn failed $!\n";

print SMTP "X-Return-Path: $deskworker\n"
    or die "pkgslip.smtp: Data return path $deskworker rejected $!\n";
print SMTP "To: $to\n"
    or die "pkgslip.smtp: Data recipient $to rejected $!\n";
print SMTP "From: $from\n"
    or die "pkgslip.smtp: Data sender $from rejected $!\n";
print SMTP "Subject: $subject\n\n"
    or die "pkgslip.smtp: Data subject $subject rejected $!\n";

print SMTP $message
    or die "pkgslip.smtp: Data message rejected $!\n";
close SMTP
    or die "pkgslip.smtp: Close connection failed? $!\n";

my $logfn = "/afs/athena.mit.edu/activity/r/random-hall/soda-tab-db/pkglog/".time();

for (0..10) {
    open LOG, ">$logfn.$_" and last;
    if ($_ == 10) {
	print "LOG FAILED. Are you sure you have kerberos tickets?\n";
	print "If you do, contact maintainer immediately!\n";
	exit;
    }
}
print LOG "$deskworker sent notification of: ".(join " and ",@objects)."\n";
print LOG "to: ".(join " ",@ARGV)."\n";
print LOG "on: ".(scalar gmtime time())."\n";
close LOG;

#give feedback
print "Package slip for $to sent successfully\n";
## END ##

=head1 TITLE

 pkgslip

=head1 SYNOPSIS

 pkgslip -p mcain            # tells mcain@mit.edu that he has a package
 pkgslip -es rnjacobs        # tells robert that he has an envelope that
                             #  he must sign for
 pkgslip -c "a moose" alexmv # tells alex that he has a moose
 pkgslip -k molly            # tells molly she has mail from Kyrgystan
 pkgslip -l rsw zcs          # tell riad and zia that they have MIT bills
 pkgslip -u mikihavl         # tells miki that she has unforwardable mail
 pkgslip -ppes awozniak      # tells woz that she has multiple items

=head1 DESCRIPTION

 A program to increase the ease with which deskworkers can inform the
 residents of items that have arrived.

=head1 OPTIONS

 --package -p --envelope -e
   A package or an envelope

 --letter -l
   A "love letter from the institute", often an MIT bill.

 --unforwardable -u
   Other unforwardable mail.

 --custom="stuff" -c "stuff"
   A custom item, "stuff" verbatim.

 --reminder -r
   Summary line at the bottom

 --kyrgystan -k
   A letter from Kyrgystan, added on (cough cough) one person's request.

 --sign -s
   Recipients must sign for some of the items they've received.

 --help -h
   Prints usage and options

 --man -m
   Prints complete man page

=head1 AUTHORS

   Robert Jacobs, rnjacobs@mit.edu
   Matt Cain, mcain@mit.edu
   Riad Wahby, rsw@mit.edu

=head1 BUGS

   You cannot specify recipients who are not @mit.edu. (because recipients are
    verified using hesiod)

=head1 CHANGES

13 nov 2000:rsw:       use Net::SMTP

30 nov 2000:mcain:     print "mail sent"

 1 dec 2000:mcain:     include sender's username

27 oct 2002:rnjacobs:  use Getopt::Long

 4 nov 2002:rnjacobs:  use Getopt::Mixed instead

 7 nov 2002:rnjacobs:  Fixed default (send package)
                       and multiple-recipient.

 9 dec 2002:rnjacobs:  Fixed unforwardable mail messages.
                       b/c unforwardable != interdep't.
                       Changed some error messages.

12 jul 2004:rnjacobs:  12 PM is not midnight. 

24 jul 2004:cat9:      No longer asks recipient what to do 
                       with unforwardable mail.

20 jan 2005:rnjacobs:  For some reason, /etc/passwd wasn't
                       world readable. Provided alternate 
                       detection schemes (hesiod, raw uid)
                       if (scalar getpwuid $<) doesn't 
                       return a valid username. Rewrite to 
                       2 AM instead of midnight.

21 jan 2005:rnjacobs:  Perl 5.005 != Perl 5.8 -- @{[ ... ]}
                       does not DTRT.

06 feb 2005:rnjacobs:  Moved to AFS, paths fixed, &c.

02 may 2006:rnjacobs:  Drop Net::SMTP, spawn sendmail to use
                       authenticated mail (lower spamscreen 
                       scores, higher delivery priority, &c)

09 may 2006:rnjacobs:  Formatting, added "reminder" option.

06 jun 2006:rnjacobs:  sendmail is not always in /usr/sbin.
                       add "which" mechanism to find it.

21 jun 2011:kree:      update hours that desk is open