#!/usr/bin/perl
#
# $0 - replacement xdm host chooser for the Fraunhofer ITWM
#
# Copyright (c) 2007 by Christian Peter <christian.peter@itwm.fraunhofer.de>
#
# usage:
# see Xorg xdm documentation
#
# v1.4, Christian Peter, 2008-01-22
# - improvements in advanced mode:
#   input sanitizing, filter host list according to server availability,
#   improved feedback
# - honor "return" key for data entry in advanced and expert mode
# - fixed bug in Login(): advanced mode did not work
# - buttons now optional
# v1.3, Christian Peter, 2008-01-21
# - support for chooser configuration file
# v1.2, Christian Peter, 2008-12-14
# - script is now configurable
# - adapted script for SLES9 operating system
# v1.1, Christian Peter, 2007-11-27
# - proof of concept implementation
#

use Tk;
use Tk::NoteBook;

# not available on SLES9
#use Net::IP;

my $config_file="/opt/yass/etc/chooser.cfg";

# read the configuration file
do "$config_file";

my $version="1.4";
my $date="2008-01-22";



#
# no user-serviceable parts below!
#

sub CheckEntry {
# check for illegal characters in user entry
	$_=shift;
	my $count = tr/A-Za-z0-9//c;
#	printf "debug: string \"$_\" count $count\n";
	if ($count > 0) {
		# illegal character(s) found
		return 1;
	} else {
		# check passed
		return 0;
	}
}

sub PopulateHosts {
# find & show all available terminal servers for this user

	# clear current list of hosts
	$list -> delete (0,'end');

	# sanitize user input
	if (CheckEntry $account) {
		$status="Illegal character in user name.";
		$statusbar->configure(-foreground=>"red");
#		$tab2status->configure (text=>"Illegal character in user name.",foreground=>"red");
#		$status->configure(-text=>"illegal character",-foreground=>"red");
#		printf "debug: invalid character in account name.\n";
		return 1;
	}

	# this might take a few seconds. change cursor shape.
	$mw->configure(cursor=>['watch','black','white']);

	# find available hosts for this user
	my @hosts = `$loginservers_bin $account`; my $result=$?;

	# restore default cursor
	$mw->configure(cursor=>['top_left_arrow','white','black']);

	if ($result != 0) {
		$status="Could not retrieve list of valid login hosts for your account.";
		$statusbar->configure(-foreground=>"red");
#		my $text = "Could not retrieve list of valid login hosts for your account.\n";
#		my $w = $mw -> messageBox (-icon=>"error",-type=>"ok",-title=>"Error",-text=>$text);
		return;
	}

	if (scalar(@hosts) == 0) {
		$status="No valid login hosts for this account.";
		$statusbar->configure(-foreground=>"red");
#		print "debug: no login hosts for this account\n";
#		my $text = "No valid login hosts for this account.";
#		my $w = $mw -> messageBox (-icon=>"error",-type=>"ok",-title=>"Error",-text=>$text);
		return;
	}

	$statusbar->configure(-foreground=>"black");
	$status="Select a host from the list, then click \"Login\".";

	# fill list widget
	while (scalar(@hosts)) {
		my $h = shift (@hosts);
		chomp($h);
		$list -> insert ('end',$h);
	}

}

sub SupportSend {
# Send email to IT support
	print "from $from subject $subject terminal $terminal\n";
	print "$body\n";
	system ("echo -- \"$body\" | mail -s \"$subject\" $support_mailto");
}

sub Support {
# Create email to IT support
	if (Exists($sw)) {
		$sw -> deiconify();
		$sw -> raise();
		return;
	}
	
#	$terminal=$ENV{'DISPLAY'};

	my $sw = $mw -> Toplevel(-title => "Support Request");
#	my $label = $sw -> Label (-text => "Mail to Support") -> pack();

	my $label = $sw -> Label (-text => "Send an email to IT support...") -> pack(-pady=>10,-anchor=>"w");

	my $f3 = $sw -> Frame() -> pack(-anchor=>"w");
	my $f1 = $f3 -> Frame() -> pack(-side=>"left");
	my $f2 = $f3 -> Frame() -> pack(-side=>"left");

	my $fromText = $f1 -> Label (-text => "From:") -> pack(-anchor=>"w");
	my $fromEntry = $f2 -> Entry (-textvariable => \$from) -> pack();

	my $subjectText = $f1 -> Label (-text => "Subject:") -> pack(-anchor=>"w");
	my $subjectEntry = $f2 -> Entry (-textvariable => \$subject) -> pack();

#	my $f3 = $sw -> Frame() -> pack(-anchor=>"w");
	my $terminalText = $f1 -> Label (-text => "Terminal:") -> pack(-anchor=>"w");
	my $terminalEntry = $f2 -> Entry (-textvariable => \$terminal, -state =>"disabled") -> pack();

	my $textEntry = $sw -> Text(-width=>60,-height=>12) -> pack(-pady=>10);
	$textEntry->Insert("This could be an embedded support request form.\nIt does not work yet.\n");
	
#	print "support";
	my $bottomFrame = $sw -> Frame() -> pack();
	my $buttonLogin = $bottomFrame -> Button (-text => "Submit", -command => sub {
	 $textEntry->selectAll; $body=$textEntry->getSelected;
	 SupportSend }) -> pack(-side => "left");
#	my $buttonCancel = $bottomFrame -> Button (-text => "Cancel", -command => [$sw => 'destroy']) -> pack(-side => "left");
	my $buttonCancel = $bottomFrame -> Button (-text => "Cancel", -command => sub { $sw->withdraw}) -> pack(-side => "left");

	#$sw -> bind('<Key-Escape>', $buttonCancel->invoke);
}

sub Help {
# Show help window for this chooser
	my $hw = $mw -> Toplevel(-title => "Help");
	my $helpText = $hw -> Text(-width=>80,-height=>10) -> pack();
	my $buttonClose = $hw -> Button (-text => "Close", -command => [$hw => 'destroy']) -> pack();
	
	$helpText->Insert("Your help text here.\n");
#	$helpText->config(state=>"readonly");
}

sub Login {
# Select server and end chooser process
#
#
#	print "server $server\n";
	my $h=$server;

	# are we in "Advanced" tab?
	# if so, set server to currently selected list entry
	if ( $nb->info("active") eq "nb2") {
#		print "debug: in advanced tab.\n";
		if ( $list->curselection eq "" ) {
			# no host selected? abort!
			return 1;
			print "debug: advcanced 1a\n";
        	} else {
# 			print "debug: cursel1 \"" . $list->get($list->curselection) . "\"\n";
 			$h=$list->get($list->curselection);
# 			print "debug: cursel2 \"" . $list->get($list->curselection) . "\"\n";
			print "debug: selected list entry \"$h\".\n";
		}
#		print "debug: advanced 2.\n";
	};

	if (length($h)==0) {
		# no server selected yet? ask the scheduler!

		print "debug: invoking scheduler...\n";
		$h=`$scheduler_bin choose $terminal`;
		if ($? != 0) {
			print "error: scheduler return code $?.\n";
		}
		chop($h);
		print "debug: scheduler returned server \"$h\"\n";

		if (length($h)==0) {
			my $text = "Could not find a login server for your terminal.\nYou can manually select a login host in advanced mode.\n";
			my $w = $mw -> messageBox (-icon=>"error",-type=>"ok",-title=>"Error",-text=>$text);
			return;
		}
	}
	
	print "debug: instructing XDM: @ARGV\n";
	system("$xdminstruct_bin -selecthost $h @ARGV");

	print "debug: logging handover of terminal $terminal to X11 server $h...\n";
	system("$scheduler_bin handover $terminal $h");

	print "debug: exiting.\n";
	exit 0;
}


sub ServerCheck {
	my $status;

	if (CheckEntry $server) {
		$serverCheck->configure(-text=>"illegal character",-foreground=>"red");
#		printf "debug: invalid character in server name.\n";
		return 1;
	}

	print "debug: checking X11 server \"$server\"\n";
	if (length($server)==0) {
		$serverCheck->configure(-text=>"no server given",-foreground=>"red");
		return 1;
	}
	$a=`/usr/bin/host $server`;
	if ($? != 0) {
		# well "host" returns 1 on SUSE 10.1 hosts
		# it returns 0 on SLES 9
		$serverCheck->configure(-text=>"no such host",-foreground=>"red");
		return 1;
	} else {
		print "debug: xdmping to server \"$server\".\n";
		# this might take a few seconds. change cursor shape.
		$mw->configure(cursor=>['watch','black','white']);
		$a=`$xdmping_bin $server`;
		$status=$?;
		# restore default cursor
		$mw->configure(cursor=>['top_left_arrow','white','black']);
		print "debug: xdmping returned status $status\n";
		if ($status == 0) {
			$serverCheck->configure(-text=>"ok",-foreground=>"green");
			return 0;
		} elsif ($status == 32256) {
			$serverCheck->configure(-text=>"unknown",-foreground=>"yellow");
			return 0;
		} elsif ($status == -1) {
			# e.g. "xdmping" binary not found
			$serverCheck->configure(-text=>"unknown",-foreground=>"yellow");
			return 0;
#		} elsif ($status == 256) {
#			$serverCheck->configure(-text=>"no such host",-foreground=>"red");
#			return 1;
		} else {
			$serverCheck->configure(-text=>"unwilling",-foreground=>"red");
			return 2;
		}
	}
}

sub DecodeTerminal {
# set $termina global variable by parsing our command line arguments

	print "error: fixme: using dummy client address data.\n";	
	my $address="0a88117c";
	my $string;

# requires NET::Ip
#	$terminal=ip_bintoip($address,4);

	$string="";
	for ($x=1; $x <= 4; $x=$x+1) {
		$byte=hex substr $address,0,2;
		substr($address,0,2)="";
#		print "debug: byte \"$byte\"\n";
		$string=$string . $byte . ".";
	}
	chop $string;

#	print "debug: decoded terminal address \"$address\" to IP \"$string\".\n";
	return $string;
}




our $mw = new MainWindow;
$mw->optionAdd('*BorderWidth' => 1);

# set main window size and screen position
# see http://cpan.uwinnipeg.ca/htdocs/Tk/Tk/Wm.html
#$mw->geometry("800x600+200+200");

# see cursorfont.h for available cursor shapes
$mw->configure(cursor=>['top_left_arrow','white','black']);
#$mw->configure(cursor=>['watch','red',blue]);

my $label = $mw -> Label(-text=>"Fraunhofer ITWM - Linux Login Chooser") -> pack(-pady=>20);




our $nb = $mw -> NoteBook() -> pack();
my $tab1 = $nb -> add('nb1',-label=>"Basic",-raisecmd=>sub {$status="Click the penguin or \"Login\" for automatic login host selection.";});
my $tab2 = $nb -> add('nb2',-label=>"Advanced",-raisecmd=>sub {$status="Enter your account name to show a list of possible login hosts.";});
my $tab3 = $nb -> add('nb3',-label=>"Expert",-raisecmd=>sub {$status="Enter your preferred X11 terminal server."});

$mw -> Photo ("img1",-file=>$image1_file);
$mw -> Photo ("img2",-file=>$image2_file);
$mw -> Photo ("img3",-file=>$image3_file);

my $tab1img = $tab1 -> Button(-image=>"img1",-command=>\&Login)->pack(-anchor=>"center",-pady=>"20");

my $tab2img = $tab2 -> Label(-image=>"img2")->pack(-side=>"left");
#our $list = $tab2 -> Listbox (-selectmode => single,-height=>16) -> pack(-side=>"right");
our $list = $tab2->Scrolled(Listbox,-height=>16,-scrollbars=>'e') ->pack(-side=>"right");
$list->bind("<Double-Button-1>",\&Login);
my $tab2midframe = $tab2 -> Frame() -> pack(-side=>"right");
my $accountField = $tab2midframe -> Entry (-width => 8, -textvariable => \$account,-validate=>"focusout",-validatecommand=>\&PopulateHosts) -> pack(-side => "right");
$accountField->bind("<KeyPress-Return>",\&PopulateHosts);
my $accountLabel = $tab2midframe -> Label (-text => "Account") -> pack(-side => "right");
#our $tab2status = $tab2midframe -> Label() -> pack(-side=>"bottom");


our $server;

my $tab3img = $tab3 -> Label(-image=>"img3")->pack(-side=>"left");
my $expertFrame = $tab3 -> Frame() -> pack(-anchor=>"center");
$expertFrame->Label(-text=>"Terminal")->pack(-side=>"left");
$expertFrame->Entry(-text=>\$terminal,-state=>"disabled")->pack(-side=>"left");

my $serverLabel = $tab3 -> Label (-text => "Server") -> pack(-side=>"left");
my $serverEntry = $tab3 -> Entry (-textvariable=>\$server,-width=>20,-validate=>focusout,-validatecommand=>\&ServerCheck)->pack(-side=>"left");
$serverEntry->bind("<KeyPress-Return>",\&ServerCheck);
our $serverCheck = $tab3 -> Label () -> pack (-side=>"left");

our $status="Yass chooser $version ($date) - Copyright (c) 2007 by Christian Peter";

#my $statusbar = $mw ->Label(-text=>"Test");
our $statusbar = $mw ->Entry(-textvariable=>\$status,-state=>"disabled",-width=>80) -> pack();

my $bottomFrame = $mw -> Frame() -> pack(-pady=>25);

my $buttonLogin = $bottomFrame -> Button (-text => "Login", -command => sub { Login }) -> pack(-side => "left");
if ($showbutton_cancel) {
	my $buttonCancel = $bottomFrame -> Button (-text => "Cancel", -command => sub { exit 1 }) -> pack(-side => "left");
}
if ($showbutton_help) {
	my $buttonHelp = $bottomFrame -> Button (-text => "Help", -command => sub { Help }) -> pack(-side => "left");
}
if ($showbutton_support) {
	my $buttonSupport = $bottomFrame -> Button (-text => "Support", -command => sub { Support }) -> pack(-side => "left");
}
if ($showbutton_failsafe) {
	my $buttonFailsafe = $bottomFrame -> Button (-text => "Failsafe", -command => sub { exec("$failsafechooser_bin @ARGV"); }) -> pack(-side=>"left");
}



# set X11 terminal IP/host name
our $terminal=$ENV{'DISPLAY'};
if (length($terminal)==0) {
	print "error: environment variable DISPLAY is empty.\n";
	# we could determine terminal IP by parsing our command line...
	# $terminal=DecodeTerminal;
}

print "debug: arguments @ARGV\n";
print "debug: chooser handling terminal \"$terminal\".\n";
print "debug: logging idle client status...\n";

system("$scheduler_bin idle $terminal");

MainLoop;

system("$scheduler_bin exiting $terminal");
