#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::ROText;
use Tk::BrowseEntry;
use File::Basename;
use Time::Local;
use POSIX;
use Getopt::Std;
use subs qw(logmsg errmsg);

=head1 mboxw

 Monitor an mbox format mailbox and Gcal.

 Create popup notifications for incoming mail and upcoming appointments.

 This program uses Tk/perl. Pop-up notifications are created with fork().

 The parent looks for a response from a child (pop-up notification) by
 checking for a click file,

 Child processes (pop-up notifications) are destroyed by the parent
 after $f_wait seconds with KILL.

 See Main Article for more information about this script.

=cut

our ($opt_c, $opt_r, $opt_v);

getopt('c');

# load the config file
$opt_c = "$ENV{HOME}/.mboxw/config.pl" unless ($opt_c);
die "No such file $opt_c" unless (-s $opt_c);
require $opt_c;
my $my_folder = dirname $opt_c;

# CONFIG -- See config.pl for more details

our $soundplayer;                               # location of sound player
our $new_mail;                                  # sound for new mail arrival
our $meeting;                                   # sound for upcoming meeting
our $mail_dimension;                            # width x height
our $mail_x_pos;                                # x pos of mail response window
our $mail_y_pos;                                # y pos of mail response window
our $cal_x_pos;                                 # x pos of calendar notification
our $cal_y_pos;                                 # y pos of calendar notification
our $inbox;                                     # location of inbox (mbox format)
our $m_wait;                                    # time to sleep between mail box checks
our $c_wait;                                    # time to check between calendar checks
our $f_wait;                                    # time to wait for child after fork()
our $gcalcli;                                   # location of gcalcli (py script)
our $snooze_interval;                           # snooze interval between calendar reminders
our $reminder;                                  # lead time for first calendar reminder
our $lockfile;                                  # we only want one copy of this script
our $cachefile;                                 # where we our cache data
our %calendar;                                  # calendars we want to track
our $nag_tm;                                    # time to wait before nagging about unread emails
our $logfile;                                   # location of logfile
our $log_gag;                                   # amount of log 0 = most, 3 = least
our $log_roll_size;                             # size at which we will roll the log
our $log_roll_compress;                         # time (days) after which we compress rolled logs
our $log_roll_retain;                           # time (days) to keep gzipped rolled logs
our $renum_flag;                                # status kept when inbox resequenced?

my %Mbox;                                       # Mbox stats

# These use mbox_no + timestamp as hash key
my $cutoff;                                     # ignore data older than this
my %AckHead;                                    # headers not yet acknowledged
my %e_time;                                     # email timestamp (from mbox)
my %e_stat;                                     # email status (A/R/O/N/K)

# These use timestamp as key
my %AckAppt;                                    # appointments not yet acknowleded
my %Gcal;                                       # hash of agenda (key = time)
my %Snooze;                                     # time when snooze started (appointment)

my $next_nag;                                   # time for next nagging alert
my $ymd = POSIX::strftime("%y%m%d", localtime); # today's date
my $localhost = `hostname`;                     # local hostname
$localhost =~ s/\s+$//;
my $inbox_mnum = 0;                             # number messages in inbox

my %Month = (
        Jan => 1,
        Feb => 2,
        Mar => 3,
        Apr => 4,
        May => 5,
        Jun => 6,
        Jul => 7,
        Aug => 8,
        Sep => 9,
        Oct => 10,
        Nov => 11,
        Dec => 12,
);

# ------------------------------------------------------------------------

=head1 logmsg (subroutine)

 Write a message along with timestamp. If $logfile is defined, write it
 to that file, otherwise write it to STDOUT. Put it to both STDOUT and
 $logfile if $opt_v is defined.

=cut

sub logmsg {
        my ($msg,$level) = @_;
        $level = 0 unless ($level);
        return if ($level < $log_gag);
        $msg =~ s/\s+$//;
        $msg = sprintf "%s %s", POSIX::strftime("%Y-%m-%d %H:%M", localtime), $msg;
        if ($logfile) {
                open LOG,">>$logfile" || errmsg "Cannot open: $logfile - $!";
                print LOG "$msg\n";
                close LOG;
                print "$msg\n" if ($opt_v);
        } else {
                print "$msg\n";
        }
}

# ------------------------------------------------------------------------

=head1 errmsg (subroutine)

 Use this instead of die ... Puts a POSIX timestamp in front of message.

=cut

sub errmsg {
        logmsg $_[0];
        die "ERROR: $_[0]\n";
}

# ------------------------------------------------------------------------
=head1 appointment (child process)

 Calendar Alert

 Create a text message box with appointment details and minutes till due
 and wait for user response. The message will time-out after $f_wait
 seconds (will be killed by parent).

 Two callback subroutines, flag_ok() and flag_snooze() are invoked with
 Tk button commands.

=cut

sub flag_ok {
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "D\n";
        close CLICK;
        exit;
}

sub flag_snooze {
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "Z\n";
        close CLICK;
        exit;
}

sub appointment {
        my ($a_time) = @_;
        # audio alert
        system "$soundplayer $meeting >/dev/null 2>&1 &";
        my $due = int(($a_time - time)/60);
        my $status;
        if ( $due >= 0 ) {
                $status = "Due in $due minutes";
        } else {
                $status = sprintf "Overdue by %d minutes", $due * -1;
        }
        # Main Window
        my $mw = MainWindow->new(-title => "Appointment");
        $mw->geometry("+$cal_x_pos+$cal_y_pos");
        my $msg = sprintf "%s %s", POSIX::strftime("%H:%M", localtime), $Gcal{$a_time};
        my $label = $mw -> Label(-text=>$msg) -> pack();
        my $due_status = $mw -> Label(-text=>$status) -> pack();
        my $button1 = $mw -> Button(-text => "Dismiss",
                        -command => \&flag_ok)
                -> pack();
        my $button2 = $mw -> Button(-text => "Snooze",
                        -command => \&flag_snooze)
                -> pack();
        MainLoop;
}

# ------------------------------------------------------------------------
=head1 you_got_mail (child process)

 Email Alert

 Put header details of email in a text window and wait for response. This
 subroutine is only called by children. Parent waits for a click file.

 Three callback subroutines, flag_acknowledged(), flag_acknowledged_all
 and flag_spam() are invoked with Tk button commands. See below for more
 details about flag_spam().

=head1 flag_spam (callback subroutine)

 A callback subroutine which dispatches spammer details to the
 firewall. You will have to write your own version of this subroutine.
 This version, which has been written for the PGTS domain, relies on the
 fact that there is a script running in the background which extracts the
 offending IP address and puts the details into /etc/postfix/access. The
 email details are reported to spam assassin using the command:

    sa-learn --mbox --spam

 Details are cross-referenced with the "sinbin script" ... For sinners
 (IP addresses which commit offences other than spamming), time spent in
 "the bin" starts off as a small time and increases with each offence.

=cut

my $spam_details;               # line of text to flag an email as spam (for the firewall)

sub flag_acknowledged {
        # write a click file to acknowledge email
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "A\n";
        close CLICK;
        exit;
}

sub flag_acknowledged_all {
        # write a click file to acknowledge all emails in the inbox
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "*\n";
        close CLICK;
        exit;
}

sub flag_spam {
        my $msg_folder = "/foo/bar";            # hard-code folder here
        # write a click file to report SPAM
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "S\n";
        close CLICK;
        # dispatch spammer details to the firewall
        my $app_owner = `whoami`;
        $app_owner =~ s/\s+$//;
        my $stat_msg = basename $inbox;
        $stat_msg = "$msg_folder/$app_owner.$stat_msg.status";
        open MSG,">>$stat_msg" || errmsg "Cannot open: $stat_msg - $!";
        print MSG "$spam_details\tS\n";
        close MSG;
        exit;
}

sub you_got_mail {
        my ($key,@args) = @_;           # key and headers (dereferenced from %AckHead)
        my @headers;                    # the array of strings that will be displayed
        # Do these tags first ...
        foreach my $tag (qw ( From To Cc Subject Date X-Spam-Status ) ) {
                foreach (@args) { push @headers,$_ if (/^$tag: /i) }
        }
        # put a small divider between the 6 principal header tags and others
        push @headers,"","===","";
        foreach (@_) {push @headers,$_
                unless ( /^From: /i || /^To: /i || /^Cc: /i ||
                        /^Subject: /i || /^Date: /i || /^X-Spam-Status: /i)
        }
        # initiate audio alert
        system "$soundplayer $new_mail >/dev/null 2>&1 &";
        # create the window with Tk
        my $mw = MainWindow->new(-title => "You've Got Mail!");
        $mw->geometry( $mail_dimension . "+$mail_x_pos+$mail_y_pos");
        my $f = $mw->Frame(-relief => 'ridge', -borderwidth => 2)
                ->pack(-fill => 'x');
        my $t = $mw->Scrolled('ROText', -wrap => 'none', -scrollbars => 'se')
                ->pack(-expand => 1, -fill => 'both');
        # create formats for bold and normal fonts
        $t->tagConfigure('bold', -font => "System 11 bold");
        $t->tagConfigure('normal', -font => "System 11");
        # put the header strings in the text box
        while (@headers) {
                my $x = shift @headers;
                my ($tag,$content) = ("","");
                # seperate the tag and the contents
                if ( $x =~ /^(\S+:)/) {
                        ($tag,$content) = ($1,$');
                        $t->insert('end', $tag, 'bold');
                        $t->insert('end', "$content\n", 'normal');
                } else {
                        $t->insert('end', "$x\n", 'normal');
                }
        }
        # add the buttons
        $f->Button(-text => '   *SPAM*   ', -command => \&flag_spam)
                ->pack(-side => 'bottom');
        $f->Button(-text => '  Dismiss  ', -command => \&flag_acknowledged)
                ->pack(-side => 'bottom');
        $f->Button(-text => 'Dismiss All', -command => \&flag_acknowledged_all)
                ->pack(-side => 'bottom');
        # setup the spam details reference string (if needed)
        $spam_details = "$key\t$e_time{$key}";
        # deploy the notification popup
        MainLoop;
}

# ------------------------------------------------------------------------
=head1 nagging_alert (child process)

 Email Alert

 Put From: and Subject: details of emails that have not been
 acknowledged or opened in a text window and wait for response. This
 subroutine is only called by children. Parent waits for a click file.

 Two callback subroutines, stop_nagging() and stop_nagging_all() are
 invoked with Tk button commands.

=cut

sub stop_nagging {
        # write a click file to stopping nagging for the first item
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "FIRST\n";
        close CLICK;
        exit;
}

sub stop_nagging_all {
        # write a click file to stop nagging for all items
        open CLICK, ">$my_folder/click.$$" || errmsg "$!";
        print CLICK "ALL\n";
        close CLICK;
        exit;
}

sub nagging_alert {
        # make some noise to attract attention
        system "$soundplayer $new_mail >/dev/null 2>&1 &";
        # get the summary of the headers
        # create the window with Tk
        my $mw = MainWindow->new(-title => "You've Got Mail");
        $mw->geometry("+$mail_x_pos+$mail_y_pos");
        my $f = $mw->Frame(-relief => 'ridge', -borderwidth => 2)
                ->pack(-fill => 'x');
        my $t = $mw->Scrolled('ROText', -wrap => 'none', -scrollbars => 'se')
                ->pack(-expand => 1, -fill => 'both');
        # create formats for bold and normal fonts
        $t->tagConfigure('bold', -font => "System 11 bold");
        $t->tagConfigure('normal', -font => "System 11");
        foreach my $key (sort{$e_time{$a}<=>$e_time{$b}} keys %AckHead){
                my $arrayref = $AckHead{$key};
                next unless ($e_stat{$key} eq "K");
                my ($from,$subject) = ("","");
                foreach my $h (@$arrayref) {
                        $from = $' if ($h =~ /^From: /i);
                        $subject = $' if ($h =~ /^Subject: /i);
                        last if ($from && $subject);
                }
                $subject =~ s/^\s+//;
                $from =~ s/^\s+//;
                if ($from =~ /^(.*)\</) {
                        my $from_readable = $1;
                        $from_readable =~ s/\s+$//;
                        $from = $from_readable if ($from_readable);
                }
                $from =~ s/\s+$//;
                $from =~ s/^["']//;
                $from =~ s/["']$//;
                $t->insert('end', sprintf ("%-30.30s ",$from), 'bold');
                $t->insert('end', sprintf ("%-50.50s\n",$subject), 'normal');
        }
        # add the buttons
        $f->Button(-text => '  Dismiss  ', -command => \&stop_nagging)
                ->pack(-side => 'bottom');
        $f->Button(-text => 'Dismiss All', -command => \&stop_nagging_all)
                ->pack(-side => 'bottom');
        # deploy the notification popup
        MainLoop;

}

# ------------------------------------------------------------------------

sub read_cache {
        my $now = time;
        foreach my $key (qw ( msize mtime last_ack last_write ) ) {
                $Mbox{$key} = 0 unless ($Mbox{$key});
        }
        return unless (-s $cachefile);
        logmsg "reading cachefile";
        open CACHE,$cachefile || errmsg "Cannot open $cachefile";
        $cutoff = $now -(86400 * 7);
        my $tag;
        while (<CACHE>) {
                s/\s+$//;
                next unless ($_);
                if (/\[(\S+)\]$/) {
                        $tag = $1;
                        last if ($tag eq "mbox_cache");
                        next;
                }
                next unless $tag;;
                # last_ack is used to auto-acknowledge emails
                next if ($tag eq "last_ack" && $Mbox{last_ack} > $_);
                $Mbox{$tag} = $_;
        }
        while (<CACHE>) {
                s/\s+$//;
                last if (/^\[gcal\]$/);
                next unless ($_);
                my ($n, $msg_id, $time, $status) = split(/\t/,$_);
                next unless ($time && $status);
                my $key = "$n\t$msg_id";
                next if ($time < $cutoff);
                $e_time{$key} = $time;
                $e_stat{$key} = $status;
        }
        while (<CACHE>) {
                s/\s+$//;
                next unless ($_);
                my ($a_time, $details, $status) = split(/\t/,$_);
                next if (($now - $a_time) > 86400 );
                $Gcal{$a_time} = $details;
                $AckAppt{$a_time} = $status;
                logmsg sprintf("item: %s %s %s", $status,
                        POSIX::strftime("%H:%M", localtime($a_time)), $details);
        }
}

# ------------------------------------------------------------------------

sub write_cache {
        $Mbox{last_write} = time;
        logmsg "writing cachefile";
        open CACHE,">$cachefile" || errmsg "Cannot open $cachefile";
        foreach my $key (qw ( msize mtime last_ack last_write) ) {
                print CACHE "[$key]\n$Mbox{$key}\n";
        }
        print CACHE "[mbox_cache]\n";
        foreach my $key (sort{$e_time{$a}<=>$e_time{$b}} keys %e_time){
                print CACHE "$key\t$e_time{$key}\t$e_stat{$key}\n";
        }
        print CACHE "[gcal]\n";
        foreach my $a_time (sort { $a<=>$b } keys %Gcal) {
                my $status = "N";
                $status = $AckAppt{$a_time} if ($AckAppt{$a_time});
                print CACHE "$a_time\t$Gcal{$a_time}\t$status\n";
        }
        close CACHE || errmsg "Cannot close $cachefile";
}

# ------------------------------------------------------------------------
=head1 read_headers

 read the mbox headers

 If the Header Status: is "RO", it means the email has been opened.

 If the Header Status: is "RO" and the X-Status: is "A" it means the
 email has been opened and a reply sent.

 If the Status: header is not present or is not "RO" the email has not
 been opened.

 The above statuses are not to be confused with the internal statuses
 that this script uses! These statuses are as follows:

     A - Acknowledged (with this script)
     R - Replied to (with mutt)
     O - Opened (with mutt)
     N - Not opened
     K - Email alert timed out (child process killed)

=cut
sub read_headers {
        my %Header;
        my @headers;
        $cutoff = time -(86400 * 7);
        my ($tag, $content) = ("","");
        open INBOX,$inbox || errmsg "Cannot open $inbox";
        $inbox_mnum = 0;
        my $timestamp;
        my $key = "";
        %AckHead = ();
        my %Src;
        if ( $renum_flag) {
                foreach my $k (keys %e_time) {
                        next unless ($e_stat{$k} && $e_stat{$k} eq "A");
                        my $tstamp = $e_time{$k};
                        my ($m,$from) = split (/\t/,$k);
                        $Src{"$from\t$tstamp"} = "A";
                }
        }
        logmsg "reading headers from $inbox";
        while (<INBOX>) {
                s/\s+$//;
                if ( $key ) {
                        if ( $_) {
                                if ( /^(\S+:)\s+/ ) {
                                        ($tag, $content) = ($1, $');
                                        push (@headers, $_);
                                        $Header{$tag} = $content;
                                } else {
                                        $_ =~ s/^\s+//;
                                        $headers[$#headers] .= " $_";
                                }
                        } else {
                                # default status to "not opened"
                                my $from = (split(/\t/,$key))[1];
                                my $status = "N";
                                $status = $Header{"Status:"} if ($Header{"Status:"});
                                # has it been opened with mutt?
                                $status = "O" if ($status eq "RO");
                                # has it has been replied to?
                                $status = "R" if ( $status eq "RO" && $Header{"X-Status:"} eq "A");
                                if ( $status eq "N") {
                                        # has it already been acknowledged by this process?
                                        if ( $e_time{$key} && $e_time{$key} == $timestamp ) {
                                                # use existing status if A or K
                                                $status = $e_stat{$key} if ($e_stat{$key} =~ /[AK]/);
                                        } elsif ($renum_flag && $Src{"$from\t$timestamp"} ) {
                                                $status = $Src{"$from\t$timestamp"};
                                                logmsg "inbox: $inbox_mnum from: $from already acknoledged, status: $status";
                                        } else {
                                                logmsg "inbox: $inbox_mnum from: $from";
                                        }
                                        # set lookup hashes and store the headers;
                                        $e_time{$key} = $timestamp;
                                        $e_stat{$key} = $status;
                                        my @array = @headers;
                                        $AckHead{$key} = \@array;
                                } else {
                                        # already acknowledged by MUA, skip it
                                        delete $e_time{$key} if ($e_time{$key});
                                        delete $e_stat{$key} if ($e_stat{$key});
                                }
                                $key = $tag = "";
                                %Header = ();
                                @headers = ();
                        }
                } elsif ( /^From\s+(\S+)\s+(\w+)\s+(\w+)\s+(\d+)\s+(\d+):\s*(\d+):\s*(\d+)\s+(\d+)/) {
                        my ($from,$wday,$Mth,$d,$h,$m,$s,$y) = ($1,$2,$3,$4,$5,$6,$7,$8);
                        my $mth = $Month{$Mth};
                        $inbox_mnum++;
                        $timestamp = timelocal ($s,$m,$h,$d,$mth-1,$y);
                        next if ($timestamp < $cutoff);
                        $key = sprintf "%d\t%s", $inbox_mnum,$from;
                        $tag = "From";
                        $content = $_;
                        $content =~ s/^From\s+//;
                        $Header{$tag} = $content;
                }
        }
        close INBOX;
}

# ------------------------------------------------------------------------

sub get_gcal_agenda {
        my $start = POSIX::strftime("%Y-%m-%d", localtime (time - 86400) );
        my $end = POSIX::strftime("%Y-%m-%d", localtime (time + 86400) );
        my $a_date = POSIX::strftime("%a %b %d", localtime);
        my $l = 0;
        my $now = time;
        my %agenda;

        # read all "owned" calendars with gcalcli
        foreach my $cal(keys %calendar) {
                my $today = 0;
                my @item = `$gcalcli --nc --cal '$calendar{$cal}' agenda $start $end 2>&1`;
                if ($?) {
                        logmsg join (' ',"No connection with Gcal. ",@item);
                        return;
                } else {
                        foreach (@item) {
                                s/\s+$//;
                                next unless ($_ && length($_) > 18);
                                $today++ if (substr($_, 0, 10) eq $a_date);
                                my ($h,$m) = split(/:/,substr($_, 12,5));
                                $h += 12 if (substr($_, 17, 2) eq "pm" && $h < 12);
                                $h = 0 if ($h == 12 && substr($_, 17, 2) eq "am");
                                my @day = localtime (time - 86400);
                                if ($today) {
                                        @day = localtime;
                                }
                                $day[0] = 0;
                                $day[1] = $m;
                                $day[2] = $h;
                                my $a_time = timelocal @day;
                                # skip yesterday if older than 4 hrs
                                next if ($today == 0 && ($now - $a_time) > 14400);
                                my $detail = "$cal: " . substr($_, 21);
                                if ( $agenda{$a_time} ) {
                                        # skip duplicate entries in different calendars
                                        next if ($agenda{$a_time} eq $detail);
                                        $agenda{$a_time} .= " / $detail";
                                } else {
                                        $agenda{$a_time} = $detail;
                                }
                        }
                }
        }

        # Check for new items
        foreach my $a_time (sort {$a<=>$b} keys %agenda){
                next if ($Gcal{$a_time} && $Gcal{$a_time} eq $agenda{$a_time});
                if ($Gcal{$a_time}) {
                        logmsg sprintf("updating agenda item: %s %s",
                                POSIX::strftime("%H:%M", localtime($a_time)),
                                $agenda{$a_time});
                } else {
                        logmsg sprintf("new agenda item: %s %s",
                                POSIX::strftime("%H:%M", localtime($a_time)),
                                $agenda{$a_time});
                }
                $Gcal{$a_time} = $agenda{$a_time};
        }

        # Check for deleted items
        foreach my $a_time (sort {$a<=>$b} keys %Gcal){
                next if ($agenda{$a_time});
                logmsg sprintf("removing agenda item: %s %s",
                        POSIX::strftime("%H:%M", localtime($a_time)),
                        $Gcal{$a_time});
                delete $Gcal{$a_time};
                delete $AckAppt{$a_time} if ($AckAppt{$a_time});
                delete $Snooze{$a_time} if ($Snooze{$a_time});
        }
}

# ------------------------------------------------------------------------

# process the response file (written by child)
# NB: $key is null if trigger by nagging_alert()

sub process_mail_response {
        my ($click_file,$key) = @_;
        if (open CLICK,$click_file) {
                my $status = (<CLICK>);
                close CLICK;
                $status =~ s/\s+$//;
                if ( $status eq 'FIRST' || $status eq 'ALL' || $status eq '*') {
                        # response to a nagging alert
                        foreach my $key (sort{$e_time{$a}<=>$e_time{$b}} keys %AckHead){
                                next unless ($e_stat{$key} eq "K" || $status eq '*');
                                $e_stat{$key} = "A";
                                delete $AckHead{$key};
                                last if ($status eq 'FIRST');
                        }
                } else {
                        # response to email notification
                        $e_stat{$key} = $status;
                        $Mbox{last_ack} = $e_time{$key};
                        delete $AckHead{$key};
                }
                unlink $click_file;
        } else {
                logmsg "could not open click file: $click_file - $!",99;
        }
        return;
}

# ------------------------------------------------------------------------

# wait for user response to email alert (child process)

sub mail_response_wait {
        my ($child, $key) = @_;
        my $wait = $f_wait + 1;
        my $click_file = "$my_folder/click.$child";
        while ( $wait-- > 0 ) {
                if (-s $click_file) {
                        process_mail_response($click_file,$key);
                        return;
                }
                sleep 1;
        }
        # no response from child
        kill 15, $child;
        logmsg "no response from child process: $child, terminated",1;
        # if $key is null, this was triggered by nagging_alert()
        if ($key) {
                $e_stat{$key} = "K";
        } else {
                $next_nag = time + $nag_tm;
        }
}

# ------------------------------------------------------------------------

# wait for user response to calendar alert (child process)

sub gcal_response_wait {
        my ($child, $a_time) = @_;
        my $wait = $f_wait + 1;
        my $click_file = "$my_folder/click.$child";
        while ( $wait-- > 0 ) {
                if (-s $click_file) {
                        if (open CLICK,$click_file) {
                                my $status = (<CLICK>);
                                close CLICK;
                                $status =~ s/\s+$//;
                                # response to email notification
                                $AckAppt{$a_time} = $status;
                                $Snooze{$a_time} = time if ( $status eq "Z");
                                unlink $click_file;
                        } else {
                                logmsg "could not open click file: $click_file - $!",99;
                        }
                        return;
                }
                sleep 1;
        }
        # no response from child
        kill 15, $child;
        logmsg "no response from child process: $child, terminated",2;
        # auto snooze
        $AckAppt{$a_time} = "Z";
        $Snooze{$a_time} = time;
}

# ------------------------------------------------------------------------

=head1 init (subroutine)

 Sanity checks global parameters (from config.pl). Initialise local
 variables. Check lockfile if locking is specified.

=cut

sub init {
        # commands specified on command line?
        if (@ARGV) {
                $opt_v = 1;
                if ( $ARGV[0] =~ /^term$/i) {
                        errmsg "Can't terminate running process without a lockfile"
                                unless ($lockfile && -s $lockfile);
                        open LOCK,$lockfile || errmsg "Cannot open: $lockfile - $!";
                        my %Lock;
                        my $tag;
                        while(<LOCK>) {
                                s/\s+$//;
                                if (/^\[(\w+)\]$/) {
                                        $tag = $1;
                                        next;
                                }
                                errmsg "Cannot fathom file: $lockfile" unless ($tag);
                                $Lock{$tag} = $_;
                        }
                        errmsg "Cannot terminate process on host: $Lock{HOSTNAME}"
                                unless ( $Lock{HOSTNAME} eq $localhost);
                        errmsg "Cannot find active PID"
                                unless ($Lock{PID} && $Lock{PID} =~ /^\d+$/);
                        kill 15,$Lock{PID};
                        unlink $lockfile;
                        logmsg "PID $Lock{PID} terminated.";
                }
                exit;
        }
        # re-open stderr if logging
        if ($logfile) {
                if ($log_roll_size && (-f $logfile) && $log_roll_size < (-s $logfile)) {
                        # roll the logfile ...
                        rename $logfile,"$logfile.$ymd";
                        if ($log_roll_compress) {
                                $log_roll_retain = $log_roll_compress * 2 unless ($log_roll_compress);
                                foreach my $l(glob "$logfile.[0-9]*") {
                                        if ($l =~ /\.gz$/) {
                                                unlink $l if ((-M $l) > $log_roll_retain);
                                        } else {
                                                system "gzip -f $l" if ((-M $l) > $log_roll_compress);
                                        }
                                }
                        }
                }
                open STDERR,">>$logfile";
        }
        logmsg "$0 commenced, PID: $$",2;
        errmsg "Bad f_wait: $f_wait" unless ($f_wait && $f_wait =~ /^\d+$/ && $f_wait > 0);
        errmsg "Bad m_wait: $m_wait" unless ($m_wait && $m_wait =~ /^\d+$/ && $m_wait > 0);
        errmsg "Bad c_wait: $c_wait" unless ($c_wait && $c_wait =~ /^\d+$/ && $c_wait > 0);
        $m_wait *= 60;
        $c_wait *= 60;
        # set nagging off unless it is an integer value
        if ($nag_tm && $nag_tm =~ /^\d+$/ && $nag_tm > 0) {
                $nag_tm *= 60;
                $next_nag = time + $nag_tm;
        } else {
                $nag_tm = $next_nag = 0;
        }
        $log_gag = 0 unless ($log_gag && $log_gag =~ /^\d+$/);
        $log_gag = 3 if ($log_gag > 3);
        # are we using a lockfile?
        if ( $lockfile && -f $lockfile) {
                logmsg "found lock: $lockfile",2;
                my $wait = int(($m_wait/60) * 5);
                my $stale = $wait * 60;
                my @stat;
                while ($wait) {
                        @stat = stat $lockfile;
                        last if ((time - $stat[9]) > $stale);
                        sleep 60;
                        $wait--;
                        logmsg "waiting on lock: $lockfile ... giving up in $wait minutes",2;
                }
                @stat = stat $lockfile;
                if ((time - $stat[9]) < $stale){
                        # give up waiting for lockfile
                        logmsg "gave up waiting on lock: $lockfile -- $0 terminating ...",99;
                        exit;
                }
                logmsg "removing stale lock: $lockfile",2;
        }
        if ($lockfile) {
                open LOCK,">$lockfile" || errmsg "Cannot open file: $lockfile - $!";
                print LOCK "[HOSTNAME]\n$localhost\n[PID]\n$$\n";
                close LOCK;
        }
        $cachefile = "$my_folder/mboxw_data.cache" unless ($cachefile);
        read_cache();
        get_gcal_agenda();
}

# ------------------------------------------------------------------------

init();
while (1) {
        sleep $m_wait;
        my $kill_count = 0;
        my @stat = stat $inbox;
        unless (@stat) {
                logmsg "ERROR: Cannot stat $inbox",99;
                next;
        }
        system "touch $lockfile" if ($lockfile);
        unless ($stat[7] == $Mbox{msize} && $stat[9] == $Mbox{mtime} ) {
                # refresh the hashes for the inbox
                read_headers();
                $Mbox{msize} = $stat[7];
                $Mbox{mtime} = $stat[9];
                # delete old values
                foreach my $key (keys %e_time){
                        delete $e_time{$key} if ((split (/\t/,$key))[0] > $inbox_mnum);
                }
        }

        # get a response for outstanding emails
        foreach my $key (sort{$e_time{$a}<=>$e_time{$b}} keys %AckHead){
                my $arrayref = $AckHead{$key};
                # was child process was killed on last iteration?
                if ($e_stat{$key} eq "K") {
                        $kill_count++;
                        next;
                }
                next unless ($e_stat{$key} eq "N");
                my $child = fork;
                if ($child) {
                        # wait for response from child
                        mail_response_wait($child, $key);
                        # no more notifications, if inbox changed
                        @stat = stat $inbox;
                        last unless ($stat[7] == $Mbox{msize} && $stat[9] == $Mbox{mtime} );
                } else {
                        # get response from user and exit
                        you_got_mail($key,@$arrayref);
                        exit;
                }
        }

        # get a response for outstanding appointments
        foreach my $a_time (sort {$a<=>$b} keys %Gcal){
                $AckAppt{$a_time} = "N" unless ($AckAppt{$a_time});
                next if ( $AckAppt{$a_time} eq "D");
                my $now = time;
                if ( $AckAppt{$a_time} eq "Z") {
                        $Snooze{$a_time} = 0 unless ($Snooze{$a_time});
                        if ( ($now - $Snooze{$a_time} ) > $snooze_interval * 60) {
                                $Snooze{$a_time} = $now;
                        } else {
                                next;
                        }
                }
                # are we in the reminder time window?
                next if (($a_time - $now) > ($reminder * 60) );
                my $child = fork;
                if ($child) {
                        # wait for response from child
                        gcal_response_wait($child, $a_time);
                } else {
                        # get response from user and exit
                        appointment($a_time);
                        exit;
                }
        }

        # refresh calender info every $c_wait seconds
        if ( (time - $Mbox{last_write}) > $c_wait) {
                logmsg "refreshing calendar info",2;
                get_gcal_agenda();
                write_cache();
                $Mbox{last_write} = time;
        }

        # nag, if required
        if ( $nag_tm && $kill_count && (time > $next_nag) ) {
                logmsg "nagging alert";
                my $child = fork;
                if ($child) {
                        # wait for response from child
                        mail_response_wait($child);
                } else {
                        nagging_alert();
                        exit;
                }
        }
}

# ------------------------------------------------------------------------