#! /usr/local/bin/perl4.035

# tpage.pl -- front-end to tpage system.
#   by Tom Limoncelli, tal@warren.mentorg.com
#   Copyright (c) 1992, Tom Limoncelli
#   The sources can be freely copied for non-commercial use only
#   and only if they are unmodified.

# $Header: /home/tal/work/beep2/RCS/tpage.pl,v 1.2 1992/09/21 20:11:51 root Exp $

# Version 2.0 -- See file HISTORY for details.

# $Log: tpage.pl,v $
# Revision 1.2  1992/09/21  20:11:51  root
# new tr's to remove high bits
#
# Revision 1.2  1992/09/21  20:11:51  root
# new tr's to remove high bits
#
# Revision 1.1  1992/09/21  20:09:37  root
# Initial revision

####################################################################
#
# Parameters that the user can set:
#
####################################################################

$debug = 0;
# leave that off

$MAX_WINDOW = 16;
#This is the number of charactors at a time do you see on your
# pager.  This is used when word-wrapping.

$MAX_MESSAGE = 110;
# How many bytes can one message be.  This must be less than 250
# minus the length of your PIN.  This is because each packet in the ixo
# protocol must be less than 250 chars.  If you have a pager that can
# receive longer messages, you'll have to modify the ixocico.c program
# to handle the "packet continuation" feature.  No biggie, just 
# something that I didn't feel like implementing since I can't even 
# test it with my pager.

$DEFAULT_S = '/home/adm/lib/tpage/schedule';
# (default: '/home/adm/lib/tpage/schedule')
# If you plan on using the schedule feature, this is the file
# name where beep2.pl will look for the schedule.  It must be accessable
# on the machine that runs tpage.pl, not the machine that runs the
# daemon (tpaged.pl).

$DEFAULT_T = '/home/adm/lib/tpage/table';
# (default: '/home/adm/lib/tpage/table')
# If you plan on using the table feature (that is, store a list
# of people and their paging info), this is the file name where tpage.pl
# will look for the data.  It must be accessable on the machine that
# runs tpage.pl, not the machine that runs the daemon (tpaged.pl).

$QUEUE_DIR = '/home/adm/lib/tpage/pqueue/';
# (default: '/home/adm/lib/tpage/pqueue/'
# This is the directory where messages will be queued.  The trailing "/"
# is required.

####################################################################
# some helping functions

require("getopts.pl");

sub strip_string {
	local($s) = @_;
print "DEBUG: REMOVE_CONTROLS :", $s, ":\n" if $debug;
	$s =~ tr/\200-\377/\000-\177/;	# remove high-bit
	$s =~ tr/\000-\037\177//d;	# delete unprintables
	$s =~ s/\s+/ /g;			# change groups of white space into " "
	$s =~ s/^ //;				# remove spaces from the front
	$s =~ s/ $//;				# remove spaces from the end
	
print "DEBUG: REMOVE_DONE :", $s, ":\n" if $debug;
	return $s;
}

####################################################################
# Here's the actual program

####################################################################
# Get the command line options.

# set the defaults

print "\n";

# -S  schedule file
$opt_S = $DEFAULT_S;
# -T  pager table
$opt_T = $DEFAULT_T;
# -U  use urgent schedule if no one is scheduled for that time.
$opt_U = 0;
# -d  number to dial. (first name in list only)
$opt_d = "";
# -p  pager id to use. (first name in list only)
$opt_p = "";
# -t  tee all stdin into stdout.
$opt_t = 0;
# -v  verbose mode.
$opt_v = 0;
# -m  input will be in RFC822, skip boring stuff.
$opt_m = 0;
# -M  like -m but also skip >-quoted text.
$opt_M = 0;
# -e  if it errors, send email to this person.
$opt_e = "";

$line_from = "";
$line_subj = "";
$line_prio = "";

do Getopts('S:T:Ud:p:tvmMe:');

# get the wholist
$opt_wholist = shift (@ARGV);
$opt_wholist = "special" if $opt_d && $opt_p;

####################################################################
# Get the message (either on the command line or stdin; handle -t -m -M

# bunch up all the rest
$opt_message = join(' ', @ARGV);
print "opt_message = :$opt_message:\n" if $debug;
$opt_message = &strip_string( $opt_message ) if $opt_message;
print "opt_message = :$opt_message:\n" if $debug;
die "$0: No message.  Cat got your tongue?" if ( $opt_message eq "" );

die "$0: Can't use -m/-M and have message on the command line"
		if ($opt_m || $opt_M) && $opt_message ne '-';

# maybe get message from stdin, echoing to stdout if $opt_t;
if ($opt_message eq '-') {
	$opt_message = '';
	# handle -m headers first
	if ($opt_m) {
		print "DEBUG: Doing -m work\n" if $debug;
		local($line) = "";
		while (<>) {
			if ( /^\S/ || /^$/ ) {	# start of new header, do previous one
				$line_from = substr($line, 6) if $line =~ /^From/;
				$line_subj = substr($line, 9) if $line =~ /^Subject: /;
				$line_prio = substr($line, 10) if $line =~ /^Priority: /;
				$line = $_;
			} else {
				$line .= $_;
			}
			last if /^$/;			# end of headers, start processing
		}
	}
	$line_from = &strip_string( $line_from ) if $line_from;
	$line_subj = &strip_string( $line_subj ) if $line_subj;
	$line_prio = &strip_string( $line_prio ) if $line_prio;

	while (<>) {
# -M means skip if the line is news quoted email.
# a line is news quoted if it begins with one of the following:
#      [white] [word] quote
# where "white" is any amount of whitespace (zero or one times)
# where word is any letters/numbers (userid) (zero or one times)
# where quote is any of >, <, }, or {.
		next if $opt_M && /^\s*\S*[\>\}\<\{]/;
		print if $opt_t;
		$_ = &strip_string( $_ );
		$opt_message .= $_;
		$opt_message .= " ";
		# once we've got quite a bunch, screw the rest.
		if ( length($opt_message) > ($MAX_MESSAGE * 8)) {
			 while (<>) { print if $opt_t; }
		}
	}
}

####################################################################
# massage the message

if ($debug) {
	print "DEBUG: pre-processed messages\n";
	print "FROM=:$line_from:\n";
	print "PRIO=:$line_prio:\n";
	print "SUBJ=:$line_subj:\n";
	print "MESS=:$opt_message:\n";
}

$line_from = substr( "F: " . $line_from . ' ' x $MAX_WINDOW,
		0, $MAX_WINDOW) if $line_from;		# pad to display size

$line_prio = substr( "P: " . $line_prio . ' ' x $MAX_WINDOW,
		0, $MAX_WINDOW) if $line_prio;		# pad to display size

$l = $MAX_WINDOW * int ((length($line_subj)+$MAX_WINDOW+2) / $MAX_WINDOW);
$line_subj = substr( "S: " . $line_subj . ' ' x $MAX_WINDOW,
		0, $l) if $line_subj;		# pad to display size

$opt_message = &strip_string( $opt_message );
# put it all together
$the_message = substr( $line_prio . $line_from . $line_subj . $opt_message, 0, $MAX_MESSAGE - 1);

if ($debug) {
	print "DEBUG: post-processed messages\n";
	print "FROM=:$line_from:\n";
	print "PRIO=:$line_prio:\n";
	print "SUBJ=:$line_subj:\n";
	print "MESS=:$opt_message:\n";
	print "COMPLETE=:$the_message:\n";
}

####################################################################
# At this point we can do some more of the sanity checking.

#die "$0: Conflicting verbosity levels" if ($opt_s && ($opt_v || $opt_V));
die "$0: Schedule file $opt_S can't be read/found"
		unless ( ($opt_wholist eq '-') || (-r $opt_S && -r $opt_T) );
die "$0: Pager table $opt_T can't be read"
		unless ($opt_d && $opt_p) || ( -r $opt_T );

####################################################################
# use the schedule to fill in "who" if we need.

if ($opt_wholist eq '-') {
	local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	local($l) = $wday;
	local($h) = $hour * 2 + int ($hour / 30) + 1;
	local($w,$found1) = 0;

print "L = $l\n" if $debug;
print "H = $h\n" if $debug;
print "U = $opt_U\n" if $debug;

	# Read from schedule until you hit a line beginning with $l.
	# At that point, get the char $h bytes in.  If that byte is "-",
	# and $opt_U, keep going.
	print "\nChecking schedule:\n\n";
	open(SCHED, "<$opt_S") || die "Can't open $opt_S: $!";
	while (1) {
		$w = '';
		while (<SCHED>) {
			last if /^${l}/;
		}
		$w = substr($_, $h, 1);
		$found1 = 1 if $w;				# we found one!
		next if $opt_U && $w eq '-';
		last;
	}

	die "$0: Schedule doesn't have a line for this day of the week.\n" unless $found1;
	die "$0: No one is assigned to be on duty at this time.\n" if $w eq '-';

	# Now search until a line begins with $w= and assign line to wholist
	$opt_wholist = '';
	while (<SCHED>) {
		next unless /^${w}\=/;
		chop( $opt_wholist = substr($_, 2) );
	}
	die "$0: Schedule error: No people assigned to '" . $w . "'\n" unless $opt_wholist;
	close SCHED;
}

####################################################################
# we we still don't know who to call, bail out.

die "$0: The schedule didn't specify anyone to call!"
		unless ($opt_wholist) || ($opt_d && $opt_p);
die "$0: There isn't anyone scheduled for this time of day."
		if $opt_wholist eq '-';

####################################################################
# rotate through "$opt_wholist" and queue each person

$cnt = 0;
foreach $who ( split(',', $opt_wholist) ) {
	$cnt++;

	# look up "who"'s information
	open(TABL, "<$opt_T") || die "Can't open $opt_T: $!";
	while (<TABL>) {
		next if /^#/;
		chop;
		local($name,$phonen,$phonea,$pin) = split;
		if ($name eq $who) {
			$opt_d = $phonea unless $opt_d;	# might have it from ARGV
			$opt_p = $pin unless $opt_p;	# might have it from ARGV
			print "Got $who is :$opt_d:$opt_p:\n" if $debug;
			last;
		}
	}
	close TABL;

	die "$0: We were not able to find a phone number for $who.\n" unless $opt_d;
	die "$0: We were not able to find a PIN for $who.\n" unless $opt_p;

	# write into the queue the proper information.
	chop( $thishost = `hostname` );
	$qname = $QUEUE_DIR . "P" . $thishost . time . $cnt;
	print "QUEUE=$qname\n" if $debug;
	local($um) = umask 2;
	open(QU, ">$qname" ) || die "Can't open $qname for writing: $!";
	umask $um;
	print QU "A\n";
	print QU $opt_d, "\n";
	print QU $opt_p, "\n";
	if ($opt_e eq '-') {	 # '-' means send errors to $who,
		print QU $who, "\n";
	} else {
		print QU $opt_e, "\n";
	}
	print QU $the_message, "\n";
	print QU "X\n";
	close QU;
	print "Message queued for $who: $the_message\n";
	
	# zap the phone# and PIN so that ARGV's info only effects us once.
	$opt_d = "";
	$opt_p = "";
}

print "\n";