home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume26 / tpage2 / tpaged.pl < prev   
Encoding:
Perl Script  |  1992-06-12  |  8.2 KB  |  278 lines
  1. #! /usr/local/bin/perl4.019
  2.  
  3. # tpaged -- back-end to tpage system.
  4. #   by Tom Limoncelli, tal@warren.mentorg.com
  5. #   Copyright (c) 1992, Tom Limoncelli
  6. #   The sources can be freely copied for non-commercial use only
  7. #   and only if they are unmodified.
  8.  
  9. # Version 1.0 -- See file HISTORY for details. 
  10.  
  11. ####################################################################
  12. #
  13. # Parameters that the user can set:
  14. #
  15. ####################################################################
  16.  
  17. $debug = 0;
  18. $QUEUE_DIR = '/home/adm/lib/tpage/pqueue/';        # same as in tpage.pl
  19. $IXOCICO = '/home/tal/work/beep2/ixocico';        # where is ixocico?
  20. $MAIL = '/usr/ucb/mail';                        # which mail to use?
  21.  
  22. # list of devices to rotate through.
  23. @DEVICES = ( "/dev/ttyz4" );    # currently they are all spoken
  24. # to at the same speed and same parameters.  Some day I'll set up
  25. # a modemtab system, but I don't think more than one modem is
  26. # really needed for this system.
  27.  
  28. # amount of time to sleep between scans
  29. $SLEEP_TIME =  30;
  30.  
  31. ####################################################################
  32. # QUEUE FILES FORMAT:
  33. #
  34. # Files in the queue have the name of the format in the
  35. # first line.  Currently there is only one format and it
  36. # is named "A".  The first line marks it as the "A" format.
  37. # a subroutine called read_format_A reads this format.  Other
  38. # formats can be written (see comments by read_format_A)
  39. #
  40. # The "A" format:
  41. # line  contents
  42. #    1: A\n
  43. #    2: number to dial\n
  44. #    3: pin\n
  45. #    4: entire message\n
  46. #    5: X\n
  47.  
  48. # read_format_*  -- modules that read various data formats.
  49. #                   Currently implemented: The "A" format.
  50. # do_proto_*     -- modules that do various beeper protocols.
  51. #                   Currently implmented: the ixo protocol.
  52. #                   Future protocols:     numeric-only pagers.
  53.  
  54. ####################################################################
  55. # Here's the actual program
  56.  
  57. # define some globals
  58.  
  59. local(%ixo_dial);
  60. local(%protocols);
  61.  
  62. while (1) {
  63.     local ($first,$allfiles);
  64.  
  65.     # We could scoop up all the files and process them, but chances
  66.     # are if one file is found, more are on the way.  So, instead
  67.     # we scoop, if any are found we sleep 5 seconds and re-scoop.
  68.     while (1) {
  69.         opendir(QDIR, $QUEUE_DIR) || die "$0: Can't open $QUEUE_DIR: $!";
  70.         @allfiles = grep( !/^\./, readdir(QDIR) );
  71.         closedir(QDIR);
  72.  
  73.         if ($#allfiles!=-1) {    # files?  take 5 and then process.
  74.             sleep 5;
  75.             last;
  76.         } else {            # no files?  hibernate.
  77.             sleep $SLEEP_TIME;
  78.             next;
  79.         }
  80.     }
  81.  
  82.     print "DEBUG: allfiles= ", join(' ', @allfiles), "\n" if $debug;
  83.     opendir(QDIR, $QUEUE_DIR) || die "$0: Can't open $QUEUE_DIR: $!";
  84.     @allfiles = grep( !/^\./, readdir(QDIR) );
  85.     closedir(QDIR);
  86.     print "DEBUG: allfiles= ", join(' ', @allfiles), "\n" if $debug;
  87.  
  88.     foreach $file (@allfiles) {
  89.         print "DEBUG: Doing $file\n" if $debug;
  90.         open(DATA, "<" . $QUEUE_DIR . $file) || print "Can't open $file: $!";
  91.         chop( $first = <DATA> );
  92. print "DEBUG: first=$first\n" if $debug;
  93.         eval "do read_format_$first();";
  94.     }
  95.     
  96.     foreach $proto (sort keys %protocol) {
  97.         next unless $protocol{ $proto };
  98.         eval "do do_protocol_$proto();";
  99.         $protocol{ $proto } = 0;
  100.         sleep $SLEEP_TIME;
  101.     }
  102. }
  103.  
  104. # Each read_format_ must:
  105. #  read from <DATA> and then close(DATA).
  106. #  %protocol{ protocol name } = 1 (for the protocol to use)
  107. #  and stuff the right data into the right variables for that protocol
  108. #  to use.
  109.  
  110. sub read_format_A
  111. {
  112.     local($dial,$pin,$error,$mess,$X);
  113.     print "DEBUG: reading format A\n" if $debug;
  114.     chop( $dial = <DATA> );
  115.     chop( $pin = <DATA> ); 
  116.     chop( $error = <DATA> );
  117.     chop( $mess = <DATA> );
  118.     chop( $X = <DATA> );
  119.  
  120.     return if $X ne "X";  # file isn't in correct format or isn't done.
  121.     return if $dial eq "";
  122.     return if $pin eq "";
  123.     return if $mess eq "";
  124.  
  125.     $protocol{ 'ixo' } = 1;
  126.     $ixo_dial{ $dial } = 1;
  127.     eval "unshift(@ixo_${dial}_pin, \$pin)";
  128.     eval "unshift(@ixo_${dial}_error, \$error)";
  129.     eval "unshift(@ixo_${dial}_mess, \$mess)";
  130.     eval "unshift(@ixo_${dial}_file, \$file)";
  131. }
  132.  
  133. # Each do_protocol_ must:
  134. #  delete files out of the queue that are successful.
  135. #  delete files out of the queue that are aged.
  136. #  clean up so that the routine can be called again.
  137.  
  138. sub do_protocol_ixo {
  139.     print "DEBUG: doing protocol IXO\n" if $debug;
  140. #    local($pin, $error, $mess, $file, $cmd, $empty);
  141.     local($pin, $error, $mess, $file, $cmd);
  142. #    $empty = 1;
  143.     # build the temp file and the command line
  144.     local($tmpfile) = "/tmp/tpaged.$$";
  145.     foreach $dial (keys %ixo_dial) {
  146.         next unless $ixo_dial{ $dial };
  147.         print "DEBUG: Number to dial is $dial\n" if $debug;
  148.         open(IX, ">$tmpfile" ) || die "$0: Can't create $tmpfile: $!";
  149.         foreach (eval "@ixo_${dial}_pin") {
  150.             print IX eval "pop(@ixo_${dial}_pin )", "\n";
  151.             print IX eval "pop(@ixo_${dial}_mess)", "\n";
  152.             unshift(@ixo_list, eval "pop(@ixo_${dial}_error)" );
  153.             unshift(@ixo_list, eval "pop(@ixo_${dial}_file )" );
  154. #            $empty = 0;
  155.         }
  156.         close IX;
  157.         print "DEBUG: ", ($#ixo_list) / 2, " messages to send.\n" if $debug;
  158. #        if ($empty) {
  159. #            print "DEBUG: nothing to do!\n" if $debug;
  160. #            unlink $tmpfile;
  161. #            return;
  162. #        }
  163.         $cmd = $IXOCICO . " <" . $tmpfile . " "
  164.             . push(@DEVICES, shift @DEVICES) . " " . $dial;
  165.         print "DEBUG: About to execute: $cmd\n" if $debug;
  166.         open(IX, $cmd . "|") || die "$0: Can't execute ixocico: $!";
  167.         $mesgnum = 0;    # count the messages as they're processed
  168.         $success = 0;
  169.         # get to the next message (same as #MESOK)
  170.         $error = pop(@ixo_list);
  171.         $file  = pop(@ixo_list);
  172.         print "DEBUG: ERROR=$error; FILE=$file\n" if $debug;
  173.         while (<IX>) {
  174.             print if $debug;
  175.             next unless /^#/;
  176.  
  177.             print unless $debug;
  178.  
  179.             /^#WRONGARGS / &&
  180.                 die("$0: Major program bug: $!");
  181.             /^#NOCONN / && do {
  182.                 printf("$0: Nobody answered the phone!\n") if $debug;
  183.                 last;
  184.             };
  185.             /^#UNKNOWNPROTO / && do {
  186.                 print "$0: Uhhh, are you sure that's a pager service?\n" if $debug;
  187.                 last;
  188.             };
  189.             /^\#MESOK (\d) / && do {
  190.                 print "DEBUG: message $1 done.\n" if $debug;
  191.                 if ($1 == $mesgnum++) {
  192.                     print "DEBUG: unlinking " . $QUEUE_DIR . $file . "\n" if $debug;
  193.                     unlink $QUEUE_DIR . $file;
  194.                     # get to the next message (same as #MESREJECT)
  195.                     $error = pop(@ixo_list);
  196.                     $file  = pop(@ixo_list);
  197.                     print "DEBUG: ERROR=$error; FILE=$file\n" if $debug;
  198.                 } else {
  199.                     print "Things have gotten out of sync.  Restarting.\n" if $debug;
  200.                     last;
  201.                 }
  202.             };
  203.             /^#MESREJECT (\d) / && do {
  204.                 if ($1 == $mesgnum++) {
  205.                     if ($error) {
  206.                         $cmd = "$MAIL <" . $QUEUE_DIR . $file . " -s 'the following pin and message was rejected' " . $error;
  207.             print "DEBUG: About to execute $cmd\n" if $debug;
  208.                     }
  209.                     print "DEBUG: unlinking " . $QUEUE_DIR . $file . "\n" if $debug;
  210.                     unlink $QUEUE_DIR . $file;
  211.                     # get to the next message (same as #MESOK)
  212.                     $error = pop(@ixo_list);
  213.                     $file  = pop(@ixo_list);
  214.                     print "DEBUG: ERROR=$error; FILE=$file\n" if $debug;
  215.                 } else {
  216.                     print "Things have gotten out of sync.  Restarting.\n" if $debug;
  217.                     last;
  218.                 }
  219.             };
  220.             /^#FORDIS / && do {
  221.                 print "Forced disconnect from server.\n" if $debug;
  222.                 last;
  223.             };
  224.             /^#PROTERR / && do {
  225.                 print "Server not following protocol.\n" if $debug;
  226.                 last;
  227.             };
  228.             ( /^#DONE / || /#BYE / ) && do {
  229.                 if ($#ixo_list) {
  230.                     print "Done with sending batch.  Waiting BYE.\n" if $debug;
  231.                     $success = 1;
  232.                     next;
  233.                 } else {
  234.                     print "ixocico is done but more data waiting to be sent!  Program bug.\n" if $debug;
  235.                     last;
  236.                 }
  237.             };
  238.             /^#WRONGANY / && do {
  239.                 print "We've been notified that one of the batch may have been not xmited.\n(great protocol, eh?)\n" if $debug;
  240.                 next;
  241.             };
  242.             /^#BADQUEUE / && do {
  243.                 die "$0: Programmer error.  Data in queue is bad: $_\n";
  244.             };
  245.             /^#MODOPEN / && do {
  246.                 print "Modem can't be opened\n" if $debug;
  247.                 last;
  248.             };
  249.             /^#PACKLEN / && do {
  250.                 die "$0: Protocol error.  Should never happen: $_\n";
  251.             };
  252.             /^#GOTMESSEQ / && do {
  253.                 print "MESSAGE: $_\n" if $debug;
  254.             };
  255.             /^#LONELY / && do {
  256.                 print "Hello?  Hello?  Either I'm getting the silent treatment or the server is dead." if $debug;
  257.                 last;
  258.             };
  259.         }
  260.         close IX;
  261.         unlink $tmpfile;
  262.         $ixo_dial{ $dial } = 0;
  263.     }
  264.  
  265.     print "DEBUG: ixo_dial = " if $debug;
  266.     foreach $i (keys %ixo_dial) {
  267.         next unless $ixo_dial{ $dial };
  268.         print $i if $debug;
  269.     };
  270.     print "\n" if $debug;
  271.  
  272.     eval "@ixo_${dial}_pin   = ()";
  273.     eval "@ixo_${dial}_mess  = ()";
  274.     eval "@ixo_${dial}_error = ()";
  275.     eval "@ixo_${dial}_file  = ()";
  276.     $ixo_list = ();
  277. }
  278.