Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume26/tpage2/tpage.pl

Perl Script | 1992-06-12 | 9.5 KB | 308 lines

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

# tpage.pl -- front-end to tpage system.
#   by Tom Limoncelli, [e-mail]
#   Copyright (c) 1992, Tom Limoncelli
#   The sources can be freely copied for non-commercial use only
#   and only if they are unmodified.

# Version 1.0 -- See file HISTORY for details.

####################################################################
#
# 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 = 160;
# 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);

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;
    open(QU, ">$qname" ) || die "Can't open $qname for writing: $!";
    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";