implement WmLogon;
# ask some questions, runs a shell script to do something with
# the answers, and run wm/toolbar.
#
# e.g.
# auth/factotum
# wm/wm genlogon {
# 	load std
# 	cd /usr/$user || raise 'no home directory'
# 	crypt -d -k $password < /keyring/factotum.cr | getlines {echo $line} > /mnt/factotum/ctl || raise 'no way'
# }

# next steps:
# 	proto/infauth could ask for a key and then go and get
#	the actual key a la getauthinfo from a logon server.
#	this doesn't fit very nicely into the factotum model.

# would be nice to have
#	sys->fd2chan; fn(): (ref FD, ref FileIO);

include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Screen, Display, Image, Context, Point, Rect: import draw;
include "tk.m";
	tk: Tk;
include "tkclient.m";
	tkclient: Tkclient;
include "string.m";
	str: String;
include "env.m";
	env: Env;
include "sh.m";
	sh: Sh;
include "fdrun.m";
include "arg.m";

WmLogon: module {
	init:	fn(ctxt: ref Draw->Context, argv: list of string);
};

Field: adt {
	name: string;
	value: string;
	secret: int;
	entry: string;
};

cfg := array[] of {
	"label .p -bitmap @/icons/inferno.bit -borderwidth 2 -relief raised",
	"frame .f -borderwidth 2 -relief raised",
	"pack .p .f -fill x",
};

username: string;

init(ctxt: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	sh = load Sh Sh->PATH;
	str = load String String->PATH;
	env = load Env Env->PATH;
	tkclient = load Tkclient Tkclient->PATH;
	if(tkclient == nil){
		sys->fprint(stderr(), "logon: cannot load %s: %r\n", Tkclient->PATH);
		raise "fail:bad module";
	}
	tkclient->init();
	sys->pctl(sys->NEWPGRP, nil);
	if(ctxt == nil)
		sys->fprint(stderr(), "logon: must run under a window manager\n");
	(ctlwin, nil) := tkclient->toplevel(ctxt, nil, nil, Tkclient->Plain);
	if(sys->fprint(ctlwin.ctxt.connfd, "request") == -1){
		sys->fprint(stderr(), "logon: must be run as principal wm application\n");
		raise "fail:lack of control";
	}

	fields: list of ref Field;
	wmcmd: string;
	arg := load Arg Arg->PATH;
	arg->init(args);
	arg->setusage("usage: logon [-q field defaultvalue]... [-Q field]... command [arg...]]\n");
	while((opt := arg->opt()) != 0){
		case opt{
		'q' =>
			f := ref Field;
			f.name = arg->earg();
			f.value = arg->earg();
			f.secret = 0;
			fields = f :: fields;
		'Q' =>
			f := ref Field;
			f.name = arg->earg();
			f.secret = 1;
			fields = f :: fields;
		'u' =>
			username = arg->earg();
		'w' =>
			wmcmd = arg->earg();
		* =>
			arg->usage();
		}
	}
	if(fields == nil)
		fields = ref Field("user", getuser(), 0, nil) :: ref Field("password", nil, 1, nil) :: nil;
	else
		fields = rev(fields);
	args = arg->argv();
	arg = nil;

	if(wmcmd == nil)
		wmcmd = "wm/toolbar";
	if(args == nil)
		arg->usage();

	for(;;){
		(panel, cmd) := makepanel(ctxt, fields);
		spawn tkclient->handler(panel, stop := chan of int);
		<-cmd;
		for(f := fields; f != nil; f = tl f){
			(hd f).value = tkcmd(panel, (hd f).entry+" get");
			env->setenv((hd f).name, str->quoted((hd f).value :: nil));
		}

		spawn logon(result := chan of string, ctxt, args);
		e := <-result;
		panel = nil;
		stop <-= 1;
		if(e == nil)
			break;
	}

	tkclient->wmctl(ctlwin, "endcontrol");
	ctlwin = nil;

	# hide secrets, assuming they haven't already escaped.
	for(f := fields; f != nil; f = tl f){
		if((hd f).secret){
			(hd f).value = nil;
			env->setenv((hd f).name, nil);
		}
	}
	sh->run(ctxt, wmcmd :: nil);
}

makepanel(ctxt: ref Draw->Context, fields: list of ref Field): (ref Tk->Toplevel, chan of string)
{
	(t, nil) := tkclient->toplevel(ctxt, "-bg silver", nil, Tkclient->Plain);

	cmd := chan of string;
	tk->namechan(t, cmd, "cmd");

	for(i := 0; i < len cfg; i++)
		tkcmd(t, cfg[i]);
	n := 0;
	for(f := fields; f != nil; f = tl f){
		n++;
		l := ".f.l"+string n;
		tkcmd(t, "label "+l+" -anchor w -text '" + (hd f).name);
		e := ".f.e"+string n;
		tkcmd(t, "entry "+e+" -bg white");
		if((hd f).secret){
			tkcmd(t, e+" configure -show *");
			(hd f).value = nil;
		}else
			tkcmd(t, e+" insert 0 '"+(hd f).value);
		tkcmd(t, "grid "+l+" "+e+" -sticky e");
		tkcmd(t, "bind "+e+" {<Key-\n>} {focus next}");
		tkcmd(t, "bind "+e+" {<Key-\t>} {focus next}");
		(hd f).entry = e;
	}
	tkcmd(t, "bind .f.e"+string n+" {<Key-\n>} {send cmd ok}");
	tkcmd(t, "focus "+(hd fields).entry);
	tkcmd(t, (hd fields).entry+" selection range 0 end");
	tkcmd(t, "update");
	org: Point;
	ir := tk->rect(t, ".", Tk->Border|Tk->Required);
	org.x = t.screenr.dx() / 2 - ir.dx() / 2;
	org.y = t.screenr.dy() / 3 - ir.dy() / 2;
	if (org.y < 0)
		org.y = 0;
	tkcmd(t, ". configure -x " + string org.x + " -y " + string org.y);
	tkclient->startinput(t, "kbd" :: "ptr" :: nil);
	tkclient->onscreen(t, "onscreen");
	return (t, cmd);
}

logon(result: chan of string, ctxt: ref Draw->Context, argv: list of string)
{
	sys->pctl(Sys->NEWPGRP, nil);
	sys->bind("#s", "/chan", Sys->MBEFORE);
	fio := sys->file2chan("/chan", "stderrfile");
	fds := array[2] of {* => sys->open("/chan/stderrfile", Sys->OWRITE)};
	spawn runlogon(ctxt, argv, fds, lresult := chan[1] of string);
	fds = nil;
	(nil, d, stdoutfid, wc) := <-fio.write;
	wc <-= (0, nil);
	t: ref Tk->Toplevel;
	stop := chan of int;
	button := chan of string;
	fid: int;
loop:
	for(;;)alt{
	(nil, nil, nil, rc) := <-fio.read =>
		if(rc != nil)
			rc <-= (nil, nil);
	(nil, d, fid, wc) = <-fio.write =>
		if(wc == nil)
			break loop;
		if(t == nil){
			(t, nil) = tkclient->toplevel(ctxt, "-borderwidth 2 -relief raised", nil, Tkclient->Plain);
			tk->namechan(t, button, "button");
			tkcmd(t, "text .t -yscrollcommand {.s set} -bg #dddddd");
			tkcmd(t, "scrollbar .s -orient vertical -command {.t yview}");
			tkcmd(t, "button .b -text {Stop} -command {send button b}");
			tkcmd(t, "pack .s -side right -fill y");
			tkcmd(t, "pack .t -side top -fill x -expand 1");
			tkcmd(t, ".t tag configure e1 -foreground #bbbbbb");
			tkcmd(t, "pack .b -side top -anchor e");
			tkcmd(t, "pack propagate . 0");
			centre(t);
			tkclient->onscreen(t, "onscreen");
			tkclient->startinput(t, "kbd"::"ptr"::nil);
			tkcmd(t, "focus .b");
			spawn tkclient->handler(t, stop);
		}
		tkcmd(t, ".t insert end "+tk->quote(string d)+" e"+string (fid == stdoutfid));
		tkcmd(t, "update");
		wc <-= (len d, nil);
	<-button =>
		sys->fprint(sys->open("/prog/"+string sys->pctl(0, nil)+"/ctl", Sys->OWRITE), "killgrp");
		if(t != nil)		# we've killed handler, so start it again... (how much of a hack is this?)
			spawn tkclient->handler(t, stop);
		break loop;
	}

	if(t != nil){
		tkcmd(t, ".b configure -text {Continue}");
		tkcmd(t, "update");
		<-button;
		stop <-= 1;
	}
	alt{
	r := <-lresult =>
		result <-= r;
	* =>
		result <-= "login aborted";
	}
}

runlogon(ctxt: ref Draw->Context, argv: list of string, fds: array of ref Sys->FD, result: chan of string)
{
	sys->fprint(fds[0], "stdout");	# let other end know which fid represents stdout.
	fdrun := load FDrun FDrun->PATH;
	fdrun->init();
	if(fdrun->run(ctxt, argv, "x01", fds, result) == -1)
		result <-= "bad fdrun spec";
}

centre(t: ref Tk->Toplevel)
{
	sz := Point(int tkcmd(t, ". cget -width"), int tkcmd(t, ". cget -height"));
	r := t.screenr;
	if (sz.x > r.dx())
		tkcmd(t, ". configure -width " + string r.dx());
	org: Point;
	org.x = r.dx() / 2 - tk->rect(t, ".", 0).dx() / 2;
	org.y = r.dy() / 3 - tk->rect(t, ".", 0).dy() / 2;
	if (org.y < 0)
		org.y = 0;
	tkcmd(t, ". configure -x " + string org.x + " -y " + string org.y);
}

getuser(): string
{
	if(username != nil)
		return username;
	fd := sys->open("/dev/user", Sys->OREAD);
	buf := array[8192] of byte;
	if((n := sys->read(fd, buf, len buf)) > 0)
		return string buf[0:n];
	return "none";
}

tkcmd(t: ref Tk->Toplevel, cmd: string): string
{
	e := tk->cmd(t, cmd);
	if(e != nil && e[0] == '!')
		sys->fprint(stderr(), "logon: tk error on %q: %s\n", cmd, e);
	return e;
}

rev[T](x: list of T): list of T
{
	l: list of T;
	for(; x != nil; x = tl x)
		l = hd x :: l;
	return l;
}


stderr(): ref Sys->FD
{
	return sys->fildes(2);
}