#!/usr/athena/bin/perl

# Usage: fingerall [-f file] [-i <interval>] [-z]

# fingerall fingers everyone in a file (~/.fingerall by default) every so
# often and reports who logs in and out. Prints a list of people currently
# on upon receiving a SIGUSR1, rereads data file on a SIGUSR2.
# It's recommended that one keeps the list of people fairly small and the
# interval somewhat large.

# file format: .fingerall consists of a list of usernames and
# addresses at which to finger, and an optional regexp to to specify
# what constitutes being on for that address. A regexp beginning with
# a '!' signifies that a user is logged on if that regexp isn't found.
# Look at mine for an example. Lines beginning with hash (#) are
# ignored, as are blank lines.

push(@INC, "/afs/athena/user/j/s/jsc/lib/perl");
require 'getopts.pl';
require 'finger.pl';
$| = 1;  # unbuffered output
$SIG{'USR1'} = 'handler';
$SIG{'USR2'} = 'handler';

# defaults
$interval = 10;
$file = "$ENV{'HOME'}/.fingerall";
$default_test = 'On\s+[\w\s]*since';
$zwrite_cmd = "zwrite -n -q $ENV{'USER'}";

# process switches
&Getopts('f:i:z');
$interval = $opt_i if $opt_i;
$file = $opt_f if $opt_f;
$zephyr = $opt_z;

&read_file();

while (1) {
    &check_list();
    sleep $interval * 60;
}

sub check_list {
    local($person, $test, $on);
    undef %on_now;
    while (($person, $test) = each %people) {
	$on = &is_on($person, $test);
	$on_now{$person} = $on if $on;
    }

    if ($zephyr) {
	open(Z, "|$zwrite_cmd");
	
	foreach $person (keys %on_now) {
	    print Z "$person logged in\n" if !$on_before{$person};
	}
	foreach $person (keys %on_before) {
	    print Z "$person logged out\n" if !$on_now{$person};
	}
	close Z;
    }
    else {
	foreach $person (keys %on_now) {
	    print "$person logged in\n" if !$on_before{$person};
	}
	foreach $person (keys %on_before) {
	    print "$person logged out\n" if !$on_now{$person};
	}
    }
    %on_before = %on_now;
}

# test to see if a user is logged on
sub is_on {
    local($person, $test) = @_;
    local($uname, $node, $atloc, $on);
    $atloc = rindex($person,'@');
    $uname = substr($person, 0, $atloc);
    $node = substr($person, $atloc + 1);
    $on = &finger_str($uname, $node);
    if ($test =~ /^!/) {
	$test =~ s/^.//;
	!($on =~ /$test/);
    }
    else {
	$on =~ /$test/;
    }
}
    
sub read_file {
    local(@lines, $person);
    undef %people;
    open(IN, $file) || die "fingerall: couldn't find $file: $!\n";
    @lines = <IN>;
    close IN;
    die "no names in $file\n" unless @lines;
    foreach (@lines) {
	chop;
	next if /^#/;
	next if /^\s*$/;
	/^([@\.\w-]+)\s*(.*)/;
	$person = $1;
	$people{$person} = $2 ? $2 : $default_test;
    }
}

sub handler {
    local($sig) = @_;
    if ($sig eq 'USR1') {
	print join("\n", (sort keys %on_now)), "\n";
    }
    elsif ($sig eq 'USR2') {
	&read_file();
	&check_list();
    }
}