Charles.Forsyth20060303a828770d19 years agoHistory
557 lines · 11.7 KB · Brainfuck
RawDownload
implement Wmexport; ## Copyright © 2003 Vita Nuova Holdings Limited.# include "sys.m";	sys: Sys;include "draw.m";	draw: Draw;	Wmcontext, Image: import draw;include "wmlib.m";	wmlib: Wmlib;include "styx.m";	styx: Styx;	Rmsg, Tmsg: import styx;include "styxservers.m";	styxservers: Styxservers;	Styxserver, Fid, Navigator, Navop: import styxservers;	Enotdir, Enotfound: import Styxservers;	nametree: Nametree; Wmexport: module {	init: fn(nil: ref Draw->Context, argv: list of string);}; # filesystem looks like:#	clone#	1#		wmctl#		keyboard#		pointer#		winname badmodule(p: string){	sys->fprint(sys->fildes(2), "wmexport: cannot load %s: %r\n", p);	raise "fail:bad module";} user := "me";qidseq := 1;imgseq := 0; pidregister: chan of (int, int);flush: chan of (int, int, chan of int); makeconn: chan of chan of (ref Conn, string);delconn: chan of ref Conn;reqpool: list of chan of (ref Tmsg, ref Conn, ref Fid);reqidle: int;reqdone: chan of chan of (ref Tmsg, ref Conn, ref Fid); srv: ref Styxserver;ctxt: ref Draw->Context; conns: array of ref Conn;nconns := 0; Qerror, Qroot, Qdir, Qclone, Qwmctl, Qptr, Qkbd, Qwinname: con iota;Shift: con 4;Mask: con 16rf; Maxreqidle: con 3;Maxreplyidle: con 3; Conn: adt {	wm:		ref Wmcontext;	iname:	string;				# name of image	n:		int;	nreads:	int;}; # initial connection provides base-name (fid?) for images.# full name could be:#	window.fid.tag init(drawctxt: ref Draw->Context, nil: list of string){	sys = load Sys Sys->PATH;	ctxt = drawctxt;	if(ctxt == nil || ctxt.wm == nil){		sys->fprint(sys->fildes(2), "wmexport: no window manager context\n");		raise "fail:no wm";	}	draw = load Draw Draw->PATH;	styx = load Styx Styx->PATH;	if (styx == nil)		badmodule(Styx->PATH);	styx->init();	styxservers = load Styxservers Styxservers->PATH;	if (styxservers == nil)		badmodule(Styxservers->PATH);	styxservers->init(styx); 	wmlib = load Wmlib Wmlib->PATH;	if(wmlib == nil)		badmodule(Wmlib->PATH);	wmlib->init(); 	sys->pctl(Sys->FORKNS|Sys->NEWPGRP, nil);		# fork pgrp? 	ctxt = drawctxt;	navops := chan of ref Navop;	spawn navigator(navops);	tchan: chan of ref Tmsg;	(tchan, srv) = Styxserver.new(sys->fildes(0), Navigator.new(navops), big Qroot);	srv.replychan = chan of ref Styx->Rmsg;	spawn replymarshal(srv.replychan);	spawn serve(tchan, navops);} serve(tchan: chan of ref Tmsg, navops: chan of ref Navop){	pidregister = chan of (int, int);	makeconn = chan of chan of (ref Conn, string);	delconn = chan of ref Conn;	flush = chan of (int, int, chan of int);	reqdone = chan of chan of (ref Tmsg, ref Conn, ref Fid);	spawn flushproc(flush); Serve:	for(;;)alt{	gm := <-tchan =>		if(gm == nil)			break Serve;		pick m := gm {		Readerror =>			sys->fprint(sys->fildes(2), "wmexport: fatal read error: %s\n", m.error);			break Serve;		Open =>			(fid, mode, d, err) := srv.canopen(m);			if(err != nil)				srv.reply(ref Rmsg.Error(m.tag, err));			else if(fid.qtype & Sys->QTDIR)				srv.default(m);			else				request(ctxt, m, fid);		Read =>			(fid, err) := srv.canread(m);			if(err != nil)				srv.reply(ref Rmsg.Error(m.tag, err));			else if(fid.qtype & Sys->QTDIR)				srv.read(m);			else				request(ctxt, m, fid);		Write =>			(fid, err) := srv.canwrite(m);			if(err != nil)				srv.reply(ref Rmsg.Error(m.tag, err));			else				request(ctxt, m, fid);		Flush =>			done := chan of int;			flush <-= (m.tag, m.oldtag, done);			<-done;		Clunk =>			request(ctxt, m, srv.clunk(m));		* =>			srv.default(gm);		}	rc := <-makeconn =>		if(nconns >= len conns)			conns = (array[len conns + 5] of ref Conn)[0:] = conns;		wm := wmlib->connect(ctxt);		if(wm == nil)				# XXX this can't happen - give wmlib->connect an error return			rc <-= (nil, "cannot connect");		else{			c := ref Conn(wm, nil, qidseq++, 0);			conns[nconns++] = c;			rc <-= (c, nil);		}	c := <-delconn =>		for(i := 0; i < nconns; i++)			if(conns[i] == c)				break;		nconns--;		if(i < nconns)			conns[i] = conns[nconns];		conns[nconns] = nil;	reqpool = <-reqdone :: reqpool =>		if(reqidle++ > Maxreqidle){			hd reqpool <-= (nil, nil, nil);			reqpool = tl reqpool;			reqidle--;		}	}	navops <-= nil;	kill(sys->pctl(0, nil), "killgrp");} nameimage(nil: ref Conn, img: ref Draw->Image): string{	if(img.iname != nil)		return img.iname;	for(i := 0; i < 100; i++){		s := "inferno." + string imgseq++;		if(img.name(s, 1) > 0)			return s;		if(img.iname != nil)			return img.iname;		# a competing process has done it for us.	}sys->print("wmexport: no image names: %r\n");raise "panic";} request(nil: ref Draw->Context, m: ref Styx->Tmsg, fid: ref Fid){	n := int fid.path >> Shift;	conn: ref Conn;	for(i := 0; i < nconns; i++){		if(conns[i].n == n){			conn = conns[i];			break;		}	}	c: chan of (ref Tmsg, ref Conn, ref Fid);	if(reqpool == nil){		c = chan of (ref Tmsg, ref Conn, ref Fid);		spawn requestproc(c);	}else{		(c, reqpool) = (hd reqpool, tl reqpool);		reqidle--;	}	c <-= (m, conn, fid);} requestproc(req: chan of (ref Tmsg, ref Conn, ref Fid)){	pid := sys->pctl(0, nil);	for(;;){		(gm, c, fid) := <-req;		if(gm == nil)			break;		pidregister <-= (pid, gm.tag);		path := int fid.path;		pick m := gm {		Read =>			if(c == nil)				srv.replydirect(ref Rmsg.Error(m.tag, "connection is dead"));			case path & Mask {			Qwmctl =>				# first read gets number of connection.				m.offset = big 0;				if(c.nreads++ == 0)					srv.replydirect(styxservers->readstr(m, string c.n));				else					srv.replydirect(styxservers->readstr(m, <-c.wm.ctl));			Qptr =>				m.offset = big 0;				p := <-c.wm.ptr;				srv.replydirect(styxservers->readbytes(m,					sys->aprint("m%11d %11d %11d %11ud ", p.xy.x, p.xy.y, p.buttons, p.msec)));			Qkbd =>				m.offset = big 0;				s := "";				s[0] = <-c.wm.kbd;				srv.replydirect(styxservers->readstr(m, s));			Qwinname =>				m.offset = big 0;				srv.replydirect(styxservers->readstr(m, c.iname));			* =>				srv.replydirect(ref Rmsg.Error(m.tag, "what was i thinking1?"));			}		Write =>			if(c == nil)				srv.replydirect(ref Rmsg.Error(m.tag, "connection is dead"));			case path & Mask {			Qwmctl =>				if(sys->write(c.wm.connfd, m.data, len m.data) == -1){					srv.replydirect(ref Rmsg.Error(m.tag, sys->sprint("%r")));					break;				}				if(len m.data > 0 && int m.data[0] == '!'){					i := <-c.wm.images;					if(i == nil)						i = <-c.wm.images;					c.iname = nameimage(c, i);				}				srv.replydirect(ref Rmsg.Write(m.tag, len m.data));			* =>				srv.replydirect(ref Rmsg.Error(m.tag, "what was i thinking2?"));			}		Open =>			if(c == nil && path != Qclone)				srv.replydirect(ref Rmsg.Error(m.tag, "connection is dead"));			err: string;			q := qid(path);			case path & Mask {			Qclone =>				cch := chan of (ref Conn, string);				makeconn <-= cch;				(c, err) = <-cch;				if(c != nil)					q = qid(Qwmctl | (c.n << Shift));			Qptr =>				if(sys->fprint(c.wm.connfd, "start ptr") == -1)					err = sys->sprint("%r");			Qkbd =>				if(sys->fprint(c.wm.connfd, "start kbd") == -1)					err = sys->sprint("%r");			Qwmctl =>				;			Qwinname =>				;			* =>				err = "what was i thinking3?";			}			if(err != nil)				srv.replydirect(ref Rmsg.Error(m.tag, err));			else{				srv.replydirect(ref Rmsg.Open(m.tag, q, 0));				fid.open(m.mode, q);			}		Clunk =>			case path & Mask {			Qwmctl =>				if(c != nil)					delconn <-= c;			}		* =>			srv.replydirect(ref Rmsg.Error(gm.tag, "oh dear"));			}		pidregister <-= (pid, -1);		reqdone <-= req;	}} qid(path: int): Sys->Qid{	return dirgen(path).t0.qid;}		replyproc(c: chan of ref Rmsg, replydone: chan of chan of ref Rmsg){	# hmm, this could still send a reply out-of-order with a flush	while((m := <-c) != nil){		srv.replydirect(m);		replydone <-= c;	}} # deal with reply messages coming from styxservers.replymarshal(c: chan of ref Styx->Rmsg){	replypool: list of chan of ref Rmsg;	n := 0;	replydone := chan of chan of ref Rmsg;	for(;;) alt{	m := <-c =>		c: chan of ref Rmsg;		if(replypool == nil){			c = chan of ref Rmsg;			spawn replyproc(c, replydone);		}else{			(c, replypool) = (hd replypool, tl replypool);			n--;		}		c <-= m;	replypool = <-replydone :: replypool =>		if(++n > Maxreplyidle){			hd replypool <-= nil;			replypool = tl replypool;			n--;		}	}} navigator(navops: chan of ref Navop){	while((m := <-navops) != nil){		path := int m.path;		pick n := m {		Stat =>			n.reply <-= dirgen(int n.path);		Walk =>			name := n.name;			case path & Mask {			Qdir =>				dp := path & ~Mask;				case name {				".." =>					path = Qroot;				"wmctl" =>					path = Qwmctl | dp;				"pointer" =>					path = Qptr | dp;				"keyboard" =>					path = Qkbd | dp;				"winname" =>					path = Qwinname | dp;				* =>					path = Qerror;				}			Qroot =>				case name{				"clone" =>					path = Qclone;				* =>					x := int name;					path = Qerror;					if(string x == name){						for(i := 0; i < nconns; i++)							if(conns[i].n == x){								path = (x << Shift) | Qdir;								break;							}					}				}			}			n.reply <-= dirgen(path);		Readdir =>			err := "";			d: array of int;			case path & Mask {			Qdir =>				d = array[] of {Qwmctl, Qptr, Qkbd, Qwinname};				for(i := 0; i < len d; i++)					d[i] |= path & ~Mask;			Qroot =>				d = array[nconns + 1] of int;				d[0] = Qclone;				for(i := 0; i < nconns; i++)					d[i + 1] = (conns[i].n<<Shift) | Qdir;			}			if(d == nil){				n.reply <-= (nil, Enotdir);				break;			}			for (i := n.offset; i < len d; i++)				n.reply <-= dirgen(d[i]);			n.reply <-= (nil, nil);		}	}} dirgen(path: int): (ref Sys->Dir, string){	name: string;	perm: int;	case path & Mask {	Qroot =>		name = ".";		perm = 8r555|Sys->DMDIR;	Qdir =>		name = string (path >> Shift);		perm = 8r555|Sys->DMDIR;	Qclone =>		name = "clone";		perm = 8r666;	Qwmctl =>		name = "wmctl";		perm = 8r666;	Qptr =>		name = "pointer";		perm = 8r444;	Qkbd =>		name = "keyboard";		perm = 8r444;	Qwinname =>		name = "winname";		perm = 8r444;	* =>		return (nil, Enotfound);	}	return (dir(path, name, perm), nil);} dir(path: int, name: string, perm: int): ref Sys->Dir{	d := ref sys->zerodir;	d.qid.path = big path;	if(perm & Sys->DMDIR)		d.qid.qtype = Sys->QTDIR;	d.mode = perm;	d.name = name;	d.uid = user;	d.gid = user;	return d;} flushproc(flush: chan of (int, int, chan of int)){	a: array of (int, int);		# (pid, tag)	n := 0;	for(;;)alt{	(pid, tag) := <-pidregister =>		if(tag == -1){			for(i := 0; i < n; i++)				if(a[i].t0 == pid)					break;			n--;			if(i < n)				a[i] = a[n];		}else{			if(n >= len a){				na := array[n + 5] of (int, int);				na[0:] = a;				a = na;			}

Lines 1–500 of 557.