#!/usr/common/bin/perl
setpwent;

$deadtime=10;

# this stops RSH from writing to STDERR and corrupting the screen
# unfortunately this makes the error messages go away
open(STDERR,">/dev/null"); # prevent rsh from writing to screen
$debug=0;

print "lablook v1.0 (c) 1994 Robert Partington\n";
if($#ARGV==-1)
{
    print <<EOH;

Aliases: f	first year lab (LF31)
	 s	second year lab (LF15)
	 t	third year lab (IT407)
	 e	electronics labs
	 c	crash lab (LF19)
	 t      t9
	 v      visual systems lab (n7)
	 x	everything

lablook is another amazing perl-ette
        by Robert Partington (c) 1994
EOH
    exit;
}

&process_alias_list(DATA);
undef $/;

@aliases{"1"}="n1[a-t],n2[a-s]";
@aliases{"f"}="!1";
@aliases{"2"}="t1[a-o],t2[a-o]";
@aliases{"s"}="!2";
@aliases{"3"}="t3[a-j],n8[a-p],n9[a-l]";
@aliases{"t"}="!3";
@aliases{"e"}="n4[a-f],n5[a-f],n6[a-z]";
@aliases{"c"}="n3[a-l]";
@aliases{"a"}="t9";
@aliases{"v"}="n7[a-e]";
@aliases{"x"}="!1,!2,!3,!e,!c,!a,!v";

foreach(@ARGV)
{
    if(/^-h/)
    {
	print <<HELPMSG;

lablook <machine list>

lablook tells you who's logged into a particular machine
It takes the same aliases (1,f,2,s,3,t,e,c,a,x) as does 'u'
but it takes less processor time and the output is a lot
better (IMHO).
HELPMSG
        exit(1);
    }
    print "'$_'\n" if $debug;
    $fm=@aliases{$_};
    if($fm)
    {
	if($fm=~/\[/ || $fm=~/^!/)
	{
	    print "matched $_\n" if $debug;
	    foreach(split(/,/,$fm))
	    {
		if(/^!(.+)$/)
		{
		    $_=@aliases{$1};
		}
		($s,@m)=&parse($_);
		$h=($h ? join(',',$h,@m) : join(',',@m));
	    }
	}
	else
	{
	    $h=$fm;
	}
    }
    elsif(/\[/)
    {
        ($s,@m)=&parse($_);
        $h=join(',',@m);
    }
    else
    {
        $h=$_;
    }
    foreach(split(/,/,$h))
    {
        @doit{$_}=1;
    }
}
foreach(sort keys(doit))
{
    &domachine($_);
}

sub process_alias_list
{
    # process the alias list given by filehandle F
    local($F)=@_;
}

sub timeout
{
    print "$m : Timed out after $deadtime seconds\n";
    kill 9,$pid;
    $died=1;
}
    
sub display
{				#
    local($lusers)=@_;
    if($lusers=~/unknown host$/)
    {
        print "$m : unknown host\n";
	return;
    }
    unless ($lusers)
    {
	print "$m : No users\n";
    }
    else
    {
	@list=split(/\n/,$lusers);
	# 
	foreach(@list)
	{
	    split(/ +/);
	    if(@_[1]=~/^console|^tty/)
	    {
		$user=@_[0];
		unless(@seen{$user})
		{
		    ($nm,$pw,$ui,$gi,$qt,$cm,$gc,$dr,$sh)=getpwnam($user);
		    if($gc)
		    {
			push(@users,"$gc ($user)");
		    }
		    else
		    {
			push(@users,"$user");
		    }
		    @seen{$user}=1;
		}
	    }
	}
	unless($#users==-1)
	{
	    $rest=join("\n" . ' ' x (length($_)+3), @users);
	    print "$m : $rest\n";
	}
    }
}

sub domachine
{
    local($m)=@_;
    local(@users)=();
    undef $died;
    $SIG{'ALRM'}='timeout';
    alarm($deadtime);
    if($pid = open(RSH,"rsh $m who |"))
	{
	    $lusers=<RSH>;
	    close(RSH);
	    alarm(0);
	}

    if($?!=0)
    {
        $lusers="unknown host";
    }
    unless ($died)
    {
	&display($lusers);
    }
}

sub addmachines
{
    local($_,$altnam)=@_;

    ($server,@machines)=&parse($_);
    if($server)
    {
	@list{$server}=join(',',@machines,split(/,/,@list{$server}));
    }
    else
    {
	@list{$_}="$_";
    }				# 
    if($altnam)
    {
        @list{$altnam}=join(',',@machines,split(/,/,@list{$altnam}));
    }
}

sub parse
{
    local($_)=@_;
    local($server,$range,@machines,$from,$to,@done);

    undef %done;

    if(/([^[]+)\[([^]]+)\]/)
    {
        $server=$1;
        $_=$2;
        $range=$2;

        # handle ranges and non-characters
        if(/^(.+)\^([a-z]+)$/)
        {
            $range=$1;
            $nots=$2;
        }

        # look for c-c pairs
        while($range=~/-/)
        {
            $range=~s/(.)-(.)//;
            $from=$1;
            $to=$2;
            @done{$from..$to}=1;
        }

        if($range)
        {
            foreach(split(//,$range))
            {
                @done{$_}=1;
            }
        }

	foreach(split(//,$nots))
	{
            delete $done{$_};
	}

        @machines=grep($_="$server$_",keys(done));
    }
    ($server,@machines);
}
__END__
f	n1[a-t],n2[a-s]		first year lab (LF31)
s	t1[a-o],t2[a-o]		second year lab (LF15)
t	t3[a-j],n8[a-p]		third year lab (IT??)
a	t9			atari lab (t9 really)
e	n4[a-f],n5[a-f],n6[a-z]	electronics labs
c	n3[a-l]			crash lab (LF??)
x	1,2,3,e,c,a	        everything