Article 1406 of alt.sources:
Xref: feenix.metronet.com alt.sources:1406
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!agate!biosci!enterpoop.mit.edu!bloom-beacon!senator-bedfellow.mit.edu!news!jsc
From: jsc@monolith.mit.edu (Jin S Choi)
Newsgroups: alt.sources
Subject: fingerall (1/1), a perl script for finding who's logged in
Message-ID: <JSC.93Jun12101500@monolith.mit.edu>
Date: 12 Jun 93 14:15:00 GMT
Organization: Massachvsetts Institvte of Technology
Lines: 229
NNTP-Posting-Host: monolith.mit.edu
Followups-To: alt.sources.d
Comments: Hyperbole mail buttons accepted, v3.07.


Archive-name: fingerall
Submitted-by: jsc@athena.mit.edu

This was requested by someone on comp.sources.wanted and I thought it
might be generally useful.

This is a perl script you can run in the background to tell you when
people log in or out. It works by establishing a finger connection every
so often and checking the results. You can specify regular expressions
for what constitutes being logged in, so it will work for all sorts of
different systems. Read the source for details.

By the way, zwrite is part of zephyr, a windowed messaging system used
at MIT. It pops up a little window with a message on your screen.

Comments, suggestions welcome.

-------------------------------------------------------------------
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	fingerall
#	/usr/local/lib/perl/finger.pl
# This archive created: Sat Jun 12 10:12:59 1993
export PATH; PATH=/bin:$PATH
if test -f 'fingerall'
then
	echo shar: will not over-write existing file "'fingerall'"
else
cat << \SHAR_EOF > 'fingerall'
#!/usr/local/bin/perl

# Written by Jin Choi <jsc@athena.mit.edu>
# 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. -z to zwrite.

# 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.

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';

# process switches
&Getopts('fi:z');
$interval = $opt_i if $opt_i;
$file = $opt_f if $opt_f;
$zwrite = $ENV{'USER'} if $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;
    }
    $output = "";
    foreach $person (keys %on_now) {
	$output .= "$person logged in\n" if !$on_before{$person};
    }
    foreach $person (keys %on_before) {
	$output .= "$person logged out\n" if !$on_now{$person};
    }

    if ($zwrite && $output) {
	open(Z, "| zwrite -s fingerall -n -q $zwrite");
	print Z $output;
	close Z;
    }
    else {
	print $output;
    }

    %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') {
	if ($zwrite) {
	    open(Z, "| zwrite -s fingerall -n -q $ENV{'USER'}");
	    select(Z);
	}
	print join("\n", (sort keys %on_now)), "\n";
	close(Z), select(STDOUT) if $zwrite;
    }
    elsif ($sig eq 'USR2') {
	&read_file();
	&check_list();
    }
}

SHAR_EOF
chmod +x 'fingerall'
fi # end of overwriting check
if test -f '/usr/local/lib/perl/finger.pl'
then
	echo shar: will not over-write existing file "'/usr/local/lib/perl/finger.pl'"
else
cat << \SHAR_EOF > '/usr/local/lib/perl/finger.pl'
# Written by Mark Eichin <eichin@athena.mit.edu>
require "sys/socket.ph";
package finger;

sub mkport {
  local($saddr,$port) = @_;
  
  local($sockaddr,$sin);
  
  $sockaddr = 'S n a4 x8';
  $sin = pack($sockaddr, 2, $port, $saddr);

  socket(FINGER_SERVER, 2, 1, 0) || return "socket:$!";
#  print "socket done\n";

  connect(FINGER_SERVER, $sin) || return "connect:$!";
#  print "connect done\n";

  select(FINGER_SERVER); $| = 1; select(STDOUT); $| = 1;
  return "OK";
}


sub main'finger {
  local($uname,$node) = @_;
  local($name, $aliases, $type, $len, $thisaddr, $port);
  
  ($name, $aliases, $port) = getservbyname("finger", 'tcp');
  ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($node);
#  print "trying $uname@$node...\n";
  print "[$name]";
  $status = &mkport($thisaddr,$port);
  print "\n";
#  print "mkport returned\n";
  if($status ne "OK") { print "$node:$status\n"; next; }
  else {
    print FINGER_SERVER "$uname\r\n";
    while (<FINGER_SERVER>) { s/\015//; print "$_"; }
    close FINGER_SERVER;
  }
}

sub main'finger_str {
  local($uname,$node) = @_;
  local($name, $aliases, $type, $len, $thisaddr, $port);
  local($output) = "";
  
  ($name, $aliases, $port) = getservbyname("finger", 'tcp');
  ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($node);
  $output.= "[$name]";
  $status = &mkport($thisaddr,$port);
  $output.="\n";
#  print "mkport returned\n";
  if($status ne "OK") { $output.= "$node:$status\n"; }
  else {
    print FINGER_SERVER "$uname\n";
    while (<FINGER_SERVER>) { s/\015//; $output.= $_; }
    close FINGER_SERVER;
  }
  $output;
}

SHAR_EOF
fi # end of overwriting check
#	End of shell archive
exit 0
--
Jin Choi
jsc@athena.mit.edu