#!/usr/bin/perl -w
#
# FAXRUNQ-Daemon
#
# scan fax-queue in regular intervals, send all faxes that are "new" and
# ready to-be-sent, pause between retries, etc.
#
# main difference to "faxrunq": runs all the time, handles multiple modems
#
# initial version: Feb 17, 1997
#
$rcs_id='RCS: $Id: faxrunqd.in,v 1.37 1999/01/04 08:48:13 gert Exp $';
#
# Change Log:
# $Log: faxrunqd.in,v $
# Revision 1.37  1999/01/04 08:48:13  gert
# make error message more clear
#
# Revision 1.36  1998/11/12 15:22:39  gert
# change max_tries_total default to 10 (same as faxrunq)
#
# Revision 1.35  1998/07/20 22:02:40  gert
# put extra brackets around exec() to silence "not reached" warnings
#
# Revision 1.34  1998/06/22 10:27:22  gert
# in case of startup with a stale 'faxrunqd.pid' file, assume unclean
# shutdown / kill -9 and remove all F.../JOB.locked files.
#
# Revision 1.33  1998/05/28 14:37:26  gert
# write "Status" line for successful send attempts as well
#
# Revision 1.32  1998/05/25 11:46:02  gert
# add job number (F000123) to acct.log entries
#
# Revision 1.31  1998/05/07 08:59:23  gert
# make number of logfiles to keep configurable
#
# Revision 1.30  1998/04/23 14:25:13  gert
# add 'modem badness' counter ($mq_badness{$tty}) to avoid using a modem
# that is broken (locked forever / cannot be initialized / NO DIALTONE)
#
# Revision 1.29  1998/04/23 13:52:07  gert
# rotate @standard_ttys after each job, to distribute jobs more evenly
#
# Revision 1.28  1998/04/21 13:53:30  gert
# make log file more readable (insert '+')
#
# Revision 1.27  1998/02/27 15:15:31  gert
# added handling of 'time' flag (start time/start+end time range)
#
# Revision 1.22  1998/02/11 09:00:16  gert
# Finish per-modem queues
# implement priority on per-modem queues
# tweak implementation details regarding delayed faxes / pausing
#
# Revision 1.18  1998/01/20 12:07:33  gert
# change format for faxrunqd.policy (separate field for "ttys")
# ...
# Revision 1.1  1997/10/02 09:58:56  gd
# Initial revision
#
#
require 5.004;
require 'getopts.pl';
use POSIX;
use IO::Handle;

#
# CONFIGURATION: filenames
#

$fax_spool_out='/var/spool/fax/outgoing';

$sendfax='/usr/local/sbin/sendfax';
$mail='/usr/sbin/sendmail';

$faxrunq_cf='/etc/mgetty+sendfax/faxrunq.config';
$fax_acct='/var/spool/fax/acct.log';
$faxrd_log='/var/spool/fax/faxrunqd.log';

$faxrd_pid='/var/spool/fax/faxrunqd.pid';

$policy_config='';

#
# CONFIGURATION: default settings, overwritten from $faxrunq_cf
#
$send_mail_success=1;
$send_mail_failure=1;
$program_success='';
$program_failure='';
$max_tries_costly=3;
$max_tries_total=10;
$delete_jobs=0;

#
# verbose strings for error messages
#
@exitcodes=( "all pages transmitted successfully",	# 0
	     "error on command line",			#  1
	     "cannot open Fax device",			#  2
	     "error initializing the modem",		#  3
	     "dial failed: BUSY",			#  4
	     "dial failed: NO DIALTONE",		#  5
	     "", "", "", "",				# -- not used
	     "dial failed: ERROR or NO CARRIER",	# 10
	     "waiting for XON failed",			# 11
	     "transmitting or polling page(s) failed",	# 12
	     "", "",					# 13, 14
             "something *VERY BAD* has happend");	# 15


#
# command line options
#
$opt_d = 0;					# debug
$opt_v = 0;					# verbose
$opt_l = '';					# ttys to use
&Getopts( 'dvl:' ) || 
    die "Valid options: -d (debug), -v (verbose), -l tty<n>\n";

if ( $opt_d ) { $opt_v=1; }

#
# startup... write PID file, make sure no other faxrunqd runs
#
if ( -f $faxrd_pid && open( FP, $faxrd_pid ) )
{
    $p = <FP>; chomp $p; close FP;

    if ( $p ne '' )		# does process exist?
    {
	if ( kill( 0 => $p ) ||	
		$! == EPERM )
	{
	    die "faxrunqd: already running (PID=$p)\n";
	}
	else			# no process found
	{
	    &remove_stale_locks;
	}
    }
}
open( FP, ">$faxrd_pid" ) ||
	die "faxrunqd: can't write PID to '$faxrd_pid': $!\n";
print FP "$$\n";
close FP;

#
# set up handlers to handle "INT" (ctrl-c), "HUP" (hangup), "TERM" (kill)...
#    (handler function does cleanup, remove lock/pid files, etc., and exits)
#
$SIG{INT}  = \&signal_handler;
$SIG{HUP}  = \&signal_handler;
$SIG{TERM} = \&signal_handler;

$SIG{USR1} = \&signal_handler_USR1;		# roll log file
$roll_log_file_requested = 0;
$roll_level=3;					# keep 3 old files around

$SIG{USR2} = \&signal_handler_USR2;		# graceful exit
$graceful_exit_requested = 0;

#
# read config file
#
if ( open( CF, $faxrunq_cf ) )
{
    while( <CF> )
    {
	print if $opt_d;

	next if /^\s*#/;		# comment lines
	chomp;
	next if /^\s*$/;		# empty lines

	if    ( /^\s*success-send-mail\s+([yYnN])/ )
		{ $send_mail_success = ( $1 eq 'y' || $1 eq 'Y' ); }
	elsif ( /^\s*failure-send-mail\s+([yYnN])/ )
		{ $send_mail_failure = ( $1 eq 'y' || $1 eq 'Y' ); }
	elsif ( /^\s*delete-sent-jobs\s+([yYnN])/ )
		{ $delete_jobs = ( $1 eq 'y' || $1 eq 'Y' ); }
	elsif ( /^\s*success-call-program\s+(\S.*)/ )
		{ $program_success = "$1"; }
	elsif ( /^\s*failure-call-program\s+(\S.*)/ )
		{ $program_failure = "$1"; }
	elsif ( /^\s*maxfail-costly\s+(\d+)/ )
		{ $max_tries_costly = $1; }
	elsif ( /^\s*maxfail-total\s+(\d+)/ )
		{ $max_tries_total = $1; }
	elsif ( /^\s*max-modems\s+(\d+)/ )
		{ print STDERR "WARNING: faxrunq.config parameter 'max-modems' is obsolete, use '-l'\n";}
	elsif ( /^\s*fax-devices\s+(\S+)/ )
		{ $opt_l = "$1"  if $opt_l eq ''; }
	elsif ( /^\s*faxrunqd-log\s+(\S+)/ )
		{ $faxrd_log = "$1"; }
	elsif ( /^\s*faxrunqd-keep-logs\s+(\d+)/ )
		{ $roll_level = $1; }
	elsif ( /^\s*acct-log\s+(\S+)/ )
		{ $fax_acct = "$1"; }
	elsif ( /^\s*policy-config\s+(\S+)/ )
		{ $policy_config = "$1"; }
	else
		{ die "syntax error in $faxrunq_cf, line $.!\n"; }
    }
}

if ( $opt_l eq '' )
	{ die "$0: no tty lines specified\n\t- must use '-l tty<n>' or 'fax-devices tty<n>' in 'faxrunq.config'\n"; }

#
# policy configuration
#

@policy=();
if ( $policy_config ne '' && -f $policy_config )
{
    print "reading $policy_config...\n" if $opt_d;
    if ( open( P, $policy_config ) )
    {
	while( <P> )
	{
	    next if /^\s*#/;			# comment
	    next if /^\s*$/;			# empty lines
	    print "  pcfg: $_" if $opt_d;
	    chomp;
	    my ( $m, $s, $t, @a ) = split( /\s+/, $_ );

	    push @policy, { 'match' => $m, 'substitute' => $s, 
			    'ttys' => ( $t ne '-' )? [ split( /:/, $t) ] : [],
			    'args' => [@a]};
	}
	close(P);
    }
}

#
# queue directory...?
#

chdir( $fax_spool_out ) ||
	    die "can't change directory to '$fax_spool_out'";

opendir FSO, "." ||
	    die "can't read directory '$fax_spool_out'";

#
# open log file
#
open( LOG, ">>$faxrd_log" ) ||
	    die "can't write log file '$faxrd_log'";
LOG->autoflush(1);
print LOG "\n" . localtime() .": faxrunqd starting, pid=$$\n$rcs_id\n";

#
# internal queue
#
%queue = ();

$queue_last_read = time();		# check queue directory ...
$queue_read_interval = 300;		# ... every 5 minutes
$queue_last_flushed = time();		# flush internal queue ...
$queue_flush_interval = 3600;		# ... once per hour

#
# child processes
#
$childs = 0; %pid2job = (); %phones = (); %pid2tty = ();

#
# ttys available (-l tty1:tty2:... option or default)
#
@standard_ttys = split( /:/, $opt_l );

#
# statistics about tty usage / success / error rates
#
%tty_statistics = (); %per_phone_statistics = ();

# ###
# ### MAIN LOOP -- rescan spool directory in certain intervals, send stuff
# ###

while( 1 )
{
    print LOG localtime() . ": scanning queue directory...\n" if $opt_v;
    $queue_last_read = time();

    rewinddir( FSO );

    foreach $f ( readdir( FSO ) )
    {
	next unless $f =~ /^F[0-9]/;

	print LOG "got: $f\n" if $opt_d; 

	if ( ! defined( $queue{$f} ) )
	{
	    next unless -d $f;
	    print LOG "--> new job!\7\n" if $opt_d;

	    $queue{$f} = { 'status' => 'unknown', 'flags' => ['-r'],
			   'tries_c' => 0, 'tries' => 0, 'priority' => 5,
			   'ctime' => time()};

	    if ( $opt_v > 1 )
		{ push @{$queue{$f}->{'flags'}}, '-v'; }

	    &read_job_to_queue( $f );
	}
    }

    # start all modem queues (that have requests and are not busy)
    print LOG localtime() . ": starting modem queues...\n" if $opt_v;

    foreach $tty ( keys %modem_queue )
    {
	print LOG "\tQ: $tty: " . scalar( @{$modem_queue{$tty}} ) . " jobs, queue length ${mq_length{$tty}} (+${mq_badness{$tty}}), in_use: ${tty_in_use{$tty}}\n"  if $opt_d;

	# use "while", not "if", in case one of the jobs was faxrm'd...
	while( ! $tty_in_use{$tty} &&
	        scalar( @{$modem_queue{$tty}}) > 0 )
	{
	    &send_job_from_queue( $tty );
	}
    }

    # all queues started.  Now, we just sit there, waiting for an "event"
    # to happen. This could be:
    #   - a job finishes -> start next one from that queue
    #   - a queue runs empty -> leave loop, maybe a new job is in spool
    #   - 10 minutes have passed -> leave loop, check for new jobs

    while(1)
    {
	if ( $childs == 0 ) { last; }

        $tty = &wait_for_child;

	next if ( $tty eq '' );

	# start next job (if there is one) on $tty

	while( ! $tty_in_use{$tty} &&
	        scalar( @{$modem_queue{$tty}}) > 0 )
	{
	    &send_job_from_queue( $tty );
	}

	# leave loop if a queue is empty
	if ( $mq_length{$tty} <= 0 )
	{
	    print LOG "* queue $tty empty, rescan on-disk-queue\n" if $opt_v; 
	    last;
	}

	# make sure that queue is read often enough - otherwise, a high
	# priority job may be delayed because 100 low pri jobs are being
	# processed and faxrunqd did not re-scan the directory...
	if ( time()-$queue_last_read > $queue_read_interval )
	{
	    print LOG "* Interrupting queue run to check for new jobs.\n" if $opt_v;
	    last;
	}

	# leave loop if user signalled for 'graceful exit'
	if ( $graceful_exit_requested ) { last; }

	# leave loop if something has changed in the on-disk queue
	if ( -f '.queue-changed' ) { last; }
    }

    # now decide whether we want to exit, wait, or just start over
    # with reading the on-disk-queue for new jobs...
    print LOG localtime() . ": queue run finished, childs=$childs\n" if $opt_v;

    # use the time to update the "last run" file...
    if ( open( LR, ">$fax_spool_out/.last_run" ) )
    {
	print LR scalar(localtime) . "\n";
	close LR;
    }

    # once per hour, completely flush internal queue, make sure nothing
    # is left over in there, that removed jobs are thrown out, rejuvenated
    # jobs requeued, etc.
    # This is also done if the on-disk queue has changed (faxq -r, etc.)
    if ( ( time() - $queue_last_flushed ) > $queue_flush_interval 
	 || ( -f '.queue-changed' ) )
    {
	print LOG "*** flush internal job queue ***\n" if $opt_v;

	# remove all jobs that are not in modem queues ('active') or delayed
	# (so that all failed->rejuvenated, error, ..., jobs get done now)
	foreach $jj ( sort( keys( %queue )))
	{
	    if ( $queue{$jj}{status} ne 'active' &&
		 $queue{$jj}{status} ne 'delayed' )
	    {
		print LOG "$jj: status='${queue{$jj}{status}}', flush\n" if $opt_d;
		delete $queue{$jj};
	    }
	}

        $queue_last_flushed = time();
	unlink( '.queue-changed' );

	# reduce "modem badness" counters, in case modem was resetted
	foreach $t ( keys( %mq_badness ))
	{
	    $mq_badness{$t} /= 2;
	    if ( $mq_badness{$t} < 1 ) { $mq_badness{$t} = 0; }
	}
    }

    # if signalled from the user (signal USR1), roll the log file, 
    # flush all queues, etc.
    if ( $roll_log_file_requested )
    {
	&dump_statistics;
	print LOG localtime(). ": -- log file ends here --\n";
	close LOG;

	# roll
	my $i=$roll_level;
	while ( $i>=1 ) 
	    { my $j=$i-1; rename "$faxrd_log.$j", "$faxrd_log.$i"; $i--; }
	rename "$faxrd_log", "$faxrd_log.0";
	$roll_log_file_requested=0;

	# start new
	open( LOG, ">$faxrd_log" ) ||
		    die "can't re-open log file '$faxrd_log'";
	LOG->autoflush(1);
	print LOG localtime() .": -- new log file started --\n";
    }

    # if signalled from the user, wait for all current child processes
    # to terminate, then exit
    if ( $graceful_exit_requested )
    {
	print LOG "Graceful Exit: wait for $childs child processes\n";
	while ( $childs > 0 )
	    { $tty=&wait_for_child; print LOG "* tty '$tty' done\n" if $opt_v; }
	&signal_handler(USR2);
    }

    # now, make sure all delayed jobs are rescheduled
    print LOG localtime() . ": checking internal queue for delayed jobs...\n" if $opt_v;
    $sleep_time=60;

    foreach $job ( keys %queue )
    {
	if ( $queue{$job}->{'status'} eq 'delayed' )
	{
	    my $s = $queue{$job}->{'delayed_until'} - time();
	    if ( $s> 0 )
		{ print LOG "$job: delayed, $s seconds to wait\n" if $opt_d; }
	    else
		{ print LOG "$job: was delayed, is active again\n" if $opt_d;
		  $queue{$job}->{'status'} = 'active'; 
		  &put_job_to_modem_queue($job); }
	    if ( $s < $sleep_time ) 
		{ $sleep_time = $s; }
	}
    }

    # there's really, really nothing left to do - so fall asleep!
    if ( $childs == 0 && $sleep_time > 0 )
    {
	# not even child processes to wait for... sleep.
	print LOG "Pausing $sleep_time seconds...\n" if $opt_v;
	sleep $sleep_time;
    }
}

close FSO;

##########################################################################
#
# put_job_to_modem_queue $job
#
# find a "suitable" modem queue for $job
#   - this modem must be allowed for that job
#   - if multiple queues allowed, take the shortest one
#
# called whenever a job's $queue{$job}->{status} changes to 'active'
#
##########################################################################
sub put_job_to_modem_queue
{
    my $j = shift;

    my @ttys = defined( $queue{$j}->{ttys} )? 
		               @{$queue{$j}->{ttys}} : @standard_ttys;

    # find tty with the shortest queue (among those that are allowed)
    my $min_l = 9999;
    my $min_t = $ttys[0];

    foreach $t (@ttys)
    {
	if ( ! defined( $modem_queue{$t} ) )		# does queue exit?
	{						# no: create
	    $modem_queue{$t}=[];
	    $mq_length{$t}=0;
	    $mq_badness{$t}=0;
	    $tty_in_use{$t}=0;
	}

	if ( $mq_length{$t}+$mq_badness{$t} < $min_l )
	{
	    $min_l = $mq_length{$t}+$mq_badness{$t}; $min_t = $t;
	}
    }

    # add job to the end of the queue, then "bubble" it up if it
    # has a higher priority than the preceding job.
    push @{$modem_queue{$min_t}}, $j;

    my $pri = $queue{$j}->{'priority'};		# priority of new job
    my $n = $#{$modem_queue{$min_t}}-1;		# previous job

    while( $n>=0 && $pri > $queue{ $modem_queue{$min_t}[$n] }->{'priority'} )
    {
	print LOG "  * pri $pri, $min_t -> bubble up to pos. $n\n"  if $opt_d;

	$modem_queue{$min_t}[$n+1] = $modem_queue{$min_t}[$n]; 
        $modem_queue{$min_t}[$n] = $j; $n--; 
    }

    # each job adds one (for dialup) plus the number of pages to the
    # total queue length.  This should give a fairly balanced load,
    # even if you have a mixture of very long and very short faxes
    $queue{$j}->{weight} = 1 + scalar( @{$queue{$j}->{pages}} );
    $mq_length{$min_t} += $queue{$j}->{weight};

    print LOG "$j: possible ttys: " . join( ':', @ttys ) . " -> queue selected: $min_t (l: $min_l->" . $mq_length{$min_t} . ")\n"  if $opt_d;

    # rotate @standard_ttys, to distribute load more evenly among modems
    push @standard_ttys, (shift @standard_ttys);
}

##########################################################################

#
# get_d_time $DIR
#
# read mtime of $1 [directory!] 
# (to see whether a JOB was modified recently)
#
##########################################################################
sub get_d_time
{
    my $dir = shift;

    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	$atime,$mtime,$ctime,$blksize,$blocks);

    if ( ( $dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks) = stat($dir) )
    {
	return $mtime;
    }

    return 0;
}


##########################################################################
#
# read_job_to_queue $DIR
#
# read $1/JOB, update $queue{$job}->xxx
#
##########################################################################

sub read_job_to_queue
{
    my $job = shift;

    print LOG "$job: reading $job/JOB...\n" if $opt_d;

    if ( -f "$job/JOB" )
    {
	unless ( open J, "$job/JOB" )
	{
	    $queue{$job}->{'status'} = 'error'; return;
	}

	$queue{$job}->{'tries'} = $queue{$job}->{'tries_c'} = 0;

	while( <J> )
	{
	    chomp;

	    if    ( /^\s*phone (.*)/ )
		{ $queue{$job}->{'phone'} = $1; }
	    elsif ( /^\s*user (.*)/ )
		{ $queue{$job}->{'user'}  = $1; }
	    elsif ( /^\s*mail (.*)/ )
		{ $queue{$job}->{'mail'}  = $1; }
	    elsif ( /^\s*pages\s+(\S.*)/ )
		{ $queue{$job}->{'pages'} = [ split( /\s/, $1 ) ]; }
	    elsif ( /^\s*Status/ )
		{ $queue{$job}->{'tries'}++; 
		  if ( /.*FATAL/ ) { $queue{$job}->{'tries_c'}++; }
		}
	    elsif ( /^\s*verbose_to (.*)/ )
		{ $queue{$job}->{'verbose_to'} = $1; }
	    elsif ( /^\s*time (\d\d\d\d)$/ )
		{ $queue{$job}->{'time_1'} = $1; }
	    elsif ( /^\s*time (\d\d\d\d)-(\d\d\d\d)$/ )
		{ $queue{$job}->{'time_1'} = $1; $queue{$job}->{'time_2'}=$2; }
	    elsif ( /^\s*priority (\d*)/ )
		{ $queue{$job}->{'priority'} = $1; }

	    elsif ( /^\s*poll/ )
		{ push @{$queue{$job}->{'flags'}}, '-p'; }
	    elsif ( /^\s*normal_res/ )
		{ push @{$queue{$job}->{'flags'}}, '-n'; }
	    elsif ( /^\s*acct_handle (.*)/)
		{ push @{$queue{$job}->{'flags'}}, '-A', $1;
		  $queue{$job}->{'acct_handle'} = $1; }
	    elsif ( /^\s*input / )
		{ ;; }
	    else
		{ print LOG "$job: yet unparsed line: '$_'\n"; }
	}

	close J;

	if ( !defined( $queue{$job}->{'phone'} ))
	{
	    print LOG "$job: phone number missing!\n";
	    &remove_error_job($job);
	    return;
	}
	if ( !defined( $queue{$job}->{'user'} ))
	{
	    print LOG "$job: no user name given!\n";
	    &remove_error_job($job);
	    return;
	}
	if ( !defined( $queue{$job}->{'pages'} ))
	{
	    print LOG "$job: no pages to send!\n";
	    &remove_error_job($job);
	    return;
	}
	if ( !defined( $queue{$job}->{'mail'} ))
	{
	    $queue{$job}->{'mail'}=$queue{$job}->{'user'};
	}

	# !!!!!!!! sanity checks (phone, pages, ... must be present)

	# remember the time the job (directory) was "created", for sorting
	unless( $queue{$job}->{'ctime'} = (stat($job))[10] )
			{ $queue{$job}->{'ctime'} = time(); }

	print LOG "$job: CREATED: " . localtime($queue{$job}->{'ctime'}) . "\n" if $opt_d; 

	# now apply "policy routing" rules (we need to know which ttys to use)
	my $phone = $queue{$job}{'phone'};
	foreach $po (@policy)
	{
	    if ( $phone =~ /$po->{match}/ )
	    {
		unless( $po->{substitute} eq '-' )
		    { eval '$phone =~ ' . $po->{substitute} . ';'; }
		push @{$queue{$job}{'flags'}}, @{$po->{args}};
		print LOG "    policy: -> phone: $phone, args: ". join(' ',@{$queue{$job}{'flags'}}) ."\n"  if $opt_v;
		$queue{$job}{'phone'} = $phone;

		if( scalar( @{$po->{ttys}} ) > 0 ) 
		    { $queue{$job}{'ttys'} = \@{$po->{ttys}}; 
		      print LOG "    policy: ttys set: " . join(':', @{$queue{$job}{'ttys'}}) ."\n"  if $opt_v;
		    }
		last;
	    }
	}

	# all done, mark job as 'ready to be sent'
	$queue{$job}->{'status'} = 'active'; 

	# if timing constraints permit, put into modem queue
	if ( &check_timing_constraints($job) )
	{
	    &put_job_to_modem_queue($job);
	}
	return;
    }

    if ( -f "$job/JOB.done" )
    {
	$queue{$job}->{'status'} = 'done'; return;
    }

    if ( -f "$job/JOB.error" )
    {
	$queue{$job}->{'status'} = 'error'; return;
    }

    if ( -f "$job/JOB.suspended" )
    {
	$queue{$job}->{'status'} = 'failed'; return;
    }

    # no JOB.* file found. 
    #
    # possibly, this job is just being created - so if the modification
    # time of the directory is very recent, just "forget" about this job
    # and look at it again in a minute
    #
    if ( (time() - &get_d_time($job)) < 240 ) 
    {
	print LOG "$job: no JOB file, but young directory, try again later\n";
	delete $queue{$job};
	return;
    }

    # it was no recent job - remove directory if older than one day
    if ( (time() - &get_d_time($job)) > 24*3600 )
    {
	print LOG "$job: no JOB file, old directory, remove it\n";
	if ( rmdir( $job ) )
		{ delete $queue{$job}; return; }

	print LOG "$job: can't rmdir(): $!\n";
    }

    # somewhere in between, or removal failed... just flag es "empty"
    $queue{$job}->{'status'} = 'empty'; return;
}

##########################################################################
#
# check_timing_constraints $JOB
#
# get $job from $modem_queue{$1}, lock $job/JOB, fork child process,
# set $tty_in_use{$tty}, etc.
#
##########################################################################
sub check_timing_constraints
{
    my $j=shift;

    # no constraints at all
    if ( !defined( $queue{$j}{'time_1'} ) )  { return 1; }

    my ($h,$m) = (localtime)[2,1];
    my $now = sprintf "%02d%02d", $h, $m;

    my $start_t = $queue{$j}{'time_1'};

    if ( !defined( $queue{$j}{'time_2'} ) )	# only start time given
    {
	if ( $now > $start_t ) { return 1; }
	print LOG "    -T- now=$now, time=$start_t";
    }
    else					# start + end time given
    {
	my $end_t = $queue{$j}{'time_2'};

	if ( $start_t < $end_t )			# e.g. "02:00 - 03:00"
	{
	    if ( $now >= $start_t && $now <= $end_t ) { return 1; }
	}
	else					# e.g. "23:00 - 02:00"
	{
	    if ( $now >= $start_t || $now <= $end_t ) { return 1; }
	}
	print LOG "    -T- now=$now, time=$start_t-$end_t";
    }

    # constraints missed, calculate delay
    my ($start_h,$start_m) = ($start_t =~ /(..)(..)/);
    $delay = ( $start_h - $h ) * 60 + ( $start_m - $m );

    if ( $delay < 0 ) { $delay += 24*60; }

    print LOG "-> delay $delay min.\n";

    $queue{$j}->{status}='delayed';
    $queue{$j}->{'delayed_until'}=time() + $delay*60;

    return 0;
}

##########################################################################
#
# send_job_from_queue $tty
#
# get $job from $modem_queue{$1}, lock $job/JOB, fork child process,
# set $tty_in_use{$tty}, etc.
#
##########################################################################
sub send_job_from_queue
{
    my $tty = shift;
    my $job = shift @{$modem_queue{$tty}};

    print LOG "$job: Sending $job/JOB on $tty...\n" if $opt_v;

    # check whether job has been removed (faxrm) in the meantime...
    unless( -d "$job" && -f "$job/JOB" )
    {
	print LOG "WARNING: job has disappeared from disk queue!\n";
	$queue{$job}->{'status'}='error';
        $mq_length{$tty} -= $queue{$job}->{weight};
	return;
    }

    my $phone = $queue{$job}{phone};

    # check whether phone number is free... if not, delay job
    ### !!!!!!!!!!! SERIOUSLY UGLY !!!!!! FIXME
    if ( defined( $phones{$phone} ) )
    {
	print LOG "$job: phone number '$phone' already busy with job ${phones{$phone}}, delaying\n" if $opt_v;
	$queue{$job}->{status}='delayed';
	$queue{$job}->{'delayed_until'}=time() + 30 + 
			30 * scalar(@{$queue{ $phones{$phone} }{pages}});
        $mq_length{$tty} -= $queue{$job}->{weight};
	return;
    }

    my $pri   = $queue{$job}{priority};
    my @flags = @{$queue{$job}{flags}};

    print LOG " +  phone number: $phone\n" if $opt_d;
    print LOG " +  priority    : $pri\n"   if $opt_d;
    print LOG " +  flags       : " . join( ' ', @flags ) . "\n"  if $opt_d;
    print LOG " +  pages       : " . join( ' ', @{$queue{$job}->{'pages'}} ) . "\n" if $opt_d;

    # lock job (just a hard link) vs. faxrunq
    unless( link "$job/JOB", "$job/JOB.locked" )
    {
	print LOG "WARNING: can't lock job ($!), skipping!\n";
        $mq_length{$tty} -= $queue{$job}->{weight};
	return;
    }

    # now fork child process
    if ( !defined( $pid = fork ) )
    {
	die "CANNOT FORK -- SEVERE ERROR -- ABORTING: $!\n";
    }

    if ( $pid == 0 )		# CHILD
    {
	chdir $job;

        { exec $sendfax ('sendfax', '-l', $tty, # '-x', '5',
	       @flags, $phone, 
	       @{$queue{$job}->{'pages'}});  }
	print LOG "EXEC FAILED: $!\n"; 
	exit(100);
    }
    else			# PARENT
    {
	$childs++;
	$pid2job{$pid}=$job;
	$pid2tty{$pid}=$tty;
	$phones{$phone}=$job;
	$tty_in_use{$tty}=1;
	printf LOG "$job: forked off child **$pid**...\n" if $opt_v;
    }
}


##########################################################################
#
# remove_error_job $DIR
#
# remove an erroneous job from the queue ('mv JOB JOB.error')
#
##########################################################################
sub remove_error_job
{
    my $job = shift;

    print LOG "$job: removing job from queue\n" if $opt_v;

    rename( "$job/JOB", "$job/JOB.error" ) ||
	print LOG "ERROR: can't rename '$job/JOB' to '$job/JOB.error': $!\n";

    $queue{$job}->{'status'} = 'error';
}


##########################################################################
#
# wait_for_child
#
# wait() for child process, handle return code / JOB Status etc.
#
##########################################################################

sub wait_for_child
{
my ($r, $s, $ex, $j, $t);

    print LOG "Waiting for offspring ($childs out there)...\n" if $opt_d;

    $r = wait; $s=$?; $ex=$s>>8;

    if ( $r == -1 )
    {
	die "ERROR-CANTHAPPEN (wait returns -1)";
    }

    # there is a weirdness in Perl on AIX -- sometimes, wait() returns
    # a PID that we did not start (bastard child?). It seems to be
    # harmless to just ignore that fact and go on, but complain anyway.
    if ( ! defined( $pid2job{$r} ) )
    {
	print LOG "ERROR-CANTHAPPEN (wait returns PID [$r] with no associated job) -- ignore\n";
	print "ERROR-CANTHAPPEN (wait returns PID [$r] with no associated job)\07\07\07\07\07\07\n";
	my $i=0; while($i<5) { sleep(10); print "\07\07\07\07\n"; $i++; }

	# just *IGNORE* this fact -- pretend nothing happened
	return '';
    }

    $childs--;
    $j = $pid2job{$r};
    $t = $pid2tty{$r};
    delete $pid2job{$r};
    delete $pid2tty{$r};
    delete $phones{ $queue{$j}->{'phone'} };

    print LOG "    ---> return=**$r** (-> job=$j, tty=$t), status=$s -> exit($ex)\n" if $opt_d;

    # job is through: remove from queue length, and mark tty as free.
    $mq_length{$t} -= $queue{$j}{weight};
    $tty_in_use{$t}=0;

    if ( $ex == 0 && $s > 0 )		# signal?!?
    {
	print LOG "$j: sendfax (pid $r) was killed with signal $s\n";
	$ex = 15;
    }

    if ( $ex == 100 )
    {
	print LOG "Problems with exec() --> aborting\n";	#!!!!! DIE
	unlink "$j/JOB.locked";
	return $t;
    }

    # save result for per-tty statistics
    if ( ! defined( $tty_statistics{$t} ) )
				{ $tty_statistics{$t} = {'total'=>0, '0'=>0}; }
    if ( ! defined( $tty_statistics{$t}{$ex} ) ) 
				{ $tty_statistics{$t}{$ex} = 0; }
    $tty_statistics{$t}{total}++;
    $tty_statistics{$t}{$ex}++;

    # and, in case of errors, for per-remote-phone statistics
    if ( $ex > 0 )
    {
        my $ph = $queue{$j}->{'phone'};
	if ( ! defined( $per_phone_statistics{$ph} ) || 
	     ! defined( $per_phone_statistics{$ph}{$ex} ) )
		{ $per_phone_statistics{$ph}{$ex} = 0; }
	$per_phone_statistics{$ph}{$ex}++;
    }


    # now handle return codes
    if ( $ex == 0 )		# job successfully sent
    {
	print LOG "$j: Job successfully sent\n" if $opt_v;

	# remove from internal work queue
	$queue{$j}->{'status'} = 'done';

	# write status line to JOB file
	&wstat( $j, "Status " . localtime() . " successfully sent\n");

	# write acct.log
	&wacct($j, "success");

	# success mail
	&sms($j)
		if $send_mail_success;

	# success program
	if ($program_success ne '')
	{
	    print LOG "    calling program $program_success for job $j...\n" if $opt_v;
	    system( "$program_success $fax_spool_out/$j/JOB </dev/null" );
	}

	# remove JOB file
	unless( rename( "$j/JOB", "$j/JOB.done" ) )
	{
	    # failed -- maybe the "$program_success" has removed it?
	    # --> die only if the file and directory still exist

	    if ( -d "$j" && -f "$j/JOB" )
		{ die "error renaming $j/JOB: $!"; }
	    else
		{ print LOG "$j/JOB: rename failed ($!) - whatever...\n"; }
	}

	# if requested, erase all files
	if ( $delete_jobs )
	{
	    print LOG "    delete job directory $j/.\n" if $opt_v;
	    system( "rm -rf $j" ) if ( $j =~ /^F[0-9]/ );

	    # if the directory is gone, we don't need to remember the job...
	    delete $queue{$j};
	}
    }				# end if ( ex == 0 )
    else			# failure sending job...
    {
	my $verb_ex = $exitcodes[$ex];

	print LOG "$j: FAILED: $ex -> $verb_ex\n" if $opt_v;

	# increase number of unsuccessful attempts (and costly attempts)
	$queue{$j}->{'tries'}++;
	$queue{$j}->{'tries_c'}++  if $ex >= 10;

	# write status line to JOB file
	my $fstr = ( $ex<10 )? "failed" : "FATAL FAILURE";
	&wstat( $j, "Status " . localtime() . " $fstr, exit($ex): $verb_ex\n");

	# write acct.log
	&wacct($j, "fail $ex: $verb_ex");

	#!!!! compare numbers -> remove job, or just requeue

	if ( $queue{$j}{'tries'}   >= $max_tries_total ||
	     $queue{$j}{'tries_c'} >= $max_tries_costly )
	{
	    # failure mail
	    &smf($j)
		if $send_mail_failure;

	    # failure program
	    if ($program_failure ne '')
	    {
		print LOG "    calling f-program $program_failure for job $j...\n" if $opt_v;
		system( "$program_failure $fax_spool_out/$j/JOB </dev/null" );
	    }

	    # remove from queue directory (suspend, but do not delete it)
	    unless( rename( "$j/JOB", "$j/JOB.suspended" ) )
	    {
		# failed -- maybe the "$program_failure" has removed it?
		# --> die only if the file and directory still exist

		if ( -d "$j" && -f "$j/JOB" )
		    { die "error renaming $j/JOB: $!"; }
		else
		    { print LOG "$j/JOB: rename failed ($!) - whatever...\n"; }
	    }

	    # remove from internal queue
	    $queue{$j}->{'status'}= 'failed';
	}			# end if ( max tries exceeded )
	else			# requeue...
	{
	    if ( $ex == 4 ) 			# BUSY: delay 5 minutes
	    {
		$queue{$j}->{'status'}='delayed';
		$queue{$j}->{'delayed_until'}=time()+300;
	    }
	    elsif ( $ex == 2 || $ex == 3 || $ex == 5 ) # HW unavailable?
	    {
		$queue{$j}->{'status'}='delayed';
		$queue{$j}->{'delayed_until'}=time()+20;
		$mq_badness{$t} += 0.2;		# mark modem as "bad"
	    }
	    else				# requeue immediately
	    {
		&put_job_to_modem_queue( $j );
	    }
	}
    }				# end if ... else ( sending failed )

    # remove LOCK (ignore errors)
    unlink( "$j/JOB.locked" );

    return $t;
}


sub sms
{
my $job=shift;
my $mail_to=$queue{$job}->{'mail'};
my $d=localtime;

    print LOG "    sending mail to $mail_to...\n" if $opt_v;

    open( M, "|$mail -t" ) ||
	die "opening pipe to mail program failed: $!";

    print M "Subject: OK: your fax to " . ($queue{$job}->{'phone'}) . "\n";
    print M <<EOF1;
To: $mail_to
From: root (Fax Daemon)

Your fax has been sent successfully at: $d

Job / Log file:

EOF1

    open( F, "$job/JOB" ) ||
	die "can't read JOB.done file: $!";
    while( <F> ) { print M $_; }
    close(F);

    print M "\nSending succeeded after " . ($queue{$job}->{'tries'}) . " unsuccessful attempts.\n";
    close(M);
}

sub smf
{
my $job=shift;
my $mail_to=$queue{$job}->{'mail'};
my $rcvr=$queue{$job}->{'phone'};
my $d=localtime;

    print LOG "    sending mail to $mail_to...\n" if $opt_v;

    open( M, "|$mail -t" ) ||
	die "opening pipe to mail program failed: $!";

    print M <<EOF1;
To: $mail_to
From: root (Fax Daemon)
Subject: FAIL: your fax to $rcvr

It was not possible to send your fax to $rcvr!

The fax job is suspended, you can requeue it for another delivery
attempt with the command:

    cd $fax_spool_out/$job
    mv JOB.suspended JOB

or (easier) with:

    faxq -r


The log file of your job follows:

EOF1

    open( F, "$job/JOB" ) ||
	die "can't read JOB.done file: $!";
    while( <F> ) { print M $_; }
    close(F);

    close(M);
}

# write "Status" record to JOB file
# parameters: job id, string to write to file
sub wstat
{
    my ($j,$r) = @_;

    unless ( open( J, ">>$j/JOB" ) )
    {
	print LOG "ERROR: can't append status line to $j/JOB: $!\n";
	&remove_error_job($j);
	return;
    }

    print J $r;
    close J;
}

# write record to acct.log
# parameters: job id, success/failure string (free form) to write to file
sub wacct
{
    my ($j,$r) = @_;

    my $m = $queue{$j}->{'mail'};
    my $p = $queue{$j}->{'phone'};
    my $a = defined( $queue{$j}->{'acct_handle'} ) ? 
		                 $queue{$j}->{'acct_handle'} : '';
    my $d=localtime;

    unless ( open( A, ">>$fax_acct" ) )
    {
	print LOG "ERROR: can't open $fax_acct for appending: $!"; return;
    }

    print A "$m $j |$p |$a|$d| $r\n";
    close A;
}



##########################################################################
#
# signal_handler
#
# called before exit'ing, when user sent a HUP or INT signal...
#
##########################################################################
sub signal_handler
{
my $sig = shift;

    print "\nfaxrunqd: signal handler: got signal $sig, goodbye...\n";
    print LOG "\nfaxrunqd: signal handler: got signal $sig, goodbye...\n";

    # save tty statistics
    &dump_statistics;

    # remove JOB locks of all currently-active jobs
    foreach $pi ( keys %pid2job )
    {
	my $jl = $pid2job{$pi};

        print LOG "remove job lock $jl/JOB.locked.\n" if $opt_d;
	unlink "$jl/JOB.locked";
    }

    # remove PID file (-> global lock)
    print LOG "remove global lock $faxrd_pid.\n" if $opt_d;
    unlink $faxrd_pid;

    exit 7;
}
##########################################################################
#
# signal_handler_USR1
#
# called when user sends a USR1 signal --> set flag to roll log file
#
##########################################################################
sub signal_handler_USR1
{
my $sig = shift;

    print LOG "\nfaxrunqd: signal handler: got signal $sig, roll log file...\n";

    $roll_log_file_requested = 1;
}
##########################################################################
#
# signal_handler_USR2
#
# called when user sends a USR2 signal --> set flag to do graceful exit
#
##########################################################################
sub signal_handler_USR2
{
my $sig = shift;

    print LOG "\nfaxrunqd: signal handler: got signal $sig, will exit as soon as possible...\n";

    $graceful_exit_requested = 1;
}
##########################################################################
#
# dump_statistics
#
# write tty statistics to LOG
# called before exiting, and in regular intervals
#
##########################################################################
sub dump_statistics
{
my $t; 
    print LOG "--------------------------------------------------\n";
    foreach $t (keys %tty_statistics)
    {
	print LOG "modem statistics for tty '$t'\n";
	print LOG "    total faxes sent: ${tty_statistics{$t}{'total'}}\n";
	print LOG "    total success   : ${tty_statistics{$t}{'0'}}\n";
	foreach (sort(keys %{$tty_statistics{$t}}))
	{
	    next if ($_ eq '0') || ($_ eq 'total');
            printf LOG "    error code %-2d   : %d (%1.1f%%) [%s]\n",
		$_, $tty_statistics{$t}{$_}, 
		100*$tty_statistics{$t}{$_}/$tty_statistics{$t}{total},
		$exitcodes[$_];
	}
    }
    print LOG "--------------------------------------------------\n";
    foreach $t (sort (keys %per_phone_statistics))
    {
	print LOG "error statistics for remote number '$t'\n";
	foreach (sort(keys %{$per_phone_statistics{$t}}))
	{
            printf LOG "    error code %-2d   : %d [%s]\n",
		$_, $per_phone_statistics{$t}{$_}, 
		$exitcodes[$_];
	}
    }
    print LOG "--------------------------------------------------\n";
}



##########################################################################
#
# remove_stale_locks
#
# called at startup, if stale "faxrunqd.pid" file is found
# go through all F..../ directories, remove JOB.locked files.
#
##########################################################################
sub remove_stale_locks
{
    print STDERR "faxrunqd: stale PID file (PID=$p), removing\n";
    unlink $faxrd_pid;

    chdir( $fax_spool_out ) || return;

    opendir D, "." || return;
    foreach $f ( readdir( D ) )
    {
	if ( -d $f && -f "$f/JOB.locked" )
	{
	    print STDERR "faxrunqd: remove stale lock \"$f/JOB.locked\"\n";
	    unlink( "$f/JOB.locked" );
	}
    }
    close D;
    return;
}
