"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/lib/Sendpage/PagingCentral.pm" (3 Jan 2008, 40670 Bytes) of package /linux/privat/old/sendpage-1.001001.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "PagingCentral.pm" see the Fossies "Dox" file reference documentation.

    1 package Sendpage::PagingCentral;
    2 
    3 # PagingCentral.pm implements the TAP protocol
    4 #
    5 # $Id: PagingCentral.pm 224 2006-08-27 17:55:05Z keescook $
    6 #
    7 # Copyright (C) 2000-2004 Kees Cook
    8 # kees@outflux.net, http://outflux.net/
    9 #
   10 # This program is free software; you can redistribute it and/or
   11 # modify it under the terms of the GNU General Public License
   12 # as published by the Free Software Foundation; either version 2
   13 # of the License, or (at your option) any later version.
   14 #
   15 # This program is distributed in the hope that it will be useful,
   16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18 # GNU General Public License for more details.
   19 #
   20 # You should have received a copy of the GNU General Public License
   21 # along with this program; if not, write to the Free Software
   22 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
   23 # http://www.gnu.org/copyleft/gpl.html
   24 
   25 use Sendpage::Modem;
   26 use Sendpage::KeesConf;
   27 use Mail::Send;
   28 
   29 =head1 NAME
   30 
   31 PagingCental.pm - implements the TAP protocol over the Modem module
   32 
   33 =head1 SYNOPSIS
   34 
   35     $pc=Sendpage::PagingCentral->new($config,$name);
   36 
   37     $rc=$pc->start_proto();
   38     $rc=$pc->send($pin,$text);
   39     ...
   40     $pc->disconnect();
   41 
   42     $rc=$pc->deliver($page);
   43 
   44     $pc->SendMail($to,$from,$cc,$errorsto,$subject,$body);
   45 
   46 =head1 DESCRIPTION
   47 
   48 This is a module for use in sendpage(1).
   49 
   50 =head1 BUGS
   51 
   52 Need to write more docs.
   53 
   54 =cut
   55 
   56 
   57 # Various return code literals
   58 $SKIP_MSG   = 4;
   59 $PERM_ERROR = 3;
   60 $TEMP_ERROR = 2;
   61 $SUCCESS    = 1;
   62 
   63 # Timings
   64 my @T=(undef, 2, 1, 10, 4, 8);
   65 # Retries
   66 my @N=(1, 3, 3, 3);
   67 # Sequence Codes
   68 my %SeqMajor = (    100 => "Informational Text",
   69             200 => "Positive Completion",
   70             300 => "Unused",
   71             400 => "Unused",
   72             500 => "Negative Completion",
   73             600 => "Unused",
   74             700 => "Unused",
   75             800 => "Unused",
   76             900 => "Unused"
   77            );
   78 my %SeqMinor = (
   79         110 => "Paging Terminal TAP Specification Supported",
   80         111 => "Paging terminal is processing the previous input -- please wait",
   81         112 => "Maximum pages enter for session",
   82         113 => "Maximum time reached for session",
   83         114 => "Welcome banners",
   84         115 => "Exit Messages",
   85         211 => "Page(s) Sent Successfully",
   86         212 => "Long message truncated and sent",
   87         213 => "Message accepted - held for deferred delivery",
   88         214 => "Character maximum, message has been truncated and sent",
   89         501 => "A time-out occurred waiting for user input",
   90         502 => "Unexpected characters received before the start of a transaction",
   91         503 => "Excessive attempts to send/re-send a transaction with checksum errors",
   92         504 => "The message field of the TAP transaction contained characters, but message characters are not allowed for the Pager format.  Perhaps the paging receiver for the given PIN is a 'Tone Only' pager.",
   93         505 => "Message portion of the TAP transaction contained alphabetic characters, but alphabetics characters are not allowed for the Pager format.  Perhaps the paging receiver for the given PIN is a 'numeric' pager.",
   94         506 => "Excessive invalid pages received",
   95         507 => "Invalid Logon attempt: incorrectly formed login sequence",
   96         508 => "Invalid Login attempt: Service type and category given is not supported",
   97         509 => "Invalid Login attempt: Invalid password supplied",
   98         510 => "Illegal Pager ID - The pager ID contains illegal characters or is too long or short",
   99         511 => "Invalid Pager ID - There is no subscriber to match this ID",
  100         512 => "Temporarily cannot deliver to Pager ID - Try Later",
  101         513 => "Long message rejected for exceeding maximum character length",
  102         514 => "Checksum error",
  103         515 => "Message format error",
  104         516 => "Message quota temporarily exceeded",
  105         517 => "Character maximum, message rejected"
  106            );
  107 
  108 my $CR="\x0d";
  109 my $LF="\x0a";
  110 my $ESC="\x1b";
  111 my $ACK="\x06";
  112 my $NAK="\x15";
  113 my $STX="\x02";
  114 my $ETX="\x03";
  115 my $EOT="\x04";
  116 my $RS="\x1e";
  117 my $US="\x1f";
  118 my $ETB="\x17";
  119 my $SUB="\x1a";
  120 my $TRN="\x2f";
  121 my $OP="\x4f";
  122 my $RE="\x52";
  123 
  124 sub new
  125 {
  126     my $proto = shift;
  127     my $class = ref($proto) || $proto;
  128     my $self  = { };
  129 
  130     $self->{CONFIG} = shift;
  131     $self->{NAME}   = shift;
  132     $self->{MODEMS} = shift;
  133 
  134     # load config information
  135     $self->{DEBUG}  = $self->{CONFIG}->get("pc:$self->{NAME}\@debug");
  136 
  137     # TAP protocol/block handling options
  138     $self->{Proto}         = $self->{CONFIG}->get("pc:$self->{NAME}\@proto");
  139     $self->{AnswerWait}    = $self->{CONFIG}->get("pc:$self->{NAME}\@answerwait");
  140     $self->{AnswerRetries} = $self->{CONFIG}->get("pc:$self->{NAME}\@answerretries");
  141     $self->{CharsPerBlock} = $self->{CONFIG}->get("pc:$self->{NAME}\@chars-per-block");
  142     $self->{MAXCHARS}      = $self->{CONFIG}->get("pc:$self->{NAME}\@maxchars");
  143     $self->{FIELDS}        = $self->{CONFIG}->get("pc:$self->{NAME}\@fields");
  144     $self->{MAXSPLITS}     = $self->{CONFIG}->get("pc:$self->{NAME}\@maxsplits");
  145     $self->{MaxPages}      = $self->{CONFIG}->get("pc:$self->{NAME}\@maxpages");
  146     $self->{MaxBlocks}     = $self->{CONFIG}->get("pc:$self->{NAME}\@maxblocks");
  147 
  148     # TAP character translation options
  149     $self->{ESC}    = $self->{CONFIG}->get("pc:$self->{NAME}\@esc");
  150     $self->{CTRL}   = $self->{CONFIG}->get("pc:$self->{NAME}\@ctrl");
  151     $self->{LFOK}   = $self->{CONFIG}->get("pc:$self->{NAME}\@lfok");
  152 
  153     # Serial characteristics
  154     $self->{Baud}         = $self->{CONFIG}->ifset("pc:$self->{NAME}\@baud");
  155     $self->{Parity}       = $self->{CONFIG}->ifset("pc:$self->{NAME}\@parity");
  156     $self->{StrictParity} = $self->{CONFIG}->ifset("pc:$self->{NAME}\@strict-parity");
  157     $self->{Data}         = $self->{CONFIG}->ifset("pc:$self->{NAME}\@data");
  158     $self->{Stop}         = $self->{CONFIG}->ifset("pc:$self->{NAME}\@stop");
  159     $self->{Flow}         = $self->{CONFIG}->ifset("pc:$self->{NAME}\@flow");
  160 
  161     # Modem control options
  162     $self->{AreaCode}    = $self->{CONFIG}->get("pc:$self->{NAME}\@areacode",1);
  163     $self->{PhoneNum}    = $self->{CONFIG}->get("pc:$self->{NAME}\@phonenum");
  164     $self->{DialWait}    = $self->{CONFIG}->get("pc:$self->{NAME}\@dialwait",1);
  165     $self->{DialRetries} = $self->{CONFIG}->get("pc:$self->{NAME}\@dialretries");
  166 
  167     # Email control settings
  168     $self->{CConErr}     = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@cc-on-error");
  169     $self->{CCSimple}    = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@cc-simple");
  170     $self->{NotifyAfter} = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@tempfail-notify-after");
  171     $self->{FailNotify}  = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@fail-notify");
  172     $self->{MaxTempFail} = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@max-tempfail");
  173     $self->{MaxAge}      = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@max-age");
  174 
  175     # Completion commands
  176     $self->{CompletionCmd} = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@completion-cmd",1);
  177 
  178     $self->{LEAD} = "";
  179     $self->{LEAD} = $CR
  180     if ($self->{CONFIG}->get("pc:$self->{NAME}\@stricttap"));
  181 
  182     # get the daemon info, allowing for fall-back
  183     $self->{PageDaemon} = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@page-daemon");
  184 
  185     return bless $self => $class;
  186 }
  187 
  188 # Clear work-tracking counters
  189 sub clear_counters
  190 {
  191     my $self = shift;
  192 
  193     # clear counters
  194     $self->{PagesProcessed}  = 0;
  195     $self->{BlocksProcessed} = 0;
  196 }
  197 
  198 # Get a modem, init, dial, and authenticate to TAP
  199 sub start_proto
  200 {
  201     my $self = shift;
  202 
  203     my (@modems, $modem, $name, $result, $report, $ref);
  204 
  205     # find an available modem
  206     $ref = $self->{CONFIG}->fallbackget("pc:$self->{NAME}\@modems", 1);
  207     if (!defined($ref)) {
  208     @modems = @{ $self->{MODEMS} }; # use all known available
  209     } else {
  210     @modems = @{ $ref };
  211     }
  212 
  213     # we need to make sure that we only use the modems that
  214     # we're allowed to use and that
  215     # were detected as "functioning" during startup
  216     my (%avail, @okay);
  217 
  218     # which are available?
  219     $avail{$_} = 1 foreach (@{ $self->{MODEMS} });
  220 
  221     foreach $modem (@modems) {
  222     push(@okay,$modem) if (defined($avail{$modem}));
  223     }
  224 
  225     @modems = @okay;
  226 
  227     my $config = $self->{CONFIG};
  228 
  229     # try each modem,  FIXME: should we do some sort of round-robin?
  230     foreach $name (@modems) {
  231     $modem = Sendpage::Modem->new(Name => $name,
  232                       Dev => $config->get("modem:${name}\@dev"),
  233                       Lockprefix => $config->get("lockprefix"),
  234                       Debug => $config->get("modem:${name}\@debug"),
  235                       Log => $main::log,
  236                       Baud => $config->get("modem:${name}\@baud"),
  237                       Parity => $config->get("modem:${name}\@parity"),
  238                       StrictParity => $config->get("modem:${name}\@strict-parity"),
  239                       Data => $config->get("modem:${name}\@data"),
  240                       Stop => $config->get("modem:${name}\@stop"),
  241                       Flow => $config->get("modem:${name}\@flow"),
  242                       Init => $config->get("modem:${name}\@init"),
  243                       InitOK => $config->get("modem:${name}\@initok"),
  244                       InitWait => $config->get("modem:${name}\@initwait"),
  245                       InitRetry => $config->get("modem:${name}\@initretries"),
  246                       Error => $config->get("modem:${name}\@error"),
  247                       Dial => $config->get("modem:${name}\@dial"),
  248                       DialOK => $config->get("modem:${name}\@dialok"),
  249                       DialWait => $config->get("modem:${name}\@dialwait"),
  250                       DialRetry => $config->get("modem:${name}\@dialretries"),
  251                       NoCarrier => $config->get("modem:${name}\@no-carrier"),
  252                       DTRToggleTime => $config->get("modem:${name}\@dtrtime"),
  253                       CarrierDetect => $config->get("modem:${name}\@carrier-detect",1),
  254                       AreaCode => $config->get("modem:${name}\@areacode",1),
  255                       LongDist => $config->get("modem:${name}\@longdist"),
  256                       DialOut =>  $config->get("modem:${name}\@dialout")
  257                      );
  258 
  259     # Did we get it?
  260     next unless defined $modem;
  261 
  262     # Init modem
  263     $result = $modem->init(Baud => $self->{Baud},
  264                    Parity => $self->{Parity},
  265                    Data => $self->{Data},
  266                    Stop => $self->{Stop},
  267                    Flow => $self->{Flow},
  268                    StrictParity => $self->{StrictParity},
  269                    # modem init string undefined; use default
  270                   );
  271     unless (defined $result) {
  272         $main::log->do('alert',
  273                "PC '%s' Failed to initialize modem '%s'",
  274                $self->{NAME}, $name);
  275         undef $modem;
  276         next;
  277     }
  278 
  279     # Dial
  280     $result = $modem->dial(AreaCode => $self->{AreaCode},
  281                    PhoneNum => $self->{PhoneNum},
  282                    DialWait =>$self->{DialWait},
  283                   );
  284     unless (defined $result) {
  285         $main::log->do('crit',
  286                "Failed to dial PC '%s' from modem '%s'",
  287                $self->{NAME},$name);
  288         undef $modem;
  289         next;
  290     }
  291 
  292     # reserved, init'd, and dialed the modem
  293     last;
  294     }
  295 
  296     # make sure we got one
  297     unless (defined $modem) {
  298     $main::log->do('crit', "No PC connections available");
  299     return (undef,"No PC connections available");
  300     }
  301 
  302     # Clear counters
  303     $self->clear_counters();
  304 
  305     my $SST = $self->{Proto};   # Get proto type
  306 
  307     # Starting implementation of UCP
  308     # ------------------------------
  309     # I did a few new routines to handle UCP:
  310     # - HandleUCPMessage
  311     # - AssambleUCPMessage
  312     # - CalcUCPChecksum
  313     # - CreateUCPMessage
  314     # - CreateUCPHeader
  315     # - TranmistUCPMessage
  316     # And I modified the following routines:
  317     # - send
  318     # - disconnect
  319     # - and this one (start_proto)
  320     # UCP doesn't need to loggon. So we just skip that for UCP
  321     if ($SST =~ /^TAP|PG[13]$/) { # Proto is TAP (PG1 or PG3)
  322     # wait for ID=
  323     #   timeout("\r")
  324     $result = $modem->chat("\r", "\r", "ID=", $self->{AnswerWait},
  325                    $self->{AnswerRetries});
  326     unless (defined $result) {
  327         $main::log->do('crit', "PC did not send 'ID=' tag");
  328         return (undef, "Could not perform protocol startup");
  329     }
  330 
  331     # Try to log on
  332     #                    ID=
  333     #    \033PG1${PASS}\r
  334 
  335     my $LEAD = $self->{LEAD};
  336     my $LOGONretries = 3;   # this is protocol-defined
  337     # my $SST=$self->{CONFIG}->get("pc:$self->{NAME}\@proto"); # PG1, etc
  338     my $PASS = $self->{CONFIG}->get("pc:$self->{NAME}\@password");
  339 
  340     # adjust the length of the password to MAKE SURE it's 6 chars
  341     if (length($PASS) > 6) {
  342         $PASS = substr $PASS, 0, 6;
  343     } elsif (length($PASS) < 6) {
  344         # should I be back-filling this password?
  345         #$PASS=sprintf("%06s",$PASS);
  346     }
  347     # supposedly, we can get a go-head here too, so we should handle it
  348     my $early_go_ahead;
  349 
  350     my $logged_in = 0;
  351     while (!$logged_in && $LOGONretries) {
  352 
  353         $result = $modem->chat("${ESC}${SST}${PASS}\r", "",
  354                    "(${LEAD}(${ACK}|${NAK}|${ESC}${EOT})${CR}|${ESC}\\[p${CR})",
  355                    $T[3], $N[0]); # the N here is not spec'd
  356         unless (defined $result) {
  357         $main::log->do('crit', "PC timed out during logon handshake");
  358         return (undef, "Paging Central timed out during logon handshake");
  359         }
  360         $modem->HexDump($result) if $self->{DEBUG};
  361 
  362         #                    something\rcode\r
  363         #   nak: retry
  364         #   ack: followed with go ahead
  365         #   eot: failure
  366         # show any messages
  367         $report = $self->ReportMsgSeq($result);
  368 
  369         if ($result =~ /${ESC}\[p${CR}/) {
  370         # got an early go ahead, skip next chat
  371         $main::log->do('debug', "Got early go-ahead")
  372             if $self->{DEBUG};
  373         # FIXME: we're pattern matching on the entire string
  374         #    instead of feeding the "leftovers" back into
  375         #    the "chat" tool
  376         $logged_in     = 1;
  377         $early_go_ahead= 1;
  378         } elsif ($result =~ /${LEAD}${ACK}${CR}/) {
  379         # Logon accepted
  380         $logged_in = 1;
  381         $main::log->do('debug', "Logon success!")
  382             if $self->{DEBUG};
  383         } elsif ($result =~ /${LEAD}${NAK}${CR}/) {
  384         # Logon requested again
  385         $LOGONretries--;
  386         $main::log->do('debug', "Logon needs to be retried")
  387             if $self->{DEBUG};
  388         } elsif ($result =~ /${LEAD}${ESC}${EOT}${CR}/) {
  389         # Forced disconnected
  390         $main::log->do('crit',
  391                    "PC requested immediate disconnect: '%s'",
  392                    $report);
  393         return (undef, "Immediate disconnect requested: $report");
  394         }
  395 
  396         # make report on failure or debug
  397         $main::log->do($logged_in==1 ? 'debug' : 'crit',
  398                "proto_startup: %s",
  399                $report)
  400         if ($report ne "" && ($self->{DEBUG} || $logged_in != 1));
  401     }
  402     unless ($logged_in) {
  403         $main::log->do('crit',
  404                "Tried to log in $LOGONretries times and failed");
  405         return undef;
  406     }
  407 
  408     unless (defined $early_go_ahead) {
  409         # wait for them to be done announcing crap
  410         #                    ${GO_AHEAD}\r
  411         # n is not spec'd here
  412         $result = $modem->chat("", "", "${ESC}\\[p${CR}", $T[3], $N[0]);
  413         unless (defined $result) {
  414         $main::log->do('crit', "PC timed out during logon speech");
  415         return (undef, "Protocol timed out");
  416         }
  417         $modem->HexDump($result) if $self->{DEBUG};
  418         $report = $self->ReportMsgSeq($result);
  419 
  420         $main::log->do('debug', "go ahead: %s", $report)
  421         if ($report ne "" && $self->{DEBUG});
  422     }
  423     }
  424     $self->{MODEM} = $modem;
  425     return (1, "Proto startup success", $SST);
  426 }
  427 
  428 sub send
  429 {
  430     my $self = shift;
  431     my ($PIN,$text) = @_;
  432     my ($report,@result,$proto);
  433 
  434     # PC in "Test" mode will pretend to deliver all pages
  435     return ($SUCCESS,"") if $self->{Proto} eq "Test";
  436 
  437     unless (defined $self->{MODEM}) {
  438     ($rc, $report, $proto) = $self->start_proto();
  439     unless (defined $rc) {
  440         $main::log->do('crit', "proto startup failed (%s)", $report);
  441         return ($TEMP_ERROR, $report); # temp failure
  442     }
  443     }
  444 
  445     # now we are at step 8, and we can send pages
  446     my @fields = ($PIN, $text);
  447 
  448     if ($proto eq "UCP") {  # UCP has his own message-handler
  449     @result = $self->HandleUCPMessage(@fields);
  450     } elsif ($proto eq "SMS") {
  451     @result = $self->HandleSMSMessage(@fields);
  452     } else {
  453     @result = $self->HandleTAPMessage(@fields);
  454     }
  455 
  456     # Handle any post-processing (maxpages, etc)
  457     $self->{PagesProcessed}++;
  458 
  459     if ($self->{MaxPages} > 0 && $self->{PagesProcessed} >= $self->{MaxPages}) {
  460     # shouldn't send any more pages
  461 
  462     # make a note in the logs
  463     $main::log->do('info',
  464                "Disconnecting from Paging Central: %d page limit reached.",
  465                $self->{MaxPages});
  466 
  467     # drop the connection (don't check for errors...)
  468     $self->disconnect();
  469     }
  470 
  471     return @result;
  472 }
  473 
  474 sub deliver
  475 {
  476     my ($self, $page) = @_;
  477     my ($rc, $report);
  478     my ($to, $cc, $extra, $attempts, $age);
  479 
  480     my $queuedir = $self->{CONFIG}->get("queuedir");
  481 
  482     for ($page->reset(), $page->next();
  483      defined($recip = $page->recip());
  484      $page->next())
  485     {
  486       # gather info from the page
  487       $attempts = $page->attempts();
  488       $to       = $page->option('from');
  489       $cc       = $recip->datum('email-cc');
  490       $age      = $page->age();
  491 
  492       # Check for maximum lifetime
  493       if ($self->{MaxAge} > 0 && $age > $self->{MaxAge}) {
  494           $rc=$PERM_ERROR;
  495           $report = sprintf("Page exceeded maximum queue age: %d > %d seconds",
  496                 $age, $self->{MaxAge});
  497       } else {
  498           # attempt to send the page
  499           ($rc, $report) = $self->send($recip->pin, $page->text);
  500       }
  501       my $now = time;
  502 
  503       # push temp error into a perm fail if needed
  504       if ($rc == $TEMP_ERROR && $attempts > $self->{MaxTempFail}) {
  505           $rc = $PERM_ERROR;
  506           $report .= "\n'Too many errors ($attempts) -- giving up.'";
  507       }
  508 
  509       # gather the reported info
  510       $extra = "";
  511       if (defined($report) && $report ne "") {
  512           $extra = "Paging Central reported:\n$report";
  513       }
  514 
  515       # delay information
  516       if ($now < $page->option('when')) {
  517           $main::log->do('warning',
  518                  "Weird.  Page got delivered before it was ready to be sent.");
  519       } else {
  520           my $delay = $now-$page->option('when');
  521 
  522           $extra = sprintf("Delivery delay: %d second%s.\n",
  523                    $delay,$delay == 1 ? "" : "s") . $extra;
  524       }
  525 
  526       if ($extra ne "") {
  527           $extra = "---diagnostics---\n" . $extra;
  528       }
  529 
  530       # logging info
  531       my $paged  = $recip->name();
  532       my $pc     = $self->{NAME};
  533       my $file   = $page->option('FILE');
  534 
  535       my $sender = $to;
  536       $sender = "nobody" if $sender eq "";
  537 
  538       my $diag = "";
  539       $diag = "PC=$report" if $report ne "";
  540 
  541       # eliminate ctrl chars in "diag"
  542       $diag = Sendpage::Modem->HexStr($diag); # call this directly
  543 
  544       my $state = "unknown";
  545       $state = "Sent" if $rc == $SUCCESS;
  546       $state = "Temp-Failure" if $rc == $TEMP_ERROR;
  547       $state = "Abandoned" if $rc == $PERM_ERROR;
  548 
  549       # log our page's state
  550       $main::log->do('info',
  551              "$pc/$file: state=$state, to=%s, from=%s, size=%d%s",
  552              $paged, $sender, length($page->text()),
  553              $diag eq "" ? "" : ", $diag");
  554 
  555       if ($rc == $SUCCESS) {
  556           # success
  557 
  558           # remove recipient from list
  559           $page->drop_recip();
  560 
  561           # Send email notification
  562           my $subject = "Page delivered";
  563           my $body = "The following page was delivered to "
  564           . "$paged:\n\n" . $page->text() . "\n\n"
  565               . $extra;
  566           my $email_to = $to;
  567           my $email_cc = $cc;
  568 
  569           # If we're doing a simple CC, we need to not
  570           # send the complex one now.
  571           if ($self->{CCSimple}) {
  572           $email_cc = "";
  573           }
  574           if ($email_to ne "" || $email_cc ne "") {
  575           $self->SendMail($email_to,
  576                   $self->{PageDaemon},
  577                   $email_cc,
  578                   $self->{PageDaemon},
  579                   $subject,
  580                   $body);
  581           }
  582 
  583           # Now, if we're doing a CC email, and it's the
  584           # simple body, send it here.
  585           if ($self->{CCSimple} && defined($cc) && $cc ne "") {
  586           $email_to = $cc;
  587           $subject  = "";
  588           $body     = $paged->text() . "\n\n";
  589           $self->SendMail($email_to,
  590                   $self->{PageDaemon},
  591                   $email_cc,
  592                   $self->{PageDaemon},
  593                   $subject,
  594                   $body);
  595           }
  596 
  597           # external commands...
  598           if (defined $self->{CompletionCmd}) {
  599           open(CMD,
  600                "|$self->{CompletionCmd} 1 $paged $queuedir/$pc/$file "
  601                . $page->option('when') . " $now");
  602           print CMD $page->text();
  603           close CMD;
  604           }
  605       } elsif ($rc == $TEMP_ERROR) {
  606           # temp failure
  607 
  608           # add page-daemon to CC possibly
  609           my $errcc = $cc;
  610           if ($self->{CConErr}) {
  611           if ($errcc eq "") {
  612               $errcc = $self->{PageDaemon};
  613           } else {
  614               $errcc = "$errcc, $self->{PageDaemon}";
  615           }
  616           }
  617 
  618           # Send email notification
  619           if ($self->{NotifyAfter} > 0 && $attempts > 0
  620           && ($attempts % $self->{NotifyAfter} == 0)
  621           && ($to ne "" || $errcc ne ""))
  622           {
  623           $self->SendMail($to,
  624                   $self->{PageDaemon},
  625                   $errcc,
  626                   $self->{PageDaemon},
  627                   "Page temporarily failed",
  628                   "The following page is still trying to be delivered to "
  629                   . $recip->name() . ":\n\n"
  630                   . $page->text() . "\n\n"
  631                   . $extra
  632                  );
  633           }
  634       } elsif ($rc == $PERM_ERROR) {
  635           # total failure
  636 
  637           # remove recipient from list
  638           $page->drop_recip();
  639 
  640           # add page-daemon to CC possibly
  641           my $errcc = $cc;
  642           if ($self->{CConErr}) {
  643           if ($errcc eq "") {
  644               $errcc = $self->{PageDaemon};
  645           } else {
  646               $errcc = "$errcc, $self->{PageDaemon}";
  647           }
  648           }
  649 
  650           # Send email notification
  651           if ($self->{FailNotify}
  652           && ($to ne "" || $errcc ne ""))
  653           {
  654           $self->SendMail($to,
  655                   $self->{PageDaemon},
  656                   $errcc,
  657                   $self->{PageDaemon},
  658                   "Page NOT delivered",
  659                   "The following page has FAILED to be delivered to "
  660                   . $recip->name() . ":\n\n"
  661                   . $page->text() . "\n\n"
  662                   . $extra
  663                  );
  664           }
  665 
  666           # external commands...
  667           if (defined $self->{CompletionCmd}) {
  668           open(CMD,
  669                "|b$self->{CompletionCmd} 0 $paged $queuedir/$pc/$file "
  670                . $page->option('when') . " $now"
  671               );
  672           print CMD $page->text();
  673           close CMD;
  674           }
  675       } else {
  676           # truely weird
  677           $main::log->do('warning',
  678                  "PagingCentral: weird.  Bad return code");
  679           $main::log->do('info', "from PC: %s",
  680                  $report)
  681           if $report ne "";
  682       }
  683       }
  684     $page->attempts(1);
  685 }
  686 
  687 sub dropmodem
  688 {
  689     my $self = shift;
  690 
  691     return 1 unless defined $self->{MODEM}; # already dropped
  692 
  693     # give up the modem
  694     #$self->{MODEM}->unlock();
  695     undef $self->{MODEM};
  696 
  697     return 1;
  698 }
  699 
  700 sub disconnect
  701 {
  702     my $self = shift;
  703     my $report;
  704 
  705     # clear our counters
  706     $self->clear_counters();
  707 
  708     return 1 unless defined $self->{MODEM}; # already disconnected
  709 
  710     $main::log->do('debug',
  711            "PagingCentral '$self->{NAME}' disconnecting")
  712     if $self->{DEBUG};
  713 
  714     if ($self->{CONFIG}->get("pc:$self->{NAME}\@proto") =~ /^TAP|PG[13]$/) {
  715     #neither t nor n spec'd
  716     my $result = $self->{MODEM}->chat("${EOT}${CR}", "",
  717                       "${CR}", $T[1], $N[0]
  718                      );
  719     unless (defined $result) {
  720         $main::log->do('crit', "disconnect chat failed -- continuing");
  721         $result = 1;
  722     } else {
  723         $self->{MODEM}->HexDump($result) if $self->{DEBUG};
  724         $report = $self->ReportMsgSeq($result);
  725 
  726         if ($result =~ /${RS}${CR}/) {
  727         $main::log->do('crit', "transaction broken");
  728         $result = undef;
  729         } elsif ($result =~ /${ESC}${EOT}${CR}/) {
  730         $main::log->do('debug', "transcation complete")
  731             if $self->{DEBUG};
  732         $result = 1;
  733         }
  734 
  735         $main::log->do('debug', "PagingCentral '%s' reported '%s'",
  736                $self->{NAME}, $report)
  737         if $self->{DEBUG};
  738 
  739 
  740         # report on failure or debug
  741         $main::log->do($result!=1 ? 'crit' : 'debug',
  742                "disconnect: %s", $report)
  743         if ($report ne "" && ($self->{DEBUG} || $result!=1));
  744     }
  745     } else {
  746     # UCP and SMS have no loggoff sequence,
  747     # so we just skip a protocol hangup
  748     $result = 1;
  749     }
  750 
  751     $self->dropmodem();
  752 
  753     $main::log->do('debug',"PagingCentral '$self->{NAME}' disconnected")
  754     if $self->{DEBUG};
  755 
  756     return $result;
  757 }
  758 
  759 sub GenerateBlocks
  760 {
  761     my $self = shift;
  762     my @fields = @_;
  763     my (@blocks, $field, $fields, $origfield, $newfield, $chunk, $block);
  764 
  765     $fields =$#fields + 1; # count fields (that many more control chars)
  766 
  767     # allow for extra fields (what was called "PET3" in old sendpage)
  768     $fields = $self->{FIELDS} if $fields < $self->{FIELDS};
  769     if ($self->{DEBUG}) {
  770     $main::log->do('debug', "\t\tFields to send: %s:", $fields);
  771     grep($main::log->do('debug', "\t\t\t%s", $_), @fields);
  772     }
  773 
  774     # Build a message block.  Cannot exceed 256 characters.
  775     # (250 + 3 control chars + 3 checksum chars) == 256 chars)
  776     # so $self->{CharsPerBlock} == 250 normally
  777 
  778     @blocks = ();
  779     $chunk = $block = "";
  780     undef $field;
  781     while ((defined($field) && length($field) > 0) || ($#fields >= 0)) {
  782     if (!defined($field) || $field eq "") {
  783         $field     = shift @fields;
  784         $origfield = $field;    # save a copy for the future
  785     }
  786 
  787     #   warn "origfield: '$origfield'\n";
  788     #   warn "field:     '$field'\n";
  789 
  790     # pull the next char and translate and escape it if we need to
  791     my ($chunk, $newfield) = $self->PullNextChar($field);
  792 
  793     #   warn "chunk:     '$chunk'\n";
  794     #   warn "newfield:  '$newfield'\n";
  795 
  796     # Each field is terminated with a CR, so we must keep $fields-many
  797     # characters available in the block.  FIXME: This calculating is overly
  798     # aggressive.
  799     if (length($chunk) +length($block)
  800         <= ($self->{CharsPerBlock} - $fields))
  801     {
  802         $block .= $chunk;
  803 
  804         # did we just exhaust a field?
  805         if (!defined($newfield) || $newfield eq "") {
  806         undef $field;       # clear it for the next field
  807         $block .= $CR;      # attach a CR
  808         $fields--;      # drop the count of fields
  809         } else {
  810         $field = $newfield; # drop that leading char
  811         }
  812     } else {
  813         # we are now at our maximum block size
  814 
  815         # if we didn't finish the field, we need to use a
  816         #    "US" marker to continue the field in the next block
  817         # if we have more blocks to send, we need to use "ETB"
  818         # if we're done sending, we send "ETX"
  819         if ($field eq $origfield) {
  820         # if $field is untouched, we're not in the
  821         #  middle of a field on this block
  822         $sep = (length($field) > 0 || defined($fields[0]))
  823             ? $ETB : $ETX;
  824         } else {
  825         $sep = $US;
  826         }
  827         push @blocks, [ $block, $sep ];
  828         $part++;        # now on to the next part?
  829         $block = "";
  830     }
  831     }
  832     # FIXME: won't this ALWAYS be true, since we never undef $block?
  833     # This seems like a bug: we're always sending an additional empty field.
  834     if (defined $block) {
  835     # done with everything, store the final block
  836     push @blocks, [ $block, $ETX ];
  837     }
  838 
  839     return @blocks;
  840 }
  841 
  842 # Handling the UCP Message
  843 sub HandleUCPMessage
  844 {
  845     my $self = shift;
  846     my ($pin, $msgtext) = @_;
  847 
  848     # checking maxlenth of Text to send
  849     if (length($msgtext) > $self->{MAXCHARS}) {
  850     $main::log->do('crit',"Cannot send message!"
  851                . " Message with %d chars to long.",
  852                $self->{MAXCHARS}
  853               );
  854     $self->disconnect();
  855     }
  856 
  857     # Create the whole message for sending, including header and checksum
  858     $msg = $self->AssembleUCPMessage($pin,$msgtext);
  859 
  860     # Transmit the message
  861     ($result, $report) = $self->TransmitUCPmsg($msg);
  862 
  863     $main::log->do('info',"RETURN: %s", $result);
  864     print length($fields[1]) . "\n";
  865     return ($result, $report);
  866 }
  867 
  868 # Putting the whole message together
  869 sub AssembleUCPMessage
  870 {
  871     my $self = shift;
  872     my ($pin, $msgtext) = @_;
  873     my ($field, $UCPlength, $UCPChecksum, $HEADERchksum);
  874     my ($HEADER, $HEADERlen, $ASCIImsg, $MSG);
  875 
  876     chop $msgtext;
  877     $ASCIImsg = $self->CreateUCPMessage($msgtext);
  878 
  879     $UCPlength = length($pin) + length($ASCIImsg);
  880     ($HEADER, $HEADERlen, $HEADERchksum) = $self->CreateUCPHeader($UCPlength);
  881     $MSG = $HEADER . $pin . $TRN . $TRN . $TRN . "3" . $TRN . $ASCIImsg . $TRN;
  882     $UCPChecksum = $self->CalcUCPChecksum($MSG);
  883     return $MSG . $UCPChecksum;
  884 }
  885 
  886 # Calculating the UCP Checksum
  887 sub CalcUCPChecksum
  888 {
  889     my $self = shift;
  890     my ($HoleMSG) = @_;
  891     my ($CHKtotal, @bytes, $CHKbin, $i, $int);
  892 
  893     @chars = split //, $HoleMSG;
  894     $CHKtotal += ord foreach @chars;
  895     $CHKbin = sprintf("%b", $CHKtotal);
  896 
  897     push @bytes, substr($CHKbin, length($CHKbin) - 8, 4);
  898     push @bytes, substr($CHKbin, length($CHKbin) - 4, 4);
  899 
  900     undef $CHKtotal;
  901     for ($i=0; $i < @bytes; $i++) {
  902     $int = oct("0b" . $bytes[$i]);
  903     if ($int <= 9) {
  904         $int += 48;
  905     } else {
  906         $int += 55;
  907     }
  908     $CHKtotal .= chr($int);
  909     }
  910 
  911     return $CHKtotal;
  912 }
  913 
  914 # Translate Messagepart to ASCII
  915 sub CreateUCPMessage
  916 {
  917     my $self = shift;
  918     my ($field) = @_;
  919     my ($str, $newfield, $origfield, $chunk, $chksum, $i, $length);
  920 
  921     $origfield = $field;
  922     for ($i=0; $i < length($field); $i++) {
  923     undef $newfield;
  924     # pull the next char and translate and escape it if we need to
  925     my ($chunk, $newfield) = $self->PullNextChar($origfield);
  926     $str .= sprintf("%02X", ord($chunk));
  927     $origfield = $newfield;
  928     }
  929 
  930     return $str;
  931 }
  932 
  933 # UCP Header
  934 sub CreateUCPHeader
  935 {
  936     my $self = shift;
  937     my ($UCPlength) = @_;
  938     my ($HDtext, $HDmsg, $HDlen, $HDchksum, $totalLength);
  939 
  940     $totalLength = sprintf("%05u", ($UCPlength + 22));
  941 
  942     $HDmsg = "01" . $TRN . $totalLength . $TRN . "O" . $TRN . "01" . $TRN;
  943 
  944     return $HDmsg;
  945 }
  946 
  947 sub HandleSMSMessage
  948 {
  949     my ($self, $pin, $msgtext) = @_;
  950 
  951     # checking maxlenth of Text to send
  952     if (length($msgtext) > $self->{MAXCHARS}) {
  953     $main::log->do('crit',"Cannot send message!"
  954                . " Message with %d chars to long.",
  955                $self->{MAXCHARS}
  956               );
  957     return ($PERM_ERROR, "Message too long");
  958     }
  959 
  960     unless (defined $self->{MODEM}) {
  961     ($rc, $report) = $self->start_proto();
  962     unless (defined $rc) {
  963         $main::log->do('crit', "SMS proto startup failed (%s)", $report);
  964         return ($TEMP_ERROR, $report); # temp failure
  965     }
  966     }
  967 
  968     # transmit block here
  969     $result = $self->{MODEM}->chat("AT+CMGS=\"$pin\"\r", "",
  970                    "${CR}${LF}?> ", $T[3], 1
  971                   );
  972     unless (defined $result) {
  973     $main::log->do('warning', "SMS message start attempt timed out");
  974     return ($TEMP_ERROR, "SMS message start attempt timed out");
  975     }
  976 
  977     $self->{MODEM}->HexDump($result) if $self->{DEBUG};
  978 
  979     $result = $self->{MODEM}->chat("$msgtext\cZ\r", "\cZ\r",
  980                    "${CR}${LF}?" . qr(\+) . "CM.*\r",
  981                    $T[3], 1
  982                   );
  983     unless (defined $result) {
  984     $main::log->do('warning', "SMS message delivery attempt timed out");
  985     return ($TEMP_ERROR, "SMS message delivery attempt timed out");
  986     }
  987 
  988     $self->{MODEM}->HexDump($result) if $self->{DEBUG};
  989 
  990     return ($PERM_ERROR, "SMS delivery failure: $1")
  991     if $result =~ /\+CMS ERROR: (.*)/;
  992 
  993     return ($SUCCESS, "SMS delivered");
  994 }
  995 
  996 sub HandleTAPMessage
  997 {
  998     my $self = shift;
  999     my @fields = @_;
 1000     my ($i, @blocks, $block, $result, $report, $rc);
 1001     my $send = undef;
 1002 
 1003     # new process needed here to support "maxblocks":
 1004     # 1) generate full translated/escape text *first*
 1005     # 2) figure out how many blocks it will take
 1006     @blocks = $self->GenerateBlocks(@fields);
 1007 
 1008     # 3) sanity-check the "maxblocks" setting to make sure we could EVER
 1009     #    send the page
 1010     if ($self->{MaxBlocks} > 0) {
 1011     if (@blocks > $self->{MaxBlocks}) {
 1012         $main::log->do('crit', "HandleTAPMessage: could NEVER send this "
 1013                . "page if 'maxblocks' is %d!", $self->{MaxBlocks}
 1014               );
 1015     }
 1016     # 4) decide if we drop the connection (enough spare blocks to send message?)
 1017     elsif ($self->{BlocksProcessed} +@blocks > $self->{MaxBlocks}) {
 1018         $main::log->do('info', "Disconnecting from Paging Central: %d "
 1019                . "block limit reached.", $self->{MaxBlocks}
 1020               );
 1021         $self->disconnect();
 1022     }
 1023     }
 1024 
 1025     # 5) verify TAP connectivity (and establish if we need to, like "send")
 1026     unless (defined $self->{MODEM}) {
 1027     ($rc, $report) = $self->start_proto();
 1028     unless (defined $rc) {
 1029         $main::log->do('crit', "TAP proto startup failed (%s)", $report);
 1030         return ($TEMP_ERROR, $report); # temp failure
 1031     }
 1032     }
 1033 
 1034     # 6) go ahead with regular block processing
 1035     $result = $SUCCESS;
 1036     $report = "";
 1037 
 1038     foreach $block (@blocks) {
 1039     my($blockbody, $blocksep) = @$block;
 1040 
 1041     ($result, $report) = $self->TransmitBlock($blockbody, $blocksep);
 1042     if ($result == $SKIP_MSG) {
 1043         return ($PERM_ERROR, $report);
 1044     } elsif ($result != $SUCCESS) {
 1045         return ($result, $report);
 1046     }
 1047     }
 1048     return ($result, $report);
 1049 }
 1050 
 1051 sub PullNextChar
 1052 {
 1053     my $self = shift;
 1054     my ($text) = @_;
 1055     my ($char, $left);
 1056 
 1057     $left = $text;
 1058 
 1059     # stop loops
 1060     return ("","") if $left eq "";
 1061 
 1062     do {
 1063     # yank the first char and encode it if need be
 1064     $char = substr($left, 0, 1); # yank first char
 1065 
 1066     # FIXME: more efficient test for "end of string"
 1067     if ($char ne $left) {
 1068         $left = substr($left, 1); # keep the rest
 1069     } else {
 1070         $left = "";
 1071     }
 1072 
 1073     # drop chars to 7 bits, as required by TAP protocol
 1074     if (ord($char) != (ord($char) & 0x7f)) {
 1075         $main::log->do('warning',
 1076                "hi-bit character reduced to 7 bits: '%s'", $char
 1077               );
 1078         $char = chr(ord($char) & 0x7f);
 1079     }
 1080 
 1081     } until ($self->CharOK($char));
 1082 
 1083     # don't check empties
 1084     return ("","") if $char eq "";
 1085 
 1086     # escape low chars if the PC supports it
 1087     if ($self->{ESC}) {
 1088     if (ord($char) < 0x20) {
 1089         $char = chr(ord($char) + 0x40);
 1090         $char = "${SUB}$char";
 1091     }
 1092     }
 1093 
 1094     return($char, $left);
 1095 }
 1096 
 1097 sub CharOK
 1098 {
 1099     my $self = shift;
 1100     my($char) = @_;
 1101 
 1102     #    # for some PCs, the TAP control chars can't be used, but all    
 1103     #    # the others are trasmitable (in this case, they don't recognize
 1104     #    # the ${SUB} escape codes
 1105     #    my $not_allowed="($CR|$ESC|$STX|$ETX|$US|$ETB|$EOT)";
 1106     #
 1107     #    return undef if ($char =~ /^$not_allowed/);
 1108     #
 1109     #    return 1;
 1110 
 1111     # don't bother checking empties
 1112     return 1 if $char eq "";
 1113 
 1114     if (ord($char) < 0x20
 1115     && !$self->{CTRL}
 1116     && !$self->{ESC}
 1117     && ($char ne $LF || !$self->{LFOK}))
 1118     {
 1119     # be more silent about dropping $LF (e.g., for numeric pagers)
 1120     $main::log->do('warning', "Dropping bad char 0x"
 1121                . sprintf("%02X", ord($char)))
 1122         if ($char ne $LF || $self->{DEBUG});
 1123     return undef;
 1124     }
 1125     return 1;
 1126 }
 1127 
 1128 # UCP is much simpler than IOX so we need a
 1129 # different Transmit routine
 1130 sub TransmitUCPmsg
 1131 {
 1132     my $self = shift;
 1133     my ($block) = @_;
 1134     my ($result, $done, $retries, $report);
 1135 
 1136     unless (defined $self->{MODEM}) {
 1137     $main::log->do('warning', "Yikes!  The modem object disappeared!");
 1138     return ($TEMP_ERROR, "Lost modem object");
 1139     }
 1140 
 1141     $block = ${STX} . $block . ${ETX};
 1142 
 1143     my $LEAD=$self->{LEAD};
 1144 
 1145     $main::log->do('debug', "Block to trans (%d): "
 1146            . Sendpage::Modem->HexStr($block), length($block))
 1147     if $self->{DEBUG};
 1148 
 1149     # count this block as being sent
 1150     $self->{BlocksProcessed}++;
 1151 
 1152     undef $done;
 1153     $retries = 0;
 1154     while (!defined($done) && $retries <= $N[2]) {
 1155 
 1156     # make sure the modem stays connected
 1157     unless ($self->{MODEM}->ready("TransmitBlock")) {
 1158         $self->dropmodem();
 1159         return ($TEMP_ERROR, "Lost modem connection");
 1160     }
 1161     # transmit block here
 1162     $result = $self->{MODEM}->chat($block, "", "\x0A", $T[3], 1);
 1163     unless (defined $result) {
 1164         $main::log->do('warning', "total block xmit failure--retrying");
 1165         $retries++;
 1166         next;       # restart block xmit
 1167     }
 1168 
 1169     $self->{MODEM}->HexDump($result) if $self->{DEBUG};
 1170     # show any messages
 1171     $report = $self->ReportMsgSeq($result);
 1172     $done   = $SUCCESS;
 1173     }
 1174 
 1175     # assume a temporary error unless we already know our state
 1176     $done = $TEMP_ERROR unless defined $done;
 1177 
 1178     return ($done, $report);
 1179 }
 1180 
 1181 sub TransmitBlock
 1182 {
 1183     my $self = shift;
 1184     my ($block, $sep) = @_;
 1185     my ($result, $done, $retries, $report);
 1186 
 1187     unless (defined $self->{MODEM}) {
 1188     $main::log->do('warning', "Yikes!  The modem object disappeared!");
 1189     return ($TEMP_ERROR, "Lost modem object");
 1190     }
 1191 
 1192     $block  = ${STX} . $block . $sep;
 1193     $block .= $self->TAPCheckSum($block) . $CR;
 1194 
 1195     my $LEAD = $self->{LEAD};
 1196 
 1197     $main::log->do('debug', "Block to trans (%d): ".
 1198            Sendpage::Modem->HexStr($block),length($block))
 1199     if $self->{DEBUG};
 1200 
 1201     # count this block as being sent
 1202     $self->{BlocksProcessed}++;
 1203 
 1204     undef $done;
 1205     $retries = 0;
 1206     while (!defined($done) && $retries <= $N[2]) {
 1207 
 1208     # make sure the modem stays connected
 1209     unless ($self->{MODEM}->ready("TransmitBlock")) {
 1210         $self->dropmodem();
 1211         return ($TEMP_ERROR,"Lost modem connection");
 1212     }
 1213 
 1214     # transmit block here
 1215     $result = $self->{MODEM}->chat($block,
 1216                        "",
 1217                        "${LEAD}(${ACK}|${NAK}|${RS}|${ESC}${EOT})${CR}",
 1218                        $T[3],
 1219                        1
 1220                       );
 1221     unless (defined $result) {
 1222         $main::log->do('warning', "total block xmit failure--retrying");
 1223         $retries++;
 1224         next;       # restart block xmit
 1225     }
 1226 
 1227     $self->{MODEM}->HexDump($result) if $self->{DEBUG};
 1228     # show any messages
 1229     $report = $self->ReportMsgSeq($result);
 1230 
 1231     # check for answer here
 1232     if ($result =~ /${LEAD}${ACK}${CR}/) {
 1233         $main::log->do('debug', "block taken") if $self->{DEBUG};
 1234         $done = $SUCCESS;
 1235     } elsif ($result =~ /${LEAD}${NAK}${CR}/) {
 1236         $main::log->do('debug', "retrans block needed")
 1237         if $self->{DEBUG};
 1238         $retries++;
 1239     } elsif ($result =~ /${LEAD}${RS}${CR}/) {
 1240         $main::log->do('debug', "skipping block") if $self->{DEBUG};
 1241         $done = $SKIP_MSG;
 1242     } elsif ($result =~ /${LEAD}${ESC}${EOT}${CR}/) {
 1243         $main::log->do('crit', "immediate disconnect requested!");
 1244         $self->disconnect();
 1245         $done=$TEMP_ERROR;
 1246     }
 1247     }
 1248 
 1249     # assume a temporary error unless we already know our state
 1250     $done = $TEMP_ERROR unless defined $done;
 1251 
 1252     return ($done, $report);
 1253 }
 1254 
 1255 # calculate the 3-char checksum for a block
 1256 sub TAPCheckSum
 1257 {
 1258     my $self = shift;
 1259     my ($data) = @_;
 1260     my ($sum, @chars, $c, @check);
 1261     $sum = 0;
 1262     @chars = split //, $data;
 1263     $sum += (ord($_) & 0x7f) foreach @chars; # drop hi bits (shouldn't be there)
 1264 
 1265     #        /* the checksum is represented as 3 ascii characters having the values
 1266     #                between 0x30 and 0x3f */
 1267     $check[2] = chr(0x30 + ($sum & 0x0f));
 1268     $sum >>= 4;
 1269     $check[1] = chr(0x30 + ($sum & 0x0f));
 1270     $sum >>= 4;
 1271     $check[0] = chr(0x30 + ($sum & 0x0f));
 1272 
 1273     return join "", @check;
 1274 }
 1275 
 1276 #
 1277 #   ${STX}${FIELD1}\r${FIELD2}\r${ETX}${CHECKSUM}\r
 1278 #
 1279 #  (note: pages can be broken into multiple packets, separated by "ETB")
 1280 #
 1281 #                    seq\rcode\r
 1282 #   nak: retry
 1283 #   ack: got it
 1284 #   rs:  skip this one
 1285 #   eot: hang up NOW
 1286 #
 1287 #   ${EOT}\r
 1288 #                    something\r
 1289 #   seq: all good
 1290 #   rs: something broken
 1291 #   eot: goodbye
 1292 
 1293 sub ReportMsgSeq
 1294 {
 1295     my $self = shift;
 1296     my ($seq) = @_;
 1297     my (@lines, $line, $msg, @msgs, $num, $text, $str);
 1298 
 1299     @lines = split /${CR}/, $seq;
 1300     undef @msgs;
 1301     undef $msg;
 1302     $str = "";
 1303 
 1304     foreach $line (@lines) {
 1305     if ($line =~ /^(\d\d\d)\D/) {
 1306         if (defined $msg) {
 1307         push @msgs, $msg;
 1308         }
 1309         # extract the sequence msgs number
 1310         $line =~ /^(\d\d\d)(.*)$/;
 1311         $num  = $1;
 1312         $text = $2;
 1313         # prepend ": " if any text exists
 1314         $text = ": $text" if $text !~ /^\s*$/;
 1315         # decode our message
 1316         if (defined $SeqMinor{$num}) {
 1317         $msg = "$SeqMinor{$num}$text";
 1318         } else {
 1319         $msg = "(undefined Sequence: $num)$text";
 1320         }
 1321 
 1322     } else {
 1323         $msg .= $line;
 1324     }
 1325     }
 1326     push @msgs, $msg if defined $msg;
 1327 
 1328     foreach $msg (@msgs) {
 1329     # drop standard signalling messages
 1330     $msg =~ s/($ESC(\[p|$EOT)*|$ACK|$NAK|$RS)//g;
 1331 
 1332     $str .= "'" . Sendpage::Modem->HexStr($msg) . "'\n"
 1333         if $msg !~ /^[\s\n\r]*$/;
 1334     }
 1335 
 1336     return $str;
 1337 }
 1338 
 1339 sub maxchars { $_[0]->{MAXCHARS} }
 1340 
 1341 sub maxsplits { $_[0]->{MAXSPLITS} }
 1342 
 1343 sub SendMail
 1344 {
 1345     my ($self, $to, $from, $cc, $errorsto, $subject, $body) = @_;
 1346 
 1347     my($msg,$fh);
 1348 
 1349     $msg = new Mail::Send;
 1350 
 1351     if ($self->{DEBUG}) {
 1352     $main::log->do('debug',
 1353                "Emailing: To: '%s', Cc: '%s', "
 1354                . "From: '%s', Subject: '%s'",
 1355                $to, $cc, $from, $subject
 1356               );
 1357     }
 1358 
 1359     unless (defined $msg) {
 1360     $main::log->do('crit', "Cannot deliver email!  Mail::Send won't start");
 1361     } else {
 1362     $msg->to($to) if (defined($to) && $to ne "");
 1363     $msg->cc($cc) if (defined($cc) && $cc ne "");
 1364     $msg->set('X-Pager', "sendpage v$main::VERSION");
 1365     $msg->set('Errors-To',"<$errorsto>")
 1366         if (defined($errorsto) && $errorsto ne "");
 1367     $msg->set('From',$from);
 1368     $msg->subject($subject);
 1369 
 1370     # use mail-agent, see if the from gets passed now
 1371     $fh = $msg->open($self->{CONFIG}->get("mail-agent"));
 1372 
 1373     unless (defined $fh) {
 1374         $main::log->do('crit',
 1375                "Cannot deliver email!  Mail::Send won't open -- check your 'mail-agent' setting");
 1376     } else {
 1377         print $fh $body
 1378         || $main::log->do('crit',
 1379                   "Error writing email: %s", $!
 1380                  );
 1381         $fh->close
 1382         || $main::log->do('crit',
 1383                   "Error closing email -- check your 'mail-agent' setting: %s",
 1384                   $!
 1385                  );
 1386     }
 1387     }
 1388 }
 1389 
 1390 sub DESTROY
 1391 {
 1392     my $self = shift;
 1393 
 1394     $main::log->do('debug',
 1395            "PagingCentral object '$self->{NAME}' being destroyed")
 1396     if $self->{DEBUG};
 1397 
 1398     $self->disconnect();
 1399 }
 1400 
 1401 1;
 1402 
 1403 __END__
 1404 
 1405 =head1 AUTHOR
 1406 
 1407 Kees Cook <kees@outflux.net>
 1408 
 1409 =head1 SEE ALSO
 1410 
 1411 Man pages: L<perl>, L<sendpage>.
 1412 
 1413 Module documentation: L<Sendpage::KeesConf>, L<Sendpage::KeesLog>,
 1414 L<Sendpage::Modem>, L<Sendpage::PageQueue>, L<Sendpage::Page>,
 1415 L<Sendpage::Recipient>, L<Sendpage::Queue>
 1416 
 1417 =head1 COPYRIGHT
 1418 
 1419 Copyright 2000 Kees Cook.
 1420 
 1421 This library is free software; you can redistribute it and/or
 1422 modify it under the same terms as Perl itself.
 1423 
 1424 =cut