"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/sendpage" (16 Apr 2009, 48413 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.

    1 #!/usr/bin/perl
    2 #
    3 # sendpage is the tool that will handle all the paging functions
    4 #
    5 # $Id: sendpage 319 2009-04-16 19:19:06Z 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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
   23 # http://www.gnu.org/copyleft/gpl.html
   24 
   25 =head1 NAME
   26 
   27 sendpage - listen for pages via SNPP, and send pages via modem
   28 
   29 =head1 SYNOPSIS
   30 
   31 sendpage [OPTIONS] [recipient ...]
   32 
   33 =head1 OPTIONS
   34 
   35 =over 4
   36 
   37 =item -bd
   38 
   39 Start sendpage in "daemon mode" where it will start all the Paging
   40 Central queues and wait for pages to be delivered.  When sendpage
   41 runs as a daemon, it must be running as the 'sendpage' user as specified
   42 in the sendpage.cf file.
   43 
   44 =item -bp
   45 
   46 Display all the pages waiting in the Paging Central queues.
   47 
   48 =item -bv
   49 
   50 Try to expand the "recipient" name, using the recipient aliases specified
   51 in the configuration file.
   52 
   53 =item -bs
   54 
   55 Shutdown the running sendpage daemon and all its children.  If a Paging
   56 Central is in the middle of delivering a page, it will finish up and
   57 exit as soon as its current page is handled.
   58 
   59 =item -br
   60 
   61 This will send a SIGHUP to the master daemon.  When the master gets the
   62 SIGHUP, it will re-read its configuration file, and restart all the
   63 Paging Centrals.  It will wait for any busy Paging Centrals to finish
   64 before continuing.
   65 
   66 =item -bq
   67 
   68 This displays the state of the running daemons: Running or Not running.
   69 If a pid file is stale (the file exists, but the process doesn't), it
   70 will mark that pid as "Stale".
   71 
   72 =item -q[R pc]
   73 
   74 This will send a SIGUSR1 signal to either the master daemon, or,
   75 if the Paging Central is specified, just that Paging Central in particular.
   76 When the master gets a SIGUSR1, it will send it to each of the running Paging
   77 Centrals.  If the Paging Central is not busy, it will immediately start a
   78 queue run.
   79 
   80 =item -C FILE
   81 
   82 Read the configuration file FILE instead of the default /etc/sendpage.cf
   83 
   84 =item -h
   85 
   86 Display a summary of all the available command line options.
   87 
   88 =item -d
   89 
   90 Turn on debugging (like "debug=true" in /etc/sendpage.cf)
   91 
   92 =item -f USER
   93 
   94 Show that the sent page is coming from USER.  Default is the current user.
   95 
   96 =item -m MESSAGE
   97 
   98 Send the given MESSAGE instead of reading text from stdin.
   99 
  100 =item -n
  101 
  102 Do not notify the 'from' user about the status of the page.
  103 
  104 =back
  105 
  106 =head1 DESCRIPTION
  107 
  108 Sendpage can run as the delivery agent, or as a client to insert a page
  109 into the paging queue.  For the various command-line arguments, 
  110 the idea here was to use sendmail-style arguments where I can, not to
  111 fully implement every option that sendmail has.  I just want the
  112 learning curve of sendpage to be small for people already familiar
  113 with sendmail.
  114 
  115 =head1 FILES
  116 
  117 =over 4
  118 
  119 =item F</etc/sendpage.cf>
  120 
  121 Default location for sendpage.cf, which holds all the configuration
  122 information for sendpage, including Paging Central definitions,
  123 recipients, and various other behaviors.
  124 
  125 =item F</var/spool/sendpage>
  126 
  127 Default directory for all the Paging Central queues and pid files.
  128 
  129 =item F</var/lock>
  130 
  131 Default directory to keep the UUCP-style device locks.
  132 
  133 =back
  134 
  135 =head1 AUTHOR
  136 
  137 Kees Cook <kees@outflux.net>
  138 
  139 =head1 BUGS
  140 
  141 Oh, I bet this code is crawling with them.  :)  I've done my best to 
  142 test this code, but I'm only one person.  If you find strange behavior,
  143 please let me know.
  144 
  145 =head1 COPYRIGHT
  146 
  147 sendpage is free software; it can be used under the terms of the GNU
  148 General Public License.
  149 
  150 =head1 SEE ALSO
  151 
  152 L<perl>, L<kill>, L<Device::SerialPort>, L<Mail::Send>,
  153 L<Sendpage::KeesConf>, L<Sendpage::KeesLog>,
  154 L<Sendpage::Modem>, L<Sendpage::PagingCentral>, L<Sendpage::PageQueue>,
  155 L<Sendpage::Page>, L<Sendpage::Recipient>, L<Sendpage::Queue>
  156 
  157 =cut
  158 
  159 # we need at least this version.  FIXME: I forgot why, though.  :P
  160 require 5.006;
  161 
  162 # Global variables;
  163 $VERSION=1.001_001; # our version!
  164 $VERSION_human=sprintf("%d.%d.%d",
  165                int(${VERSION}),
  166                substr((${VERSION}=~/^\d\.(\d+)$/)[0],0,3),
  167                substr((${VERSION}=~/^\d\.(\d+)$/)[0],3,3));
  168 
  169 my $config;         # holds the configuration object
  170 undef $log;         # holds logging object
  171 my $db;             # holds the db object, if used
  172 
  173 # Module-global variables
  174 my %CHILDREN;           # who the childrens are
  175 my $SHUTDOWN;           # when to shutdown
  176 my $RELOAD;         # when we're reloading
  177 my $DEBUG;          # for debugging
  178 my $DEBUG_SELECT;       # for debugging select loop
  179 my $DEBUG_SNPP;         # for debugging SNPP issues
  180 my %opts;           # holds the command line args hash
  181 undef @modems;          # List of available modems
  182 undef @pcs;         # List of enabled PCs
  183 
  184 # Global socket variables
  185 undef $server;          # holds the SNPP server obj
  186 undef $s;           # holds our Select set
  187 undef %CNXNS;         # List of open SNPP client pipes by filehandle
  188 undef %PIPES;           # List of open SNPP client pipes by PID
  189 
  190 # Global queue run variables
  191 my $PC;             # holds name of PC for queue runners
  192 my $sleeptime;          # holds sleeptime for next queue delay
  193 
  194 # FIXME: load modules in a nice error-correcting fashion (borrow from mr house)
  195 use POSIX;
  196 use Getopt::Std;
  197 use Sendpage::Modem;
  198 use Sendpage::KeesConf;
  199 use Sendpage::PagingCentral;
  200 use Sendpage::PageQueue;
  201 use Sendpage::Page;
  202 use Sendpage::Recipient;
  203 use Sendpage::KeesLog;
  204 use Sendpage::SNPPServer;
  205 use Sendpage::Db;
  206 use Socket;
  207 use IO::Select;
  208 use IO::Pipe;
  209 use Sys::Hostname::Long;
  210 
  211 sub Usage
  212 {
  213     die "Usage: $0 [OPTIONS] [alias ...]
  214 version $VERSION_human
  215 
  216 General Options
  217     -h      you're reading it.  :)
  218     -d      turn debug on
  219     -C FILE     use FILE as the sendpage.cf file
  220     -t      test all configured modems
  221 
  222 Daemon Options
  223     -bd     run in daemon mode
  224     -bp     display the queues
  225     -bv     verify addresses
  226     -bs     shutdown server
  227     -br     have server reload configurations
  228     -bq     query state of daemons
  229     -q      force a queue run
  230     -qR PC      force a queue run only for the PC paging central
  231 
  232 Page Queuing Options
  233     -f USER         force page to be from USER (default is current user)
  234     -m MESSAGE      message to send (reads from stdin by default)
  235     -n              no email status sent to 'from' for this page
  236 
  237 ";
  238 }
  239 
  240 # Start logging immediately
  241 $log=Sendpage::KeesLog->new(Syslog => 0);
  242 
  243 # get our options
  244 if (!getopts('htvdqC:b:R:f:m:n',\%opts) || $opts{h}) {
  245     Usage();
  246 }
  247 
  248 # build default configuration, with any command line info
  249 $config=initConfig(\%opts);
  250 
  251 # load configuration
  252 Initialize();
  253 
  254 # Restart logging
  255 $log->reconfig(Syslog => $config->get("syslog"),
  256            Opts  => $config->get("syslog-opt"),
  257            Facility => $config->get("syslog-facility"),
  258            MinLevel => $config->get("syslog-minlevel"),
  259           );
  260 
  261 # Mode of operation selection
  262 #
  263 #   Modes:
  264 #       - daemon (spawn queue runners, listen for pages)
  265 #       - queue display
  266 #       - address expansion
  267 #       - force a queue run (optionally for only a certain PC)
  268 #
  269 if ($opts{t}) {
  270     ModemInit();
  271     exit(0);
  272 }
  273 if ($opts{b}) {
  274     QueryDaemons(1) if ($opts{b} eq "q");
  275     SendHUP() if ($opts{b} eq "r");
  276     ShutdownEverything() if ($opts{b} eq "s");
  277     BecomeDaemon() if ($opts{b} eq "d");
  278     DisplayQueue() if ($opts{b} eq "p");
  279     VerifyAddress(@ARGV) if ($opts{b} eq "v");
  280 
  281     warn "Unknown run mode: '$opts{b}'\n";
  282     Usage();
  283 }
  284 if ($opts{q}) {
  285     my $ret=SendSignal('USR1',$opts{R} ? $opts{R} : "");
  286 
  287     # FIXME: should run the queue by hand if no one else can
  288     die "Failed to notify queue manager: $!\nMaybe you should run me with -bd?\n" if (!defined($ret) || $ret != 0);
  289     exit;
  290 }
  291 
  292 
  293 die "Must be root to write pages directly to queue.  Please use 'snpp' instead.\n"
  294     if (!VerifyIdentities());
  295 DropPrivs();
  296 
  297 if (!@ARGV) {
  298     Usage();
  299 }
  300 else {
  301     my $msg=$opts{m};
  302 
  303     # it's time to write a file directly to the queue
  304 
  305     # who is it from?
  306     if (!defined($opts{f}) && !$opts{n}) {
  307     $opts{f}=scalar(getpwuid($<))."\@";
  308     $opts{f}.=hostname_long();
  309     }
  310 
  311     if (!defined($msg)) {
  312     my $line;
  313     while ($line=<STDIN>) {
  314         $msg.=$line;
  315     }
  316     }
  317 
  318     # generate errors to the stderr
  319     ArrayDig(@ARGV);
  320 
  321     # turn on syslog for queue logging
  322     $log->on();
  323 
  324     # try to write the pages
  325     exit Sendpage::SNPPServer->write_queued_pages(undef,$opts{f},$msg,
  326                           $config,$log,$DEBUG,@ARGV);
  327 }
  328 
  329 sub QueryDaemons
  330 {
  331     my($display)=@_;
  332     my(@check,$pc,$pid,$state,$running,$disabled);
  333 
  334     undef $running;
  335     @check=@pcs;
  336     unshift(@check,"");
  337     foreach $pc (@check) {
  338     if ($pc ne "" && $config->get("pc:$pc\@enabled")==0) {
  339         $disabled=1;
  340     }
  341     else {
  342         $disabled=0;
  343     }
  344     $pid=PidOf($pc,1);
  345     if ($pid==0) {
  346         $state="Not running";
  347     }
  348     else {
  349         undef $!;
  350         kill 0, $pid;
  351         if ($! == ESRCH) {
  352         $state="Stale: not running";
  353         }
  354         else {
  355         $state="Running";
  356         $running=1;
  357         }
  358     }
  359     printf("%-6d %20s : %s%s\n",$pid,
  360            ($pc eq "") ? 'Queue Manager' : $pc, $state,
  361            $disabled ? " (disabled)" : "")
  362         if ($display);
  363     }
  364 
  365     exit(0) if ($display);
  366 
  367     return $running;
  368 }
  369 
  370 sub SendHUP
  371 {
  372     my $ret=SendSignal('HUP',"");
  373     die "Failed to notify queue manager: $!\n" if (!defined($ret) || $ret != 0);
  374     exit;
  375 }
  376 
  377 sub ShutdownEverything
  378 {
  379     # there's no need for individual killing is there?
  380     #my $ret=SendSignal('QUIT',$opts{R} ? $opts{R} : "");
  381     my $ret=SendSignal('QUIT',"");
  382     warn "Failed to notify queue manager: $!\n" if (!defined($ret) || $ret != 0);
  383     exit;
  384 }
  385 
  386 sub Initialize
  387 {
  388     &loadConfig();
  389     $DEBUG=$config->get("debug");
  390     $DEBUG_SELECT=$config->get("debug-select");
  391     $DEBUG_SNPP=$config->get("debug-snpp");
  392     @pcs=$config->instances("pc");
  393     undef %pcs; grep($pcs{$_}=1,@pcs);
  394     @modems=$config->instances("modem");
  395 }
  396 
  397 # plops down a pid file
  398 sub RecordPidFile
  399 {
  400     my($name,$pid)=@_;
  401     my($file);  
  402 
  403     $name=".$name" if ($name ne "");
  404     $file=$config->get("pidfileprefix").$name.".pid";
  405     open(FILE,">$file") || $log->do('err',"Cannot write to '$file': %s",$!);
  406     print FILE $pid,"\n";
  407     close(FILE);
  408 }
  409 
  410 # deletes a pid file by name
  411 sub YankPidFile
  412 {
  413     my($name)=@_;
  414     my($file);
  415 
  416     $name=".$name" if ($name ne "");
  417     $file=$config->get("pidfileprefix").$name.".pid";
  418     unlink($file) || $log->do('err',"Cannot unlink '$file': %s",$!);
  419 }
  420 
  421 # sends a signal to the specified PID
  422 # returns non-0 on failure
  423 sub SendSignal
  424 {
  425     my($sig,$pid)=@_;
  426 
  427     if ($pid !~ /^\d+$/) {
  428     $pid=PidOf($pid);
  429     }
  430 
  431     return undef if ($pid == 0);
  432 
  433     $log->do('debug',"signalling '$sig' to pid '$pid'") if ($DEBUG);
  434     undef $!;
  435     kill $sig, $pid;
  436     return $!+0;
  437 }
  438 
  439 # tries to find the PID of a certain sendpage
  440 # return PID, or 0 or failure
  441 sub PidOf
  442 {
  443     my($name,$quiet)=@_;
  444     my($file,$pid);
  445 
  446     if ($name ne "") {
  447     if (!defined($pcs{$name})) {
  448         $log->do('warning',"No such PC '$name'");
  449         return 0;
  450     }
  451     $name=".$name";
  452     }
  453 
  454     $pid=0;
  455     $file=$config->get("pidfileprefix").$name.".pid";
  456     if (-f $file) {
  457     my $line;
  458 
  459     open(FILE,"<$file") || $log->do('err',"Cannot read '$file': %s",$!);
  460     chomp($line=<FILE>);
  461 
  462     # this is used to untaint for a sendpage -q
  463     if ($line=~/^(\d+)$/) {
  464         $pid=$1;
  465     }
  466     close(FILE);
  467     }
  468     else {
  469     my $warning=sprintf("No pid file found for sendpage%s!",
  470                 $name);
  471     $log->do('warning',"%s",$warning) if (!defined($quiet));
  472     }
  473     return ($pid+0);
  474 }
  475 
  476 sub NiceShutdown
  477 {
  478     $SIG{QUIT}=$SIG{INT}=DEFAULT;
  479 
  480     $SHUTDOWN=1;
  481     if ($PC eq "") {
  482     my($pc,$cnxn);
  483 
  484     # Shutdown PCs
  485     foreach $pc (@pcs) {
  486         if ($config->get("pc:$pc\@enabled")==0) {
  487         next;
  488         }
  489         $log->do('debug',"Signalling '$pc' ...") if ($DEBUG);
  490         SendSignal('QUIT',$pc);
  491     }
  492     # Shut down SNPP clients
  493     foreach $cnxn (keys %PIPES) {
  494         $log->do('debug',"Signalling SNPP client '$cnxn' ...")
  495         if ($DEBUG);
  496         SendSignal('QUIT',$cnxn);
  497     }
  498     }
  499     else {
  500     $log->do('debug',"Shutting down nicely: '$PC'") if ($DEBUG);
  501     }
  502 }
  503 
  504 sub ImmediateShutdown
  505 {
  506     $SIG{TERM}=DEFAULT;
  507     $log->do('debug',"Shutting down immediately") if ($DEBUG);
  508     exit(0);
  509 }
  510 
  511 sub QueueRun
  512 {
  513     #$log->do('debug',"Pid $$ heard signal USR1") if ($DEBUG);
  514 
  515     # we need to signal all the PC's if we're master
  516     if ($PC eq "") {
  517     my $pc;
  518     foreach $pc (@pcs) {
  519         if ($config->get("pc:$pc\@enabled")==0) {
  520         next;
  521         }
  522         $log->do('debug',"Signalling '$pc' ...") if ($DEBUG);
  523         SendSignal('USR1',$pc);
  524     }
  525     }
  526     else {
  527     # perform queue run
  528     $log->do('debug',"QueueRun requested for '$PC' ...")
  529         if ($DEBUG);
  530 
  531     # if we get a request for this DURING a queue run, we
  532     #  should immediately rescan our queue.  To do this,
  533     #  we set our next sleeptime to 0
  534     $sleeptime=0;
  535     }
  536 }
  537 
  538 sub DisplayQueue
  539 {
  540     my($queue, $waiting, $page, $recip);
  541 
  542     foreach $pc (@pcs) {
  543     $queue=Sendpage::PageQueue->new($config,$config->get("queuedir")."/$pc");
  544 
  545     if (($waiting=$queue->ready())>-1) {
  546         print "\nin the '$pc' queue: ".($waiting+1)."\n";
  547         while (defined($page=$queue->getPage())) {
  548         print "\tqueue filename: ".$queue->file()."\n";
  549         print "\tattempts:       ".$page->attempts()."\n";
  550         print "\tfrom:           ".$page->option('from')."\n"
  551             if ($page->option('from') ne "");
  552         print "\tqueued at:      ".scalar(localtime($page->option('queued')))."\n"
  553             if ($page->option('queued') ne "");
  554         print "\tdeliverable:    ".($page->deliverable() ? "yes" : "pending")."\n";
  555         print "\tdeliverable at: ".scalar(localtime($page->option('when')))."\n"
  556             if ($page->option('when') ne "");
  557         for ($page->reset(), $page->next();
  558              defined($recip=$page->recip());
  559              $page->next()) {
  560             print "\tdest: '".$recip->name()."' (pin '".$recip->pin()."', email '".$recip->datum('email-cc')."')\n";
  561         }
  562         $queue->fileDone();
  563         print "\n";
  564         }
  565     }
  566     }
  567     exit(0);
  568 }
  569 
  570 sub VerifyAddress
  571 {
  572     my ($fail,@recips);
  573     ($fail,@recips)=ArrayDig(@ARGV);
  574     if ($fail != 0) {
  575     exit(1);
  576     }
  577     foreach $recip (@recips) {
  578     print "deliverable: ".$recip->name()." as ".$recip->pin().
  579         " via ".$recip->pc()." (email is '".$recip->datum('email-cc')."')\n";
  580     }
  581     exit(0);
  582 }
  583 
  584 sub ModemInit
  585 {
  586     my $modref;
  587 
  588     # test modems, keeping functioning ones in a list for the PCs to pick
  589     if ($DEBUG) {
  590     grep($log->do('debug',"found listing for modem: $_"),@modems);
  591     grep($log->do('debug',"found listing for pc: $_"),@pcs);
  592     }
  593 
  594     # should be limit which modems we're using?
  595     if (defined($modref=$config->get("modems",1))) {
  596     # we should limit the modem list
  597     @modems=@{ $modref };
  598     grep($log->do('debug',"using specified modem: $_"),@modems)
  599         if ($DEBUG);
  600     }
  601     else {
  602     # pull from instance list
  603     @modems=$config->instances("modem");
  604     }
  605     # check the modems
  606     @modems=verifyModems(@modems);
  607     grep($log->do('debug',"found functioning modem: $_"),@modems)
  608     if ($DEBUG);
  609 
  610     $log->do('alert',"no functioning modems!") if (!defined($modems[0]));
  611 }
  612 
  613 sub BlockSignals
  614 {
  615     # define the signals to block
  616     my $sigset = POSIX::SigSet->new(SIGINT,  SIGTERM, SIGQUIT, 
  617                     SIGUSR1, SIGHUP, SIGPIPE);
  618 
  619     # start blocking signals
  620     unless (defined sigprocmask(SIG_BLOCK, $sigset)) {
  621     $log->do('alert',"Could not block signals!");
  622     }
  623 
  624     return $sigset;
  625 }
  626 
  627 sub UnblockSignals
  628 {
  629     # define the signals to block
  630     my $sigset = POSIX::SigSet->new(SIGINT,  SIGTERM, SIGQUIT, 
  631                     SIGUSR1, SIGHUP, SIGPIPE);
  632 
  633     # stop blocking signals
  634     unless (defined sigprocmask(SIG_UNBLOCK, $sigset)) {
  635     $log->do('alert',"Could not unblock signals!");
  636     }
  637 }
  638 
  639 # start one or all the children
  640 sub SpawnChildren
  641 {
  642     my($which)=@_;
  643 
  644     my($pid,$pc,@which,$sigset);
  645 
  646     if (defined($which)) {
  647     undef @which;
  648     push(@which,$which);
  649     }
  650     else {
  651     @which=@pcs;
  652     undef %CHILDREN;
  653     undef %STARTED;
  654     $log->do('info',"starting Queue Manager (sendpage v$VERSION_human)");
  655     }
  656 
  657     # there was a race condition here between the fork
  658     #    and the call to "SignalInit" where a child could
  659     #    think it was still the manager, and receive yet
  660     #    another signal, and act on it.   Now we block signals.
  661 
  662     # spawn PCs
  663     foreach $pc (@which) {
  664     if ($config->get("pc:$pc\@enabled")==0) {
  665         next;
  666     }
  667 
  668     # start blocking signals
  669     $sigset=&BlockSignals();
  670 
  671     $pid=fork();
  672     if ($pid<0) {
  673         # failure
  674         $log->do('emerg',"Cripes!  Cannot spawn process: %s",$!);
  675     }
  676     elsif ($pid>0) {
  677         # parent
  678         $log->do('debug',"spawned child: $pid for PC '$pc'")
  679         if ($DEBUG);
  680         $CHILDREN{$pid}=$pc;
  681         $STARTED{$pc}=time;
  682         RecordPidFile($pc,$pid);
  683     }
  684     else {
  685         # child
  686 
  687         # set up
  688         &DropPrivs(1);
  689         &SignalInit();
  690 
  691         $log->do('debug',"I am child: $$ for PC '$pc'")
  692         if ($DEBUG);
  693         &CheckFDs();
  694 
  695         &StartQueue($pc,$sigset);
  696         $log->do('crit',"PC '$pc' stopped processing!  ".
  697              "Whoops, that can't happen!");
  698         exit(1);
  699     }
  700 
  701     # stop blocking signals
  702     &UnblockSignals($sigset);
  703     }
  704 }
  705 
  706 # should they get serial port rights?
  707 sub DropPrivs
  708 {
  709     my ($serial)=@_;
  710 
  711     my $grouplist="nobody";
  712 
  713     if (!defined($setUID)) {
  714     $log->do('crit',"Effective User ID unknown -- aborting!");
  715     exit(1);
  716     }
  717     if (defined($serial)) {
  718     if (!defined($lockGID)) {
  719         $log->do('crit',"Effective Group ID for locking unknown -- aborting!");
  720         exit(1);
  721     }
  722     if (!defined($ttyGID)) {
  723         $log->do('crit',"Effective Group ID for tty read/write unknown -- aborting!");
  724         exit(1);
  725     }
  726     $grouplist="$lockGID $ttyGID";
  727     }
  728 
  729     $(=$)=$grouplist;
  730     if ($( != $grouplist) {
  731     $log->do('crit',"Could not setgid to '$grouplist': %s -- aborting!",$!);
  732     }
  733 
  734     $<=$>=$setUID;
  735     if ($< != $setUID) {
  736     $log->do('crit',"Could not setuid: %s -- aborting!",$!);
  737     }
  738 }
  739 
  740 # Debugging routine to check on the state of open file descriptors.
  741 # I used this will tracking weird problems with the select loop.
  742 sub CheckFDs
  743 {
  744     return unless ($DEBUG);
  745     for (my $fd = 0; $fd < 10; $fd ++ ) {
  746     my $fh = IO::Handle->new_from_fd( $fd, "r" );
  747     if (defined($fh)) {
  748         $log->do('debug',"$fd: open");
  749     }
  750     #       else {
  751     #           $log->do('debug',"$fd: $!");
  752     #       }
  753     }
  754 }
  755 
  756 sub Respawn
  757 {
  758     my($undef,$forwarded) = @_;
  759     my($pid,$pc,$now);
  760 
  761     $!=0;
  762     if ($forwarded) {
  763     $pid=$forwarded;
  764     }
  765     else {
  766     $pid=wait;
  767     }
  768 
  769     # quit out if we're done (wait will sleep)
  770     return if ($SHUTDOWN==1);
  771 
  772     if ($pid==-1) {
  773     if ($!==ECHILD) {
  774         $log->do('warning',"No children on SIGCHLD?!  Shutting down...");
  775         $SHUTDOWN=1;
  776         return;
  777     }
  778     else {
  779         $log->do('warning',"Oops: waitpid spat totally unexpected error: %s",$!);
  780         return;
  781     }
  782     }
  783     if (defined($CHILDREN{$pid})) {
  784     $log->do('debug', "pid $pid died: '".$CHILDREN{$pid}."'")
  785         if ($DEBUG);
  786 
  787     $pc=$CHILDREN{$pid};
  788     $now=time;
  789 
  790     # restart within the same 10 seconds??
  791     if ($now<($STARTED{$pc}+10)) {
  792         $log->do('alert',"Ugly nasty problem with $CHILDREN{$pid} queue manager!");
  793         $log->do('alert',"The same PC has died twice rather quickly.  Shutting it down.");
  794     }
  795     else {
  796         $log->do('err',"Whoa!  The '$CHILDREN{$pid}' PC died unexpectedly -- restarting it.");
  797         SpawnChildren($CHILDREN{$pid});
  798     }
  799     }
  800     elsif (defined($PIPES{$pid})) {
  801     $log->do('debug',"SNPP connection (pid $pid) finished") if ($DEBUG_SNPP);
  802     # Only handle PID shutdown here
  803     #       $log->do('debug',"(select: removing pipe ".fileno($PIPES{$pid}).")")
  804     #           if ($DEBUG_SELECT);
  805     #       $s->remove($PIPES{$pid}); # don't select on this handle anymore
  806     #       PipeShutdownPipe($PIPES{$pid});
  807     PipeShutdownPid($pid);
  808     }
  809     else {
  810     # defunct children?  no!  bastards!  :)
  811     $log->do('warning',"Bastard child detected!  Unknown PID '$pid' was reaped.");
  812     }
  813 }
  814 
  815 sub SignalInit
  816 {
  817     # set up signal handlers for children
  818     #$SIG{'CHLD'}='IGNORE';
  819     $SIG{'HUP'}='IGNORE';
  820     $SIG{'USR1'}='IGNORE';
  821     $SIG{'PIPE'} = 'IGNORE';
  822     $SIG{'INT'}=$SIG{'QUIT'}=\&NiceShutdown;
  823     $SIG{'TERM'}=\&ImmediateShutdown;
  824 }
  825 
  826 sub VerifyIdentities
  827 {
  828     my($user,$group,$name);
  829 
  830     # check for our setuid user
  831     $user=$config->get('user');
  832     ($name,undef,$setUID)=getpwnam($user);
  833     if (!defined($name)) {
  834     $log->do('crit',"There is no such user named '$user'!  Aborting...");
  835     return undef;
  836     }
  837 
  838     # check for our locking group
  839     $group=$config->get('group-lock');
  840     ($name,undef,$lockGID)=getgrnam($group);
  841     if (!defined($name)) {
  842     $log->do('crit',"There is no such group named '$group'!  Aborting...");
  843     return undef;
  844     }
  845 
  846     # check for our tty r/w group
  847     $group=$config->get('group-tty');
  848     ($name,undef,$ttyGID)=getgrnam($group);
  849     if (!defined($name)) {
  850     $log->do('crit',"There is no such group named '$group'!  Aborting...");
  851     return undef;
  852     }
  853 
  854     # are we root?
  855     if (0 != $<) {
  856     return undef;
  857     }
  858 
  859     return 1;
  860 }
  861 
  862 sub BecomeDaemon
  863 {
  864     # check to see if we're already running
  865     if (QueryDaemons()) {
  866     warn "Already running:\n";
  867     QueryDaemons(1);
  868     }
  869 
  870     if (!VerifyIdentities()) {
  871     $log->do('crit',"Must be running as 'root' to daemonize!  Aborting...");
  872     exit(1);
  873     }
  874 
  875     # daemon mode starts here
  876     ModemInit();
  877 
  878     SignalInit();
  879 
  880     $PC="";
  881 
  882     # close file handles.  (unless debugging)
  883     close(STDIN);
  884     close(STDOUT);
  885     close(STDERR) unless ($DEBUG || $DEBUG_SELECT || $DEBUG_SNPP);
  886 
  887     # Become a daemon
  888     my $pid = fork;
  889     exit if $pid;
  890     die "Couldn't fork: $!" unless defined($pid);
  891     POSIX::setsid() or die "Can't start a new session: $!";
  892 
  893     # reconfig, and reopen syslog connection
  894     $log->reconfig(Syslog => $config->get("syslog"),
  895            Opts  => $config->get("syslog-opt"),
  896            Facility => $config->get("syslog-facility"),
  897            MinLevel => $config->get("syslog-minlevel"),
  898           );
  899     $log->on();
  900 
  901     $0="sendpage: accepting connections";
  902     $SHUTDOWN=0;
  903     RecordPidFile($PC,$$);
  904 
  905     # build new loop selector
  906     $s=IO::Select->new();
  907 
  908     # start the queue runners
  909     SpawnChildren();
  910 
  911     # listen for USR1 to send USR1s
  912     $SIG{'USR1'} = \&QueueRun;
  913     # listen for reload info
  914     $SIG{'HUP'}=\&Reload;
  915     # listen for children death
  916     #$SIG{'CHLD'}=\&Respawn;
  917 
  918     # start the SNPP stuff now
  919     StartSNPP();
  920 
  921     # Enter the main processing loop
  922     MainLoop();
  923 
  924     die "parent died: this should never have happened: $!\n";
  925 }
  926 
  927 sub initSNPP
  928 {
  929     my $host=$config->get("snpp-addr");
  930     my $port=$config->get("snpp-port");
  931 
  932     # need to use "create" so that the "accept"s don't call the constructor
  933     $server=Sendpage::SNPPServer->create(Addr => $host, Port => $port);
  934 
  935     if (defined($server)) {
  936     $log->do('debug',"SNPP listener running on %s:%d",
  937          $server->sockhost,
  938          $server->sockport) if ($DEBUG_SNPP);
  939     }
  940     else {
  941     $log->do('crit',"SNPP listener for '%s:%s' failed: %s",
  942          $host,$port,$!);
  943     }
  944 
  945     # Expand our snpp ACLs so we don't have to during each connection
  946     @ACLs=();
  947     my $item;
  948     foreach $item (@{$config->get("snpp-acl")}) {
  949     my ($netmask,$way) = split(/:/,$item,2);
  950     $way=uc($way);
  951     my ($net_str,$mask_str) = split(/\//,$netmask,2);
  952     $log->do('debug',"ACL loaded: '$net_str'/'$mask_str' is '$way'")
  953         if ($DEBUG_SNPP);
  954 
  955     my $net  = inet_aton($net_str);
  956     my $mask = inet_aton($mask_str);
  957 
  958     push(@ACLs,[ $net, $mask, $net_str, ($way eq "ALLOW") ]);
  959     }
  960 }
  961 
  962 sub StopSNPP
  963 {
  964     $log->do('debug',"SNPP listeners shutting down")
  965     if ($DEBUG_SNPP);
  966     $log->do('debug',"(select: dropping ".fileno($server).")")
  967     if ($DEBUG_SELECT);
  968     $s->remove($server);
  969     $server->close();
  970     undef $server;
  971 }
  972 
  973 sub StartSNPP
  974 {
  975     $log->do('info',"starting SNPP listeners");
  976     initSNPP();
  977     if (defined($server)) {
  978     $log->do('debug',"(select: adding server ".fileno($server).")")
  979         if ($DEBUG_SELECT);
  980     $s->add($server);
  981     }
  982 }
  983 
  984 sub RestartSNPP
  985 {
  986     StopSNPP();
  987     StartSNPP();
  988 }
  989 
  990 # FIXME: have all the ACLs pre-expanded for us...
  991 sub IPAllowed
  992 {
  993     my $sock=shift;
  994 
  995     # Verify that this connection is allowed
  996 
  997     my $peer=$sock->peerhost();
  998 
  999     my $other_end = $sock->peername();
 1000     if (!defined($other_end)) {
 1001     $log->do('alert',"SNPP client '$peer' failed getpeername!");
 1002     return undef;
 1003     }
 1004     my ($port, $iaddr) = unpack_sockaddr_in($other_end);
 1005     my $other_ip_address = inet_ntoa($iaddr);
 1006 
 1007     # Compare this IP address to our ACL list
 1008     my $item;
 1009     my $allowed=0;
 1010     my $found=0;
 1011     foreach $item (@ACLs) {
 1012     my ($net,$mask,$net_str,$allow) = @{$item};
 1013 
 1014     # Drop the peer IP through the mask
 1015     my $net_check = ($iaddr & $mask);
 1016 
 1017     my $check_str=inet_ntoa($net_check);
 1018 
 1019     if ($DEBUG_SNPP) {
 1020         my $mask_str=inet_ntoa($mask);
 1021         $log->do('debug',"ip: '$peer' mask: '$mask_str' ".
 1022              "masked: '$check_str' net: '$net_str'");
 1023     }
 1024 
 1025     # if result is our network, we have a hit
 1026     if ($check_str eq $net_str) {
 1027         $found=1;
 1028         $log->do('debug', "Matched ACL") if ($DEBUG_SNPP);
 1029         if ($allow==1) {
 1030         $allowed=1;
 1031         }
 1032         # if not allow, then reject
 1033         last;
 1034     }
 1035     }
 1036     if ($DEBUG_SNPP && $found == 0) {
 1037     $log->do('debug',"No ACL matched '$peer'");
 1038     }
 1039     if ($allowed != 1) {
 1040     $sock->command("421 Connection denied");
 1041     $log->do('info',"SNPP client '$peer' rejected");
 1042     return undef;
 1043     }
 1044     return 1;
 1045 }
 1046 
 1047 # This main loop cycles through all the pending socket connections:
 1048 #  - SNPP listeners to spawn SNPP clients
 1049 #  - SNPP client pipes to start PC queue runs
 1050 sub MainLoop
 1051 {
 1052     my($fh,$read,$exc,$pipe,$sigset,$match,$pid);
 1053 
 1054     while ($SHUTDOWN!=1) {
 1055     if (!defined($server)) {
 1056         $log->do('crit',"Cannot start any SNPP listeners -- ".
 1057              "aborting!");
 1058         NiceShutdown();
 1059         YankPidFile("");
 1060         exit(1);
 1061     }
 1062 
 1063     # reset my containers
 1064     $read=$exc=undef;
 1065 
 1066     if ($DEBUG_SELECT) {
 1067         grep($log->do('debug',"select set: ".fileno($_)),
 1068          $s->handles());
 1069     }
 1070 
 1071     # handle children dying
 1072     while (($pid = waitpid(-1,&WNOHANG))>0) {
 1073         &Respawn('',$pid);
 1074     }
 1075 
 1076     if ($s->count()<1) {
 1077         $log->do('warning',"Whoa!  Nothing left in the select array -- restarting SNPP!");
 1078         RestartSNPP();
 1079     }
 1080 
 1081     $log->do('debug',"(select starting)") if ($DEBUG_SELECT);
 1082     $match=0;
 1083     $!=0;
 1084     my @events = IO::Select->select($s,undef,$s,1.0);
 1085     if (scalar(@events)==0 && $! != 0) {
 1086         if ($! == &EINTR()) {
 1087         $match=1;
 1088         $log->do('debug',"select loop: %s -- continuing",$!)
 1089             if ($DEBUG_SELECT);
 1090         }
 1091         else {
 1092         $log->do('warning',"select loop failed: %s",$!);
 1093         }
 1094     }
 1095     $log->do('debug',"(select finished)") if ($DEBUG_SELECT);
 1096 
 1097     ($read,undef,$exc)=@events;
 1098     foreach $fh (@$read) {
 1099         # Handle a new SNPP connection
 1100         if ($fh == $server) {
 1101         my $pid;
 1102         my $sock = $fh->accept;
 1103 
 1104         $match=1;
 1105 
 1106         if (!defined($sock)) {
 1107             $log->do('err',"SNPP accept: %s",$!);
 1108             next;
 1109         }
 1110 
 1111         $log->do('debug',"got connection from %s",
 1112              $sock->peerhost) if ($DEBUG_SNPP);
 1113 
 1114         if (!IPAllowed($sock)) {
 1115             close($sock);
 1116             next;
 1117         }
 1118 
 1119         $pipe = new IO::Pipe;
 1120 
 1121         $sigset=&BlockSignals();
 1122 
 1123         if (($pid = fork())>0) {
 1124             # Parent
 1125 
 1126             # close other side of pipe
 1127             $pipe->reader();
 1128             # close our forked socket
 1129             close($sock);
 1130 
 1131             $log->do('debug',"(select: adding pipe ".fileno($pipe).")")
 1132             if ($DEBUG_SELECT);
 1133             $s->add($pipe);
 1134             PipeRemember($pipe,$pid);
 1135         }
 1136         elsif ($pid==0) {
 1137             # Child
 1138 
 1139             # close other side of pipe
 1140             $pipe->writer();
 1141             $pipe->autoflush(1);
 1142 
 1143             # close master socket
 1144             close $fh;
 1145             # FIXME: close ALL snpp listeners
 1146 
 1147             # set up identity
 1148             $PC="SNPP client";
 1149             $0="sendpage: SNPP client: ".
 1150             $sock->peerhost;
 1151             &DropPrivs();
 1152             &SignalInit();
 1153 
 1154             $log->do('debug',"I am child: $$ for SNPP")
 1155             if ($DEBUG);
 1156             &CheckFDs();
 1157 
 1158             # we will unblock signals in
 1159             #  the snpp handler
 1160             $sock->HandleSNPP(
 1161                       "SNPP Sendpage $VERSION_human",
 1162                       $pipe, $config, $log,
 1163                       $DEBUG_SNPP, $sigset);
 1164             $log->do('debug',
 1165                  "leaving SNPP client cnxn")
 1166             if ($DEBUG_SNPP);
 1167 
 1168             exit(0);
 1169 
 1170         }
 1171         else {
 1172             $log->do('err',"SNPP fork: %s",$!);
 1173             # error on fork
 1174             close($sock);
 1175         }
 1176 
 1177         &UnblockSignals($sigset);
 1178         }
 1179         # Handle SNPP client notifications
 1180         elsif (defined($pid=$CNXNS{$fh})) {
 1181         $match=1;
 1182 
 1183         # is this pipe shutdown?
 1184         if ($fh->eof()) {
 1185             PipeShutdownPipe($fh);
 1186             $log->do('debug',"(select: removing pipe ".fileno($fh).")")
 1187             if ($DEBUG_SELECT);
 1188             $s->remove($fh);
 1189             close($fh);
 1190         }
 1191         # something is readable from a pipe
 1192         else {
 1193             chomp(my $pc=<$fh>);
 1194 
 1195             SendSignal('USR1',$pc) if ($pc ne "");
 1196         }
 1197         }
 1198         else {
 1199         $match=1;
 1200 
 1201         # toss any straggling pipes
 1202         $log->do('debug',"(select: removing stale selectable file handle: ".fileno($fh).")")
 1203             if ($DEBUG_SELECT);
 1204         $s->remove($fh);
 1205         close($fh);
 1206         }
 1207     }
 1208     # Deal with exceptions
 1209     foreach $fh (@$exc) {
 1210         if ($fh == $server) {
 1211         $match=1;
 1212 
 1213         $log->do('err',"Whoa!  Server socket took a hit!  -- reopening it");
 1214         RestartSNPP();
 1215         }
 1216         else {
 1217         $match=1;
 1218 
 1219         $log->do('warning',"SNPP connection took a hit!");
 1220         $log->do('debug',"(select: removing server ".fileno($fh).")")
 1221             if ($DEBUG_SELECT);
 1222         $s->remove($fh);
 1223         close($fh);
 1224         }
 1225     }
 1226 
 1227     #   if ($match==0) {
 1228     #       $log->do('warning',"Select produced an unmatched file descriptor?!");
 1229     #   }
 1230     }
 1231     $log->do('info',"stopping Queue Manager and SNPP listeners (sendpage v$VERSION_human)");
 1232     StopSNPP();
 1233     YankPidFile("");
 1234     exit(0);
 1235 }
 1236 
 1237 sub PipeShutdownPipe
 1238 {
 1239     my $pipe = shift;
 1240 
 1241     delete $CNXNS{$pipe};
 1242 }
 1243 
 1244 sub PipeShutdownPid
 1245 {
 1246     my $pid = shift;
 1247 
 1248     delete $PIPES{$pid};
 1249 }
 1250 
 1251 sub PipeRemember
 1252 {
 1253     my($pipe,$pid)=@_;
 1254 
 1255     $PIPES{$pid}=$pipe;
 1256     $CNXNS{$pipe}=$pid;
 1257 }
 1258 
 1259 
 1260 sub StartQueue
 1261 {
 1262     my($name,$sigset)=@_;
 1263 
 1264     # Queue-runner variables
 1265     my($rundelay,$pc,$waiting);
 1266     $rundelay=$config->get("pc:${name}\@rundelay");
 1267     #warn "run delay: $rundelay\n";
 1268 
 1269     $PC=$name;
 1270     $pc=Sendpage::PagingCentral->new($config,$PC,\@modems);
 1271 
 1272     # rename myself
 1273     $0="sendpage: $PC queue";
 1274 
 1275     # set up handler
 1276     $SIG{'USR1'} = \&QueueRun;
 1277 
 1278     $log->do('debug', "starting queue runs for '$PC'") if ($DEBUG);
 1279 
 1280     my $dir=$config->get("queuedir")."/$PC";
 1281     if (! -d $dir) {
 1282     if (!mkdir($dir,0700)) {
 1283         $log->do('alert',"Cannot mkdir '$dir': $!");
 1284         exit(1);
 1285     }
 1286     }
 1287 
 1288     $queue=Sendpage::PageQueue->new($config, $dir);
 1289 
 1290     if (!defined($queue)) {
 1291     $log->do('alert',"Failed to open queue for '$PC'  --  exiting");
 1292     exit(1);
 1293     }
 1294 
 1295     # stop blocking signals
 1296     &UnblockSignals($sigset);
 1297 
 1298     while ($SHUTDOWN!=1) {
 1299     # reset our sleep time
 1300     $sleeptime=$rundelay;
 1301 
 1302     # search queue, gathering pages
 1303     $waiting=$queue->ready()+1;
 1304     if ($waiting>0) {
 1305         while (defined($page=$queue->getPage())) {
 1306         if ($page->deliverable()) {
 1307             $pc->deliver($page);
 1308 
 1309             if ($page->has_recips()) {
 1310             $log->do('debug',"$PC: rewriting page to queue") if ($DEBUG);
 1311             # something requires rerun
 1312             $queue->writePage($page);
 1313             $queue->fileDone();
 1314             }
 1315             else {
 1316             $log->do('debug',"$PC: tossing queue file") if ($DEBUG);
 1317             $queue->fileToss();
 1318             }
 1319         }
 1320         else {
 1321             $queue->fileDone();
 1322         }
 1323         }
 1324     }
 1325 
 1326     # don't hang up if need to rescan our queue
 1327     if ($sleeptime != 0) {
 1328         $pc->disconnect();
 1329 
 1330 
 1331         # strange eval needed to wake up on USR1 signals
 1332         eval {
 1333         local $SIG{USR1} = sub { die "usr1\n" };
 1334 
 1335         # pause for the next queue run
 1336         sleep($sleeptime);
 1337         };
 1338         if ($@) {
 1339         QueueRun();
 1340         }
 1341         else {
 1342         # nothing: we're done sleeping
 1343         }
 1344     }
 1345 
 1346     # check and see if we should shutdown (parent is init)
 1347     if (!$SHUTDOWN && getppid==1) {
 1348         $log->do('err',"Parent process died -- aborting");
 1349         $SHUTDOWN=1;
 1350     }
 1351     }
 1352     $log->do('debug', "Queue runner for '$PC' shutting down") if ($DEBUG);
 1353     # remove our pid file
 1354     YankPidFile($PC);
 1355     exit(0);
 1356 }
 1357 
 1358 sub DoNothing
 1359 {
 1360     # no code here, but just have HAVING a signal handler, I'll wake up
 1361     # during a SIGCHLD for my waitpid
 1362 }
 1363 
 1364 sub Reload {
 1365     my($pid);
 1366 
 1367     $log->do('info', "initiating reload ...");
 1368 
 1369     if ($PC eq "") {
 1370     my %OLD=%CHILDREN;
 1371     undef %CHILDREN;
 1372     undef %STARTED;
 1373 
 1374     StopSNPP();
 1375 
 1376     $RELOAD=1;
 1377 
 1378     my $finished=0;
 1379 
 1380     # shutdown the PCs
 1381     foreach $pc (@pcs) {
 1382         if ($config->get("pc:$pc\@enabled")==0) {
 1383         next;
 1384         }
 1385         $log->do('debug', "Stopping '$pc' ...") if ($DEBUG);
 1386         SendSignal('QUIT',$pc);
 1387         $finished++;
 1388     }
 1389     # shut down all the SNPP clients too
 1390     foreach $pc (keys %PIPES) {
 1391         $log->do('debug',"Stopping SNPP client '$pc' ...")
 1392         if ($DEBUG);
 1393         SendSignal('QUIT',$pc);
 1394         $finished++;
 1395     }
 1396 
 1397     # Note:
 1398     # can't do "ModemInit" until everyone is dead because we
 1399     # need to re-init (to validate) all the modems.
 1400 
 1401     my @keys=keys %OLD;
 1402 
 1403     undef $!;
 1404     $log->do('debug', "Waiting for $finished PCs/SNPPs to die off...") if ($DEBUG);
 1405     while ($finished!=0) {
 1406         $pid=wait;
 1407         if ($pid==-1) {
 1408         if ($!==ECHILD) {
 1409             $log->do('warning',"Ran out of children too early?!  Continuing anyway...");
 1410             $finished=0;
 1411         }
 1412         else {
 1413             $log->do('warning',"Oops: waitpid spat totally unexpected error: %s",$!);
 1414         }
 1415         }   
 1416         elsif ($pid==0) {
 1417         $log->do('warning',"Got 0 pid somehow");
 1418         }
 1419         elsif (defined($OLD{$pid})) {
 1420         $log->do('debug', "Letting old PC '$OLD{$pid}' rest in peace") if ($DEBUG);
 1421         $finished--;
 1422         }
 1423         elsif (defined($PIPES{$pid})) {
 1424         PipeShutdownPid($pid);
 1425         $log->do('debug',"SNPP connection (pid $pid) finished") if ($DEBUG || $DEBUG_SNPP);
 1426         $finished--;
 1427         }
 1428         else {
 1429         $log->do('warning',"Strange, I got an unknown child PID: '$pid'");
 1430         }
 1431     }
 1432 
 1433     $log->do('debug', "Reinitializing...") if ($DEBUG);
 1434 
 1435     $RELOAD=0;
 1436 
 1437     # reload our configurations
 1438     Initialize();
 1439     ModemInit();
 1440 
 1441     # Restart logging
 1442     $log->reconfig(Syslog => $config->get("syslog"),
 1443                Opts  => $config->get("syslog-opt"),
 1444                Facility => $config->get("syslog-facility"),
 1445                MinLevel => $config->get("syslog-minlevel"),
 1446               );
 1447     $log->on();
 1448 
 1449     # Start up all our children
 1450     SpawnChildren();
 1451     StartSNPP();
 1452     }
 1453     else {
 1454     $log->do('warning',"Weird: PC '$PC' caught a Reload signal somehow.");
 1455     }
 1456 }
 1457 
 1458 sub verifyModems
 1459 {
 1460     my (@totest) = @_;
 1461 
 1462     # find all our valid modems, keeping those that are either in use (e.g.
 1463     # we have been HUPd) or respond to initialization
 1464     my $m;
 1465     my $result;
 1466     my $modem;
 1467     my @okay;
 1468 
 1469     foreach $modem (@totest) {
 1470     $m=Sendpage::Modem->new(Name => $modem,
 1471                 Dev => $config->get("modem:${modem}\@dev"),
 1472                 Lockprefix => $config->get("lockprefix"),
 1473                 Debug => $config->get("modem:${modem}\@debug"),
 1474                 Log => $log,
 1475                 Baud => $config->get("modem:${modem}\@baud"),
 1476                 Parity => $config->get("modem:${modem}\@parity"),
 1477                 StrictParity => $config->get("modem:${modem}\@strict-parity"),
 1478                 Data => $config->get("modem:${modem}\@data"),
 1479                 Stop => $config->get("modem:${modem}\@stop"),
 1480                 Flow => $config->get("modem:${modem}\@flow"),
 1481                 Init => $config->get("modem:${modem}\@init"),
 1482                 InitOK => $config->get("modem:${modem}\@initok"),
 1483                 InitWait => $config->get("modem:${modem}\@initwait"),
 1484                 InitRetry => $config->get("modem:${modem}\@initretries"),
 1485                 Error => $config->get("modem:${modem}\@error"),
 1486                 Dial => $config->get("modem:${modem}\@dial"),
 1487                 DialOK => $config->get("modem:${modem}\@dialok"),
 1488                 DialWait => $config->get("modem:${modem}\@dialwait"),
 1489                 DialRetry => $config->get("modem:${modem}\@dialretries"),
 1490                 NoCarrier => $config->get("modem:${modem}\@no-carrier"),
 1491                 DTRToggleTime => $config->get("modem:${modem}\@dtrtime"),
 1492                 CarrierDetect => $config->get("modem:${modem}\@carrier-detect",1),
 1493                 AreaCode => $config->get("modem:${modem}\@areacode",1),
 1494                 LongDist => $config->get("modem:${modem}\@longdist"),
 1495                 DialOut =>  $config->get("modem:${modem}\@dialout")
 1496                    );
 1497     if (!defined($m)) {
 1498         $log->do('warning',"Cannot find modem '$modem'");
 1499         next;
 1500     }
 1501     if (!defined($result=$m->init())) {
 1502         $log->do('alert',"Cannot initialize modem '$modem'");
 1503         next;
 1504     }
 1505     undef $m;
 1506     push(@okay,$modem);
 1507     }
 1508 
 1509     return @okay;
 1510 }
 1511 
 1512 sub RecipDig
 1513 {
 1514     my($recip,$seen)=@_;
 1515     my($dests,$one,%hash,$result);
 1516 
 1517     if (!defined($seen)) {
 1518     my %holder;
 1519     $holder{$recip->name()}=1;
 1520     $seen=\%holder;
 1521     }
 1522     else {
 1523     $seen->{$recip->name()}++;
 1524     }
 1525 
 1526     if ($seen->{$recip->name()}>1) {
 1527     $log->do('alert',"Loop found in alias expansion!  Culprit recip: '%s'",
 1528          $recip->name());
 1529     exit(1);
 1530     }
 1531 
 1532     # no alias, just return this one (leaf node)
 1533     return ($recip) if (!$recip->alias());
 1534 
 1535     $log->do('debug',"from: '%s'",$recip->name())
 1536     if ($config->get("alias-debug"));
 1537 
 1538     # get expanded list
 1539     $dests=$recip->dests();
 1540 
 1541     # dump list
 1542     grep($log->do('debug',"starting with: '%s'",$_),@{$dests})
 1543     if ($config->get("alias-debug"));
 1544 
 1545     # expand each one
 1546     foreach $one (@{ $dests }) {
 1547     $log->do('debug',"expanding: '%s'",$one) if ($config->get("alias-debug"));
 1548     my %copy=%{$seen};
 1549     my $r=Sendpage::Recipient->new($config,$db,$one,$recip->data());
 1550     if (!defined($r)) {
 1551         $log->do('err',"undeliverable: '%s'",$one);
 1552     }
 1553     else {
 1554         my @results=RecipDig($r,\%copy);
 1555 
 1556         # add them to our hash
 1557         foreach $result (@results) {
 1558         $log->do('debug',"got: '%s'",$result->name())
 1559             if ($config->get("alias-debug"));
 1560         $hash{$result->name()}=$result;
 1561         }
 1562     }
 1563     }
 1564 
 1565     undef @results;
 1566     foreach $one (keys %hash) {
 1567     $log->do('debug',"passing back: '%s'",$hash{$one}->name())
 1568         if ($config->get("alias-debug"));
 1569     push(@results,$hash{$one});
 1570     }
 1571 
 1572     return @results;
 1573 }
 1574 
 1575 sub ArrayDig
 1576 {
 1577     my(@array)=@_;
 1578     my ($one,$result,%hash,@results,$fail);
 1579 
 1580     # did a look-up fail?
 1581     $fail=0;
 1582     # dump list
 1583     grep($log->do('debug',"starting with: '%s'",$_),@array)
 1584     if ($config->get("alias-debug"));
 1585 
 1586     # expand each one
 1587     foreach $one (@array) {
 1588     $log->do('debug',"expanding: '%s'",$one)
 1589         if ($config->get("alias-debug"));
 1590     my $recip=Sendpage::Recipient->new($config,$db,$one);
 1591     if (!defined($recip)) {
 1592         $log->do('err',"undeliverable: '%s'",$one);
 1593         $fail=1;
 1594     }
 1595     else {
 1596         my @results=RecipDig($recip);
 1597 
 1598         # add them to our hash
 1599         foreach $result (@results) {
 1600         $log->do('debug',"got: '%s'",$result->name())
 1601             if ($config->get("alias-debug"));
 1602         $hash{$result->name()}=$result;
 1603         }
 1604     }
 1605     }
 1606 
 1607     undef @results;
 1608     foreach $one (keys %hash) {
 1609     $log->do('debug',"passing back: '%s'",$hash{$one}->name())
 1610         if ($config->get("alias-debug"));
 1611     push(@results,$hash{$one});
 1612     }
 1613 
 1614     return ($fail,@results);
 1615 }
 1616 
 1617 sub initConfig
 1618 {
 1619     my(%opts) = %{ $_[0] };
 1620 
 1621     # set up default values  (this is ignored by KeesConf...)
 1622     my %cfg=(
 1623          PEDANTIC=> 1,
 1624          CASE   => 1,
 1625          CREATE  => 1,
 1626          GLOBAL  => {
 1627              DEFAULT   => "<unset>",
 1628              ARGCOUNT  => ARGCOUNT_ONE,
 1629             },
 1630         );
 1631     my $config = Sendpage::KeesConf->new(\%cfg);
 1632 
 1633     # global variables
 1634     $config->define("dsn", { DEFAULT => "" });
 1635     $config->define("dbuser", { DEFAULT => "" });
 1636     $config->define("dbpass", { DEFAULT => "" });
 1637     $config->define("dbtable", { DEFAULT => "" });
 1638     $config->define("cfgfile",   { DEFAULT => "/etc/sendpage.cf" });
 1639     $config->define("pidfileprefix",{ DEFAULT => "/var/spool/sendpage/sendpage" });
 1640     $config->define("lockprefix",{ DEFAULT => "/var/lock/LCK.." });
 1641     $config->define("queuedir", { DEFAULT => "/var/spool/sendpage" });
 1642     $config->define("mail-agent", { DEFAULT => "sendmail" });
 1643     $config->define("user", { DEFAULT => "sendpage" });
 1644     $config->define("group-lock", { DEFAULT => "uucp" });
 1645     $config->define("group-tty", { DEFAULT => "dialout" });
 1646     $config->define("page-daemon", { DEFAULT => "sendpage" });
 1647     $config->define("cc-on-error", { ARGCOUNT => 0, DEFAULT => 1 });
 1648     $config->define("modems",   { ARGCOUNT => 2 });
 1649     $config->define("alias-debug",    { ARGCOUNT => 0, DEFAULT => 0 });
 1650     $config->define("debug",    { ARGCOUNT => 0,
 1651                   DEFAULT => $opts{d} ? 1 : 0 });
 1652     $config->define("debug-select",    { ARGCOUNT => 0,
 1653                      DEFAULT => $opts{d} ? 1 : 0 });
 1654     $config->define("debug-snpp",    { ARGCOUNT => 0,
 1655                        DEFAULT => $opts{d} ? 1 : 0 });
 1656     # should the sender be notified of failures?
 1657     $config->define("fail-notify", { ARGCOUNT => 0, DEFAULT => 1 });
 1658     # sender should be notified how on every X temp fails? (0=never)
 1659     $config->define("tempfail-notify-after", { DEFAULT => 5 });
 1660     # how many temp fails does it take to produce a perm failure?
 1661     $config->define("max-tempfail", { DEFAULT => 20 });
 1662     #   max age in seconds of a page in the queue (0 = unlimited)
 1663     $config->define("max-age",      { DEFAULT => 0 });
 1664     # default email CC domain
 1665     $config->define("fallback-email-domain", { DEFAULT => undef });
 1666     # command to run after each successful or failed page
 1667     $config->define("completion-cmd", { UNSET => 1 });
 1668     # syslog toggle: strerr is used if not syslog
 1669     $config->define("syslog", { DEFAULT => 1, ARGCOUNT => 0 });
 1670     # syslog logopt words (any of "pid", "ndelay", "cons", "nowait")
 1671     $config->define("syslog-opt", { DEFAULT => "pid" });
 1672     # syslog facility to log with (one of "auth", "authpriv", "cron", "daemon",
 1673     #   "kern", "local0" through "local7", "lpr", "mail", "news", "syslog",
 1674     #   "user", or "uucp"
 1675     $config->define("syslog-facility", { DEFAULT => "daemon" });
 1676     # syslog reports internally range from debug through crit.  Most people
 1677     # figure out how to configure sendpage to report debug, but don't change
 1678     # their syslog configs.  So, we'll have a "minlevel".  Anything below
 1679     # "minlevel" will be elevated to "minlevel" before being sent to syslog.
 1680     $config->define("syslog-minlevel", { DEFAULT => "info" });
 1681     # SNPP settings
 1682     $config->define("snpp-port", { DEFAULT => "444" });
 1683     $config->define("snpp-addr", { DEFAULT => "localhost" });
 1684     $config->define("snpp-acl", { ARGCOUNT => 2, DEFAULT => [ "127.0.0.1/255.255.255.255:ALLOW" ] });
 1685 
 1686     # aliases defaults
 1687     #$config->define("recip:", { ARGCOUNT => 2 });
 1688     # where to send email-cc's of pages.  none if blank, defaults to 
 1689     #   ALIAS @ fallback-email-domain if unset
 1690     $config->define("recip:email-cc", { UNSET => 1 });
 1691     # page is PIN@PC, alias is just the recip name again
 1692     $config->define("recip:dest", { ARGCOUNT => 2 });
 1693 
 1694     # modem defaults
 1695     $config->define("modem:debug",  { ARGCOUNT => 0, 
 1696                       DEFAULT => $opts{d} ? 1 : 0 });
 1697     $config->define("modem:baud",   { DEFAULT => 9600 });
 1698     $config->define("modem:data",   { DEFAULT => 7 });
 1699     $config->define("modem:parity", { DEFAULT => "even" });
 1700     $config->define("modem:stop",   { DEFAULT => 1 });
 1701     $config->define("modem:flow",   { DEFAULT => "rts" });
 1702     $config->define("modem:strict-parity", { ARGCOUNT => 0, DEFAULT => 0 });
 1703     $config->define("modem:dev",    { DEFAULT => "/dev/null" });
 1704     $config->define("modem:carrier-detect", { DEFAULT => "on" });
 1705     # time to force DTR down during reset (0 = don't do it at all)
 1706     $config->define("modem:dtrtime", { DEFAULT => 0.5 });
 1707     $config->define("modem:init",   { DEFAULT => "ATZ" });
 1708     $config->define("modem:initok", { DEFAULT => "OK" });
 1709     $config->define("modem:initwait",{ DEFAULT => 4 });
 1710     $config->define("modem:initretries",{ DEFAULT => 2 });
 1711     $config->define("modem:dial",   { DEFAULT => "ATDT" });
 1712     $config->define("modem:dialok", { DEFAULT => "CONNECT.*\r" });
 1713     $config->define("modem:dialwait",{ DEFAULT => 60 });
 1714     $config->define("modem:error", { DEFAULT => "ERROR" });
 1715     $config->define("modem:no-carrier",
 1716             {
 1717              DEFAULT => "ERROR|NO CARRIER|BUSY|NO DIAL|VOICE" });
 1718     $config->define("modem:areacode", { UNSET => 1 });
 1719     $config->define("modem:longdist", { DEFAULT => 1 });
 1720     $config->define("modem:dialout", { DEFAULT => "" });
 1721 
 1722     # FIXME:
 1723     # currently not implemented -- perhaps never, better to stall and try again
 1724     $config->define("modem:dialretries",{ DEFAULT => 3 });
 1725 
 1726     # paging central defaults
 1727     #     Paging centrals can override baud, data, parity, stop, flow, dialwait,
 1728     #       dialretries
 1729     #  modem connect info
 1730     $config->define("pc:enabled",{ ARGCOUNT => 0, DEFAULT => 1 });
 1731     $config->define("pc:debug",  { ARGCOUNT => 0, 
 1732                    DEFAULT => $opts{d} ? 1 : 0 });
 1733     $config->define("pc:page-daemon", { UNSET => 1 });
 1734     $config->define("pc:cc-on-error",  { ARGCOUNT => 0, UNSET => 1 });
 1735     $config->define("pc:cc-simple",  { ARGCOUNT => 0, DEFAULT => 0 });
 1736     $config->define("pc:fail-notify", { ARGCOUNT => 0, UNSET => 1 });
 1737     $config->define("pc:tempfail-notify-after", { UNSET => 1 });
 1738     $config->define("pc:max-tempfail", { UNSET => 1 });
 1739     $config->define("pc:max-age",       { UNSET => 1 });
 1740     # command to run after each successful or failed page
 1741     $config->define("pc:completion-cmd", { UNSET => 1 });
 1742     $config->define("pc:modems", { ARGCOUNT => 2 });
 1743     $config->define("pc:baud",   { DEFAULT => 9600 });
 1744     $config->define("pc:data",   { DEFAULT => 7 });
 1745     $config->define("pc:parity", { DEFAULT => "even" });
 1746     $config->define("pc:stop",   { DEFAULT => 1 });
 1747     $config->define("pc:flow",   { DEFAULT => "rts" });
 1748     $config->define("pc:strict-parity", { ARGCOUNT => 0, DEFAULT => 0 });
 1749     $config->define("pc:phonenum",{DEFAULT => "" });
 1750     $config->define("pc:areacode",{ UNSET => 1 });
 1751     # how many chars per page before auto-splitting?
 1752     $config->define("pc:maxchars",{DEFAULT => 1024 });
 1753     # how many page splits allowed per page?
 1754     $config->define("pc:maxsplits",{DEFAULT => 6 });
 1755     # PC uses it's own dialwait for delaying
 1756     $config->define("pc:dialwait",{ UNSET => 1 });
 1757     $config->define("pc:rundelay",{DEFAULT => 30 });
 1758     $config->define("pc:dialretries",{ DEFAULT => 3 });
 1759     # allow for selecting delivery protocol (TAP (PG1, PG3), UCP, SMS, SNPP)
 1760     $config->define("pc:proto",{DEFAULT => "PG1" });
 1761     # allow for forced multiple fields in BlockTrans
 1762     $config->define("pc:fields",{DEFAULT => 2 });
 1763     $config->define("pc:password",{DEFAULT => "000000" });
 1764     #  proto establishment info
 1765     $config->define("pc:answerwait", { DEFAULT => 2 });
 1766     $config->define("pc:answerretries", { DEFAULT => 3 });
 1767     #  protocol settings
 1768     #   MUST have the leading "<CR>" for each answer?
 1769     $config->define("pc:stricttap",     { DEFAULT => 0, ARGCOUNT => 0 });
 1770     #   chars less than 0x20 are allowed in a field
 1771     $config->define("pc:ctrl",      { DEFAULT => 0, ARGCOUNT => 0 });
 1772     #   chars CAN be escaped (if false, "LF" is allowed, it seems?)
 1773     $config->define("pc:esc",       { DEFAULT => 0, ARGCOUNT => 0 });
 1774     #   is LF allowed (some PCs allow it, but no other ctrl chars)
 1775     $config->define("pc:lfok",      { DEFAULT => 0, ARGCOUNT => 0 });
 1776     #   fields cannot be split across blocks? (FIXME: unimplemented)
 1777     $config->define("pc:fieldsplits",   { DEFAULT => 1, ARGCOUNT => 0 });
 1778     #  paging central limits
 1779     #   max blocks per connection (0 = unlimited)
 1780     $config->define("pc:maxblocks",     { DEFAULT => 0 });
 1781     #   max pages per connection (0 = unlimited)
 1782     $config->define("pc:maxpages",      { DEFAULT => 0 });
 1783     #   max chars per block: 250 is protocol standard: 256 - 3 ctrl - 3 chksum
 1784     $config->define("pc:chars-per-block",   { DEFAULT => 250 });
 1785 
 1786     return $config;
 1787 }
 1788 
 1789 sub loadConfig {
 1790     my($cfgfile);
 1791 
 1792     $cfgfile=$config->get("cfgfile");
 1793     $cfgfile=$opts{C} if (defined($opts{C}));
 1794 
 1795     # toss our config
 1796     $config->dump();
 1797 
 1798 
 1799     # yes, this seems silly, but we allow cmdline options to change
 1800     # various defaults, including this one
 1801     $config->file($cfgfile);
 1802 
 1803     if ($config->get("dsn")) {
 1804     my ($dsn, $dbuser, $dbpass, $dbtable);
 1805     $dsn = $config->get("dsn");
 1806     $dbuser = $config->get("dbuser");
 1807     $dbpass = $config->get("dbpass");
 1808     $dbtable = $config->get("dbtable");
 1809     if ($db) {
 1810         $db->setdb($dsn,$dbuser,$dbpass,$dbtable);
 1811     } else {
 1812         $db = Sendpage::Db->new($dsn,$dbuser,$dbpass,$dbtable);
 1813     }
 1814     }
 1815 }
 1816 
 1817 
 1818 #
 1819 # file locking example from the Perl Cookbook
 1820 #
 1821 # use Fcntl qw(:DEFAULT :flock);
 1822 # 
 1823 # sysopen(FH, "numfile", O_RDWR|O_CREAT)
 1824 #                                     or die "can't open numfile: $!";
 1825 # flock(FH, LOCK_EX)                  or die "can't write-lock numfile: $!";
 1826 # # Now we have acquired the lock, it's safe for I/O
 1827 # $num = <FH> || 0;                   # DO NOT USE "or" THERE!!
 1828 # seek(FH, 0, 0)                      or die "can't rewind numfile : $!";
 1829 # truncate(FH, 0)                     or die "can't truncate numfile: $!";
 1830 # print FH $num+1, "\n"               or die "can't write numfile: $!";
 1831 # close(FH)                           or die "can't close numfile: $!";
 1832 #
 1833 #