#! /usr/local/bin/perl -w
#################################################################
#
#   tkleute
#
#   Ein Script mit PerlTK, um die rwho Ausgabe graphisch 
#   aufzubereiten, und nur die interessanten Leute zu filtern.
#
#   $Id: tkleute,v 1.7 2001/06/07 20:51:56 hjficker Exp $
#
#################################################################
#  TODO: 
#    - Rückportierung auf Textmode
#    - Optionen (--help, --version und ähnlicher Schwachfug


# Sauberes Programmieren erzwingen...
use strict;
use diagnostics;

# PerlTK
use Tk;
require Tk::Balloon;


#################################################################
#  Einige Defaults

# Konfigurations-Datei
my $conf_filename = $ENV{"HOME"} . "/.tkleute";

# Defaults
my %init_globalconf = 
    ( windowtitle => "Big Brother",
      geometry    => "40x30",
      font        => "-*-fixed-medium-r-*-*-13-*-*-*-*-*-iso8859-1",
      titlefont   => "-*-fixed-bold-r-*-*-13-*-*-*-*-*-iso8859-1",
      consolefont => "-*-fixed-medium-r-*-*-13-*-*-*-*-*-iso8859-1",
      command     => "rwho -a",
      maxidle     => 60,  # Maximal # Minuten idle
      update      => 60, # Update nach # Sekunden
      );


#################################################################
#  Globale Variablen

my %globalconf;

my $scaletime = 0;
my $scalepos = 0;
my $updateseconds;

#################################################################
#  Widgets

my $rwho_textfield;
my $top;
my $tooltip;
my $scale;


#################################################################
#  Initialisierung von TK (Fenster bauen und so

sub init_tk {
    $top = MainWindow->new;
    $top -> title($globalconf{windowtitle});
    $rwho_textfield = $top -> Scrolled("Text",
				       -relief      => "sunken",
				       -borderwidth => 2,
				       -setgrid     => "true",
				       -scrollbars  => "osoe",
				       -wrap        => "none",
				       -state       => "disabled",
				       -font        => $globalconf{font},
				       -cursor      => "top_left_arrow");

    $rwho_textfield -> pack(-expand => 1,
			    -fill => 'both');

    $rwho_textfield -> tag("configure", "title", 
			   "-font" => $globalconf{titlefont})
	if (defined($globalconf{titlefont}));

    $rwho_textfield -> tag("configure", "title", 
			   "-foreground" => $globalconf{titlefg})
	if (defined($globalconf{"titlefg"}));

    $rwho_textfield -> tag("configure", "title", 
			   "-background" => $globalconf{titlebg})
	if (defined($globalconf{"titlebg"}));

    $rwho_textfield -> tag("configure", "console", 
			   "-font" => $globalconf{consolefont})
	if (defined($globalconf{consolefg}));

    $rwho_textfield -> tag("configure", "console", 
			   "-foreground" => $globalconf{consolefg})
	if (defined($globalconf{"consolefg"}));

    $rwho_textfield -> tag("configure", "console", 
			   "-background" => $globalconf{consolebg})
	if (defined($globalconf{"consolebg"}));

    $tooltip = $top->Balloon();
    $tooltip->configure(-font => $globalconf{tooltipfont}) 
	if (defined($globalconf{tooltipfont}));
    
    $scale = $top->Scale(-from        => 0,
  			 -to          => 100,
  			 -variable    => \$scalepos,
  			 -showvalue   => 0,
  			 -width       => 10,
  			 -orient      => "horizontal",
  			 -borderwidth => 1,
  			 -state       => "disabled");
    $scale -> pack(-expand => 0,
		   -fill   => 'x',
		   -side   => 'bottom');

    $top -> geometry($globalconf{geometry});
}


################################################################# 
#  Gibt true oder false (bzw 1 oder 0) zurück, wenn einer von 
#  den keys vom übergebenen Hash eine Konsole ist. Der (das?) 
#  Hash sollte als Referenz übergeben werden.
sub host_has_console {
    for (keys(%{$_[0]})) {
	if (/console|tty[0-9]|:[0-9]|sunray/) {
	    return 1;
	}
    }
    return 0;
}


################################################################# 
#  Gibt eine sortierte Liste der Hostnames zurück. Erwartet 
#  wird eine Referenz auf einen Hash mit den Hostnames als key, 
#  und den ttys (inkl. idletimes) als Werten.
#  Sortiert wird zunächst nach Konsole und dann nach idle-time.
sub sort_hosts {
    my @ret_val = ();
    my %hosts = %{$_[0]};
    @ret_val = sort {
	my $a_has_cons = host_has_console(\%{$hosts{$a}});
	my $b_has_cons = host_has_console(\%{$hosts{$b}});
	if ($a_has_cons != $b_has_cons) {
	    $b_has_cons - $a_has_cons;
	} else {
	    my $a_idle = 5999; # Maximale Idletime
	    my $b_idle = 5999;
	    for (keys(%{$hosts{$a}})) {
		if ($hosts{$a}{$_}{"idle"} < $a_idle) {
		    $a_idle = $hosts{$a}{$_}{"idle"};
		}
	    }
	    for (keys(%{$hosts{$b}})) {
		if ($hosts{$b}{$_}{"idle"} < $b_idle) {
		    $b_idle = $hosts{$b}{$_}{"idle"};
		}
	    }
	    $a_idle - $b_idle;
	}
    } keys(%hosts);
    return @ret_val;
}


#################################################################
#  Gibt eine Liste zurück mit den Sortieten ttys. Sortiert wird
#  zunächst danach, ob eine Konsole vorhanden ist, und dann nach 
#  der Idle-Time. Erwartet wird eine Referenz auf eine Hash, wo
#  die ttys mit den jeweiligen Idletimes drinstehen.
sub sort_ttys {
    # Gibt liste zurück mit sortierten ttys.
    # Will die ttys mit zugehörigen idles usw. haben (hash)
    my %ttys = %{$_[0]};
    my @ret_val = sort {
	my $a_is_cons = ($a =~ /console|tty[0-9]|:[0-9]|sunray/);
	my $b_is_cons = ($b =~ /console|tty[0-9]|:[0-9]|sunray/);
	if ($a_is_cons == $b_is_cons) {
	    $ttys{$a}{"idle"} - $ttys{$b}{"idle"};
	} else {
	    $b_is_cons - $a_is_cons;
	}
    } keys(%ttys);
    return @ret_val;
}


#################################################################
#  Gibt ein schönes grosses Konstrukt zurück, in dem die 
#  rwho-Ausgabe aufbereitet wurde.
#  Erwartet wird ein String mit dem rwho-Befehl.
#  Rückgabe: 
#  Hash (
#    Key:   Username
#    Value: Hash (
#             Key:   Hostname
#             Value: Hash (
#                      Key:   tty
#                      Value: Hash (
#                               Key: "idle"      Value: idletime
#                               Key: "logintime" Value: logintime
#                             )
#                    )
#           )
#  )
sub read_rwho {
    my ($user, $where, $rechner, $pty, $month, $day, $logintime, $idle);
    my %logged_in;
    my %user_logged_in;
    if (!open(RWHO, "{ " . $_[0] . " ; } < /dev/null |")) {
	# Fehler beim öffnen. Warum?!?
	print "Error while executing " . $_[0] . "\n";
	print "Please report this bug to hjficker\@tzi.de\n";
	return %logged_in;
    }
    while (<RWHO>) {
	($user, $where, $month, $day, $logintime, $idle) = split;
	
	$rechner = $where;
	$rechner =~ s/^([^:]*):(.*)$/$1/;
	$pty = $where;
	$pty =~ s/^([^:]*):(.*)$/$2/;

	if (!defined($idle)|| $idle eq "") {
	    $idle = 0;
	} else {
	    # Umwandeln in Minuten
	    my ($h, $m) = split(/:/, "0$idle");
	    $idle = $h*60+$m;
	}

	# Bug bei rwho: Idle-time von -1
	#  Dann sind leute wirklich zu lange idle. => Wech
	if ($idle == -1) {
	    next;
	}

	if (!defined($logged_in{$user})) {
	    $logged_in{$user}={};
	}
	if (!defined($logged_in{$user}{$rechner})) {
	    $logged_in{$user}{$rechner} = {};
	}
	$logged_in{$user}{$rechner}{$pty} = 
	    {"logintime" => "$month $day $logintime",
	     "idle"      => $idle};
    }
    close(RWHO);
    return %logged_in;
}


#################################################################
#  Liest die Konfigurationsdatei, die übergeben wird, ein, und
#  gibt ein Konstrukt mit der Konfiguration zurück.
#  Rückgabe ist:
#  Array von Hash (
#              Key: "user"   Value: Username
#              Key: "title"  Value: Titel, unter dem dieser Name erscheint
#              Key: sonstwas Value: Sonstwas (zusätzliche Konf)
#            )
#  Ganz nebenbei wird noch die Globalconf geschrieben.
sub read_conf {
    %globalconf = %init_globalconf;
    open(CONF, "<" . $_[0]) || die "Cannot open $_[0]\n";
    
    my @conf = ();
    my $titel = "";
    while (<CONF>) {
	chomp;
	s/\#.*$//;
	s/^ *(.*) *$/$1/;

	if ($_ eq "") { next }; # Leerzeile, nur Kommentar...
	
	if (m/^\[.*\]$/) {
	    # "[ irgendwas ]" gefunden -> Titel
	    s/^\[(.*)\]/$1/;
	    $titel = $_;
	    next;
	}
	
	# Ansonsten irgendein Leut.
	my $wer = $_;
	$wer =~ s/(^[^ ]*).*$/$1/;
	my %thisconf = ( "user" => $wer, "title" => $titel );
	if (m/\{$/) {
	    # Extra-Conf
	    while (<CONF>) {
		chomp;
		s/\#.*$//;
		s/^ *(.*) *$/$1/;
		if ($_ eq "") { next; }
		if ($_ eq "}") { last; } # Klammer wieder zu
		
		# Jetzt erwarten wir bla=fasel
		my $l = $_;
		$l =~ s/([^ =]*) *=.*/$1/;
		my $r = $_;
		$r =~ s/[^=]*= *(.*)$/$1/;
		
		$thisconf{$l} = $r;
	    }
	}
	if ($wer eq "CONF") {
	    # Hack, Configuration
	    %globalconf = (%globalconf, %thisconf);
	} else {
	    @conf = (@conf, \%thisconf);
	}
    }
    close(CONF);
    $updateseconds = $globalconf{"update"} / 10;
    if ($updateseconds < 2) {
	$updateseconds = 2;
    } 
    elsif ($updateseconds > 10) {
	$updateseconds = 10;
    }
    return @conf;
}


#################################################################
#  Schreiben des Fensters
#  ganz böse TK-Hackerei.
sub update_text {
    my %logged_in = %{$_[1]};
    my @conf = @{$_[0]};
    my $prev_title = "";

    my $tag_no = 0;

    $rwho_textfield->configure(-state => "normal");

    $rwho_textfield->delete("1.0", "end");

    my $thisconf;

    for $thisconf (@conf) {
	my $user = $$thisconf{"user"};
	if (!defined($logged_in{$user})) {
	    next; # Nicht da...
	}
	my %hosts = %{$logged_in{$user}};

	for (keys(%hosts)) {
	    if (defined($$thisconf{"hosts"})) {
		my $re = $$thisconf{"hosts"};
		if (!($_ =~ /$re/)) {
		    # Diesen host wollen wir nicht.
		    delete $hosts{$_};
		    next;
		}
	    }
	    
	    if (defined($$thisconf{"maxidle"}) || 
		defined($globalconf{"maxidle"})) {
		my $minidle = 5999; #Maximales idle überhaupt
		my %ttys = %{$hosts{$_}};
		for (keys(%ttys)) {
		    if ($ttys{$_}{"idle"} < $minidle) {
			$minidle = $ttys{$_}{"idle"};
		    }
		}
		if (defined($$thisconf{"maxidle"})) {
		    if ($minidle > $$thisconf{"maxidle"}) {
			delete $hosts{$_};
			next;
		    }
		} else {
		    if ($minidle > $globalconf{"maxidle"}) {
			delete $hosts{$_};
			next;
		    }
		}
	    }
	}
	
	if (keys(%hosts) == 0) { 
	    next; # Diese Rechner wollten wir nicht... -> Weiter
	}
	
	# So, User haben wir.
	# Titel schon ausgegeben?
	if ($prev_title ne $$thisconf{"title"}) {
	    # Nee, also noch tun.
	    $rwho_textfield->insert("end", $$thisconf{"title"} . "\n", "title");
	    $prev_title = $$thisconf{"title"};
	}
	# User ausgeben...
	my $str = sprintf("%-9s", $user);
	$rwho_textfield->insert("end", $str);
	for (sort_hosts(\%hosts)) {
	    if (host_has_console($hosts{$_})) {
		$rwho_textfield->insert("end", $_ . " ", "console");
	    } else {
		$rwho_textfield->insert("end", $_ . " ");
	    }
	}
	
	if (defined($$thisconf{font}) || 
	    defined($$thisconf{fg}) ||
	    defined($$thisconf{bg})) {

	    $rwho_textfield->tag("configure", "tag" . $tag_no,
				 -font => $$thisconf{font}) 
		if (defined($$thisconf{font}));
	    
	    $rwho_textfield->tag("configure", "tag" . $tag_no,
				 -foreground => $$thisconf{fg}) 
		if (defined($$thisconf{fg}));
	    
	    $rwho_textfield->tag("configure", "tag" . $tag_no,
				 -background => $$thisconf{bg}) 
		if (defined($$thisconf{bg}));

	    $rwho_textfield->tag("add", "tag" . $tag_no, 
				 "end - 1 line linestart", 
				 "end - 1 line lineend");
	    $tag_no ++;
	}
	
	$rwho_textfield->insert("end", "\n");
    }

    $rwho_textfield->configure(-state => "disabled");
}



my @conf;
if (@ARGV != 0) {
    $conf_filename = $ARGV[0];
}

@conf = read_conf($conf_filename);


sub sig_handler {
    print "SIG$_[0] caught";
    if ($_[0] eq "HUP") {
	print " --> reread configuration\n";
	@conf = read_conf($conf_filename);
	$scaletime=$globalconf{"update"};
    } else {
	print "\n";
	$scaletime=$globalconf{"update"};
    }
}


$SIG{"HUP"} = \&sig_handler;
$SIG{"USR1"} = \&sig_handler;
    
init_tk();    

my %rwho_data;

my $msg = "";
my @thisword = ("", "");
my @lastword = ("", "");

$tooltip->attach($rwho_textfield, 
		 -balloonposition => "mouse",
		 -msg => \$msg,
		 -postcommand => sub {
		     if ($thisword[0] eq $thisword[1]) {
			 0;
		     } else {
			 my $t = $rwho_textfield;
			 # User herausfinden... steht vorne
			 my $user = 
			     $t->get($t->index("$thisword[0] linestart"),
				     $t->index("$thisword[0] linestart wordend"));
			 my $rechner = $t->get($thisword[0], $thisword[1]);
			 
			 $msg = "";
			 if (! defined($rwho_data{$user}{$rechner})) {
			     return 0;
			 }
			 my %ttys = %{$rwho_data{$user}{$rechner}};
			 $msg = "Logins of $user at $rechner";
			 for (sort_ttys(\%ttys)) {
			     $msg = $msg . sprintf("\n%-8s%-13s%5d", 
						   $_,
						   $ttys{$_}{"logintime"},
						   $ttys{$_}{"idle"});
			 }
			 my $x = $rwho_textfield->pointerx;
			 my $y = $rwho_textfield->pointery;
			 "\@$x,$y";
		     }
		 },
		 -motioncommand => sub {
		     my $x = $rwho_textfield->pointerx-$rwho_textfield->rootx;
		     my $y = $rwho_textfield->pointery-$rwho_textfield->rooty;
		     @thisword = ($rwho_textfield->index("\@$x,$y wordstart"),
				  $rwho_textfield->index("\@$x,$y wordend"));
		     if ($thisword[0] eq $lastword[0] &&
			 $thisword[1] eq $lastword[1]) {
			 0;
		     } else {
			 @lastword = @thisword;
			 ;
		     }
		 });



$top->after(500, 
	    sub{
		$rwho_textfield->Busy;
		%rwho_data = read_rwho($globalconf{command});
		update_text(\@conf, \%rwho_data); 
		$rwho_textfield->Unbusy;
	    });


$top->repeat($updateseconds * 1000,
			sub {
			    $scaletime += $updateseconds;
			    $scalepos = 100 * $scaletime 
					    / $globalconf{"update"};
			    if ($scaletime >= $globalconf{"update"}) {
				$rwho_textfield->Busy;
				%rwho_data = read_rwho($globalconf{command});
				update_text(\@conf, \%rwho_data); 
				$scaletime = 0;
				$scalepos = 0;
				$rwho_textfield->Unbusy;
			    }
			});

MainLoop();

#################################################################
#  Changelog:
#  $Log: tkleute,v $
#  Revision 1.7  2001/06/07 20:51:56  hjficker
#  Fehlerbehandlung
#
#  Revision 1.6  2000/12/01 13:34:15  hjficker
#  Sortierung nach sunrays
#
#  Revision 1.5  2000/11/29 20:40:54  hjficker
#  sunrays implementiert
#
#  Revision 1.4  2000/11/15 21:37:45  hjficker
#  Probleme bei änderung von Update-Time behoben
#
#  Revision 1.3  2000/06/06 14:31:13  hjficker
#  Zeit wird bei SIGHUP und SIGUSR1 zurückgesetzt.
#
#  Revision 1.2  2000/04/14 13:06:07  hjficker
#  - Cursor geändert
#  - Busy beim read_rwho und update_text
#
#  Revision 1.1  2000/04/14 12:12:38  hjficker
#  Initial revision
#
#