#!/usr/bin/perl -w

# tty check module

# Version: $Revision: 0.5 $
# Author: Matt Selsky <selsky@columbia.edu>
#  (Based on compiled tty module by Benjamin Oshrin)
# Date: $Date: 2003/01/29 01:32:11 $
#
# Copyright (c) 2002 - 2003
# The Trustees of Columbia University in the City of New York
# Academic Information Systems
# 
# License restrictions apply, see doc/license.html for details.

use strict;
use FindBin;
use lib "$FindBin::Bin/../common";
use Survivor::Check;

use POSIX qw(:errno_h :fcntl_h);

my %argfmt = ('flags' => 'optional flags any(b,n)',
              'warn' => 'optional number between(0,100)',
              'prob' => 'optional number between(0,100)');

my $sc = new Survivor::Check();

$sc->GetOpt(\%argfmt, \&TtyValidate);

my($bad,    # Lines that we cannot verify
   $active, # Lines in use
   $avail,  # Lines not in use
   $notty,  # Open lines that aren't ttys
   $total,  # Total lines examined
   $warnerr # Error string
   );
$bad = $active = $avail = $notty = $total = 0;

my($checkbad,$checknotty);

my $r = $sc->Exec( \&TtyCheck);

exit($r);

sub TtyValidate {
    return(MODEXEC_OK, 0, "Tty OK");
}

sub TtyCheck {
    my $self = shift;
    my $host = shift;

    my $rc = MODEXEC_OK;

    my $flags = $self->Arg('flags');
    my $warn = $self->Arg('warn');
    my $prob = $self->Arg('prob');

    if(!defined $warn && !defined $prob) {
	return(MODEXEC_MISCONFIG, 0, "Must specify either 'warn' or 'prob'");
    }

    if(defined $flags && $flags =~ /b/) {
	$checkbad++;
    }
    if(defined $flags && $flags =~ /n/) {
	$checknotty++;
    }

    # First, do a relatively simple check to see what is available
    # to check.  If a directory /dev/pts exists, use it, otherwise
    # use /dev and only check entries beginning with pts or tty
    # (that aren't directories)

    # XXX doesn't work if using devpts since only in use ptys show up
    if( -d '/dev/pts' ) {
	&checkdir('/dev/pts', 1);
    } else {
	&checkdir('/dev', 0);
    }

    # warn if any abnormalities encountered
    if($warnerr) {
	$rc = MODEXEC_WARNING;
    }

    # Now check totals
    my $unavail_pct = (($total - $avail) * 100) / $total;

    if(defined $prob && $unavail_pct >= $prob) {
	$rc = MODEXEC_PROBLEM;
    } elsif(defined $warn && $unavail_pct >= $warn) {
	$rc = MODEXEC_WARNING;
    }

    # Append tally information
    my $buf = "$active active, $avail available".
	($checkbad ? ", $bad bad lines" : '').
	($checknotty ? ", $notty not ttys" : '' ).
	", $total total";

    my $x;
    if($rc == MODEXEC_PROBLEM) { $x = 'PROBLEM:' }
    elsif($rc == MODEXEC_WARNING) { $x = 'WARNING:' }
    else { $x = 'OK:' }

    &appendwarn( $x, $buf, 1);
	
    return($rc, $avail, $warnerr);
}

sub checkdir {
    # Check the ttys in <dirname>.  If <all> is true, check all files
    # in <dirname> (not beginning with '.'), else check only those
    # beginning with 'pts' or 'tty'.
    my $dirname = shift;
    my $all = shift;
    
    if($dirname) {
	if( opendir(DIR, $dirname) ) {
	    while(defined(my $d = readdir(DIR))) {
		if( ($all && $d !~ /^\.\.?$/) ||
		    (!$all && ($d =~ /^pts/ || $d =~ /^tty/)) ) {
		    &checktty($dirname . '/' . $d);
		}
	    }
	    closedir(DIR);
	}
    }
}

sub checktty {
    my $path = shift;

    return unless($path);

    $total++;
    my($fd,$timeout);

    if( -e $path ) {
	$SIG{ALRM} = sub { die "timeout" };
	eval {
	    $timeout = 1;
	    alarm(1);
	    $fd = POSIX::open($path, O_RDONLY|O_NOCTTY|O_NONBLOCK);
	    alarm(0);
	    undef $timeout;
	};
	if($@) {
	    if($@ =~ /timeout/) {
		$timeout = 1;
	    }
	    else {
		alarm 0; # clear pending alarm
		return(MODEXEC_PROBLEM, 0, "Unhandled timeout exception - $@");
	    }
	}
	$SIG{ALRM} = 'DEFAULT';

	if(defined $fd) {
	    if( POSIX::isatty($fd) ) {
		$active++;
	    } elsif($checknotty) {
		$notty++;
		&appendwarn( $path, 'is not a tty', 0);
	    } else {
		$avail++;
	    }
	    POSIX::close($fd);
	} elsif(!defined $timeout) {
	    # Some OSs, like Solaris 8, return ENXIO when there is no
	    # device associated with the character device (ie: nobody
	    # is logged in) while others (Sol 2.5) use EACCESS instead.
	    # We check for ENXIO first, since its meaning is clearer.
	    if(POSIX::errno() == ENXIO) {
		# No device associated w/ char device
		$avail++;
	    } elsif(POSIX::errno() == EACCES) {
		# The actual action to take here would be dependent on
		# if the OS returns ENXIO or not.  If it did, this should
		# actually be considered a bad line.  Since we can't
		# really know, we assume the line is available.
		$avail++;
	    } elsif(POSIX::errno() == 0 ) { # XXX why is errno == 0?
		$avail++;                   # usually for /dev/pts/0
	    } else {
		&appendwarn( $path, "unhandled - ".POSIX::errno(), 0);
		$bad++;
	    }
	} else {
	    if($checkbad) {
		$bad++;
		&appendwarn( $path, 'timed out', 0);
	    }
	}
    } elsif($checkbad) {
	$bad++;
	&appendwarn( $path, 'did not stat', 0);
    }
}

sub appendwarn {
    my $p = shift;
    my $e = shift;
    my $prepend = shift;

    if($p && $e) {
	if($warnerr) {
	    if($prepend) {
		$warnerr = "$p $e,$warnerr";
	    } else {
		$warnerr = "$warnerr,$p $e";
	    }
	} else {
	    $warnerr = "$p $e";
	}
    }
}
