ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/grid/remotelogon.b/
implement WmLogon; # # Copyright © 2003 Vita Nuova Holdings Limited. All rights reserved. # # # get a certificate to enable remote access. # 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 "arg.m"; include "sh.m"; include "dial.m"; dial: Dial; include "newns.m"; include "keyring.m"; keyring: Keyring; include "security.m"; login: Login; include "registries.m"; registries: Registries; Registry, Attributes: import registries; # XXX where to put the certificate: is the username already set to # something appropriate, with a home directory and keyring directory in that? # how do we find out the signer; presumably from the registry? # should do that before signing on; if we can't get it, then prompt for it. WmLogon: module { init: fn(ctxt: ref Draw->Context, argv: list of string); }; registry: ref Registry; usr := ""; passwd := ""; loginaddr := ""; signerpkhash := ""; cfg := array[] of { "frame .f -bd 2 -relief raised", "label .f.p -bitmap @/icons/inferno.bit -borderwidth 2 -relief raised", "label .f.ul -text {User Name:} -anchor w", "entry .f.ue -bg white -width 10w", "label .f.pl -text {Password:} -anchor w", "entry .f.pe -bg white -show *", "checkbutton .f.ck -variable newuser -text {New}", "frame .f.f -borderwidth 2 -relief raised", "frame .f.u", "pack .f.ue -in .f.u -side left -expand 1 -fill x", "pack .f.ck -in .f.u -side left", "grid .f.ul -row 0 -column 0 -sticky e -in .f.f", "grid .f.u -row 0 -column 1 -sticky ew -in .f.f", "grid .f.pl -row 1 -column 0 -sticky e -in .f.f", "grid .f.pe -row 1 -column 1 -sticky ew -in .f.f", "pack .f.p .f.f -fill x", "bind .f.ue <Key-\n> {focus .f.pe}", "bind .f.ue {<Key-\t>} {focus .f.pe}", "bind .f.pe <Key-\n> {send panelcmd ok}", "bind .f.pe {<Key-\t>} {focus .f.ue}", "focus .f.ue", }; notecfg := array[] of { "frame .n -bd 2 -relief raised", "frame .n.f", "label .n.f.m -anchor nw", "label .n.f.l -bitmap error -foreground red", "button .n.b -text Continue -command {send notecmd done}", "focus .n.f", "bind .n.f <Key-\n> {send notecmd done}", "pack .n.f.l .n.f.m -side left -expand 1", "pack .n.f .n.b", }; checkload[T](x: T, p: string): T { if(x == nil) error(sys->sprint("cannot load %s: %r\n", p)); return x; } init(ctxt: ref Draw->Context, argv: list of string) { sys = load Sys Sys->PATH; draw = checkload(load Draw Draw->PATH, Draw->PATH); tk = checkload(load Tk Tk->PATH, Tk->PATH); tkclient = checkload(load Tkclient Tkclient->PATH, Tkclient->PATH); tkclient->init(); login = checkload(load Login Login->PATH, Login->PATH); keyring = checkload(load Keyring Keyring->PATH, Keyring->PATH); dial = checkload(load Dial Dial->PATH, Dial->PATH); registries = checkload(load Registries Registries->PATH, Registries->PATH); registries->init(); arg := load Arg Arg->PATH; if(arg != nil){ arg->init(argv); arg->setusage("usage: logon [-u user] [-p passwd] [-a loginaddr] command [arg...]]\n"); while((opt := arg->opt()) != 0){ case opt{ 'a' => loginaddr = arg->earg(); 'k' => signerpkhash = arg->earg(); 'u' => usr = arg->earg(); 'p' => passwd = arg->earg(); * => arg->usage(); } } argv = arg->argv(); arg = nil; } else { if(tl argv != nil) sys->fprint(stderr(), "remotelogon: cannot load %s: %r; ignoring arguments\n", Arg->PATH); argv = nil; } sys->pctl(Sys->FORKNS, nil); sync := chan of (ref Keyring->Authinfo, string); spawn logon(ctxt, sync); (key, err) := <-sync; if(key == nil) raise "fail:" + err; registry = nil; servekeyfile(key); errch := chan of string; spawn exec(ctxt, argv, errch); err = <-errch; if (err != nil) error(err); } # run in a separate process so that we keep the outer namespace unsullied by # mounted registries. logon(ctxt: ref Draw->Context, sync: chan of (ref Keyring->Authinfo, string)) { sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil); { logon1(ctxt, sync); } exception e { "fail:*" => sync <-= (nil, e[5:]); } } logon1(ctxt: ref Draw->Context, sync: chan of (ref Keyring->Authinfo, string)) { if(ctxt == nil) ctxt = tkclient->makedrawcontext(); (top, ctl) := tkclient->toplevel(ctxt, nil, nil, Tkclient->Plain); tkclient->startinput(top, "kbd" :: "ptr" :: nil); tkclient->onscreen(top, "onscreen"); stop := chan of int; spawn tkclient->handler(top, stop); if(usr != nil){ fa := loginaddr; if(fa == nil) fa = findloginresource(top, signerpkhash); if(getauthinfo(top, fa, 0, sync)){ cleanup(); stop <-= 1; exit; } } cmd(top, "canvas .c -buffer none -bg #777777"); cmd(top, "pack .c -fill both -expand 1"); enter := makepanel(top); for(;;) { cmd(top, "focus .f.ue; update"); <-enter; usr = cmd(top, ".f.ue get"); if(usr == nil) { notice(top, "You must supply a user name to login"); continue; } passwd = cmd(top, ".f.pe get"); if(getauthinfo(top, loginaddr, int cmd(top, "variable newuser"), sync)){ cleanup(); stop <-= 1; exit; } cmd(top, ".f.ue delete 0 end"); cmd(top, ".f.pe delete 0 end"); } } findloginresource(top: ref Tk->Toplevel, signerpkhash: string): string { mountregistry(); attrs := ("resource", "login")::nil; if(signerpkhash != nil) attrs = ("pk", signerpkhash) :: attrs; (svc, err) := registry.find(attrs); if(svc == nil){ notice(top, "cannot find name of login server"); return nil; } return (hd svc).addr; } cleanup() { # get rid of spurious mouse/kbd reading processes. # XXX should probably implement "stop" ctl message in wmlib sys->fprint(sys->open("/prog/"+string sys->pctl(0, nil)+"/ctl", Sys->OWRITE), "killgrp"); } getauthinfo(top: ref Tk->Toplevel, addr: string, newuser: int, sync: chan of (ref Keyring->Authinfo, string)): int { if(newuser) if(createuser(top, usr, passwd, signerpkhash) == 0) return 0; if(addr == nil){ addr = findloginresource(top, signerpkhash); if(addr == nil) return 0; } (err, info) := login->login(usr, passwd, addr); if(info == nil){ notice(top, "Login failed:\n" + err); return 0; } sync <-= (info, nil); return 1; } createuser(top: ref Tk->Toplevel, user, passwd: string, signerpkhash: string): int { mountregistry(); attrs := ("resource", "createuser")::nil; if(signerpkhash != nil) attrs = ("signer", signerpkhash) :: attrs; (svcs, err) := registry.find(attrs); if(svcs == nil){ notice(top, "cannot find name of login server"); return 0; } addr := (hd svcs).addr; c := dial->dial(addr, nil); if(c == nil){ notice(top, sys->sprint("cannot dial %s: %r", addr)); return 0; } if(sys->mount(c.dfd, nil, "/tmp", Sys->MREPL, nil) == -1){ notice(top, sys->sprint("cannot mount %s: %r", addr)); return 0; } fd := sys->open("/tmp/createuser", Sys->OWRITE); if(fd == nil){ notice(top, sys->sprint("cannot open createuser: %r")); return 0; } if(sys->fprint(fd, "%q %q", user, passwd) <= 0){ notice(top, sys->sprint("cannot create user: %r")); return 0; } signerpkhash = (hd svcs).attrs.get("signer"); return 1; } servekeyfile(info: ref Keyring->Authinfo) { keys := "/usr/" + user() + "/keyring"; if(sys->bind("#s", keys, Sys->MBEFORE) == -1) error(sys->sprint("cannot bind #s: %r")); fio := sys->file2chan(keys, "default"); if(fio == nil) error(sys->sprint("cannot make %s: %r", keys + "/default")); sync := chan of int; spawn infofile(fio, sync); <-sync; if(keyring->writeauthinfo(keys + "/default", info) == -1) error(sys->sprint("cannot write %s: %r", keys + "/default")); } mountregistry() { if(registry == nil) registry = Registry.new("/mnt/registry"); if(registry == nil) registry = Registry.connect(nil, nil, nil); if(registry == nil){ sys->fprint(stderr(), "logon: cannot contact registry: %r\n"); raise "fail:no registry"; } } infofile(fileio: ref Sys->FileIO, sync: chan of int) { sys->pctl(Sys->NEWPGRP|Sys->NEWFD|Sys->NEWNS, nil); sync <-= 1; infodata: array of byte; for(;;) alt { (off, nbytes, fid, rc) := <-fileio.read => if(rc == nil) break; if(off > len infodata) off = len infodata; rc <-= (infodata[off:], nil); (off, data, fid, wc) := <-fileio.write => if(wc == nil) break; if(off != len infodata){ wc <-= (0, "cannot be rewritten"); } else { nid := array[len infodata+len data] of byte; nid[0:] = infodata; nid[len infodata:] = data; infodata = nid; wc <-= (len data, nil); } } } exec(ctxt: ref Draw->Context, argv: list of string, errch: chan of string) { sys->pctl(sys->NEWFD, 0 :: 1 :: 2 :: nil); if(argv == nil) argv = "/dis/wm/wm.dis" :: nil; else { sh := load Sh Sh->PATH; if(sh != nil){ sh->run(ctxt, "{$* &}" :: argv); errch <-= nil; exit; } } { cmd := load Command hd argv; if (cmd == nil) { errch <-= sys->sprint("cannot load %s: %r", hd argv); } else { errch <-= nil; spawn cmd->init(ctxt, argv); } }exception{ "fail:*" => exit; } } makepanel(top: ref Tk->Toplevel): chan of string { c := chan of string; tk->namechan(top, c, "panelcmd"); for(i := 0; i < len cfg; i++) cmd(top, cfg[i]); centre(top, ".f"); return c; } centre(top: ref Tk->Toplevel, w: string): string { ir := tk->rect(top, w, Tk->Required); r := tk->rect(top, ".", 0); org := Point(r.dx() / 2 - ir.dx() / 2, r.dy() / 3 - ir.dy() / 2); if (org.y < 0) org.y = 0; if(org.x < 0) org.x = 0; return cmd(top, ".c create window "+string org.x+" "+string org.y+" -window "+w+" -anchor nw"); } notice(top: ref Tk->Toplevel, message: string) { if(top == nil) error(message); c := chan of string; tk->namechan(top, c, "notecmd"); for(i := 0; i < len notecfg; i++) cmd(top, notecfg[i]); cmd(top, ".n.f.m configure -text '" + message); id := centre(top, ".n"); cmd(top, "update"); <-c; cmd(top, ".c delete " + id); cmd(top, "destroy .n"); cmd(top, "update"); } error(e: string) { sys->fprint(stderr(), "remotelogon: %s\n", e); raise "fail:error"; } stderr(): ref Sys->FD { return sys->fildes(2); } user(): string { 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"; } cmd(top: ref Tk->Toplevel, s: string): string { e := tk->cmd(top, s); if (e != nil && e[0] == '!') sys->fprint(stderr(), "remotelogon: tk error on '%s': %s\n", s, e); return e; }