xref: /inferno-os/appl/cmd/wmexport.b (revision 66f5808b81b1df84bc57c4f7b9d487201bc162fb) 
1implement Wmexport;
2
3#
4# Copyright © 2003 Vita Nuova Holdings Limited.
5#
6
7include "sys.m";
8	sys: Sys;
9include "draw.m";
10	draw: Draw;
11	Wmcontext, Image: import draw;
12include "wmlib.m";
13	wmlib: Wmlib;
14include "styx.m";
15	styx: Styx;
16	Rmsg, Tmsg: import styx;
17include "styxservers.m";
18	styxservers: Styxservers;
19	Styxserver, Fid, Navigator, Navop: import styxservers;
20	Enotdir, Enotfound: import Styxservers;
21
22Wmexport: module {
23	init: fn(nil: ref Draw->Context, argv: list of string);
24};
25
26# filesystem looks like:
27#	clone
28#	1
29#		wmctl
30#		keyboard
31#		pointer
32#		winname
33
34badmodule(p: string)
35{
36	sys->fprint(sys->fildes(2), "wmexport: cannot load %s: %r\n", p);
37	raise "fail:bad module";
38}
39
40user := "me";
41qidseq := 1;
42imgseq := 0;
43
44pidregister: chan of (int, int);
45flush: chan of (int, int, chan of int);
46
47makeconn: chan of chan of (ref Conn, string);
48delconn: chan of ref Conn;
49reqpool: list of chan of (ref Tmsg, ref Conn, ref Fid);
50reqidle: int;
51reqdone: chan of chan of (ref Tmsg, ref Conn, ref Fid);
52
53srv: ref Styxserver;
54ctxt: ref Draw->Context;
55
56conns: array of ref Conn;
57nconns := 0;
58
59Qerror, Qroot, Qdir, Qclone, Qwmctl, Qptr, Qkbd, Qwinname: con iota;
60Shift: con 4;
61Mask: con 16rf;
62
63Maxreqidle: con 3;
64Maxreplyidle: con 3;
65
66Conn: adt {
67	wm:		ref Wmcontext;
68	iname:	string;				# name of image
69	n:		int;
70	nreads:	int;
71};
72
73# initial connection provides base-name (fid?) for images.
74# full name could be:
75#	window.fid.tag
76
77init(drawctxt: ref Draw->Context, nil: list of string)
78{
79	sys = load Sys Sys->PATH;
80	ctxt = drawctxt;
81	if(ctxt == nil || ctxt.wm == nil){
82		sys->fprint(sys->fildes(2), "wmexport: no window manager context\n");
83		raise "fail:no wm";
84	}
85	draw = load Draw Draw->PATH;
86	styx = load Styx Styx->PATH;
87	if (styx == nil)
88		badmodule(Styx->PATH);
89	styx->init();
90	styxservers = load Styxservers Styxservers->PATH;
91	if (styxservers == nil)
92		badmodule(Styxservers->PATH);
93	styxservers->init(styx);
94
95	wmlib = load Wmlib Wmlib->PATH;
96	if(wmlib == nil)
97		badmodule(Wmlib->PATH);
98	wmlib->init();
99
100	sys->pctl(Sys->FORKNS|Sys->NEWPGRP, nil);		# fork pgrp?
101
102	ctxt = drawctxt;
103	navops := chan of ref Navop;
104	spawn navigator(navops);
105	tchan: chan of ref Tmsg;
106	(tchan, srv) = Styxserver.new(sys->fildes(0), Navigator.new(navops), big Qroot);
107	srv.replychan = chan of ref Styx->Rmsg;
108	spawn replymarshal(srv.replychan);
109	spawn serve(tchan, navops);
110}
111
112serve(tchan: chan of ref Tmsg, navops: chan of ref Navop)
113{
114	pidregister = chan of (int, int);
115	makeconn = chan of chan of (ref Conn, string);
116	delconn = chan of ref Conn;
117	flush = chan of (int, int, chan of int);
118	reqdone = chan of chan of (ref Tmsg, ref Conn, ref Fid);
119	spawn flushproc(flush);
120
121Serve:
122	for(;;)alt{
123	gm := <-tchan =>
124		if(gm == nil)
125			break Serve;
126		pick m := gm {
127		Readerror =>
128			sys->fprint(sys->fildes(2), "wmexport: fatal read error: %s\n", m.error);
129			break Serve;
130		Open =>
131			(fid, mode, d, err) := srv.canopen(m);
132			if(err != nil)
133				srv.reply(ref Rmsg.Error(m.tag, err));
134			else if(fid.qtype & Sys->QTDIR)
135				srv.default(m);
136			else
137				request(ctxt, m, fid);
138		Read =>
139			(fid, err) := srv.canread(m);
140			if(err != nil)
141				srv.reply(ref Rmsg.Error(m.tag, err));
142			else if(fid.qtype & Sys->QTDIR)
143				srv.read(m);
144			else
145				request(ctxt, m, fid);
146		Write =>
147			(fid, err) := srv.canwrite(m);
148			if(err != nil)
149				srv.reply(ref Rmsg.Error(m.tag, err));
150			else
151				request(ctxt, m, fid);
152		Flush =>
153			done := chan of int;
154			flush <-= (m.tag, m.oldtag, done);
155			<-done;
156		Clunk =>
157			request(ctxt, m, srv.clunk(m));
158		* =>
159			srv.default(gm);
160		}
161	rc := <-makeconn =>
162		if(nconns >= len conns)
163			conns = (array[len conns + 5] of ref Conn)[0:] = conns;
164		wm := wmlib->connect(ctxt);
165		if(wm == nil)				# XXX this can't happen - give wmlib->connect an error return
166			rc <-= (nil, "cannot connect");
167		else{
168			c := ref Conn(wm, nil, qidseq++, 0);
169			conns[nconns++] = c;
170			rc <-= (c, nil);
171		}
172	c := <-delconn =>
173		for(i := 0; i < nconns; i++)
174			if(conns[i] == c)
175				break;
176		nconns--;
177		if(i < nconns)
178			conns[i] = conns[nconns];
179		conns[nconns] = nil;
180	reqpool = <-reqdone :: reqpool =>
181		if(reqidle++ > Maxreqidle){
182			hd reqpool <-= (nil, nil, nil);
183			reqpool = tl reqpool;
184			reqidle--;
185		}
186	}
187	navops <-= nil;
188	kill(sys->pctl(0, nil), "killgrp");
189}
190
191nameimage(nil: ref Conn, img: ref Draw->Image): string
192{
193	if(img.iname != nil)
194		return img.iname;
195	for(i := 0; i < 100; i++){
196		s := "inferno." + string imgseq++;
197		if(img.name(s, 1) > 0)
198			return s;
199		if(img.iname != nil)
200			return img.iname;		# a competing process has done it for us.
201	}
202sys->print("wmexport: no image names: %r\n");
203raise "panic";
204}
205
206request(nil: ref Draw->Context, m: ref Styx->Tmsg, fid: ref Fid)
207{
208	n := int fid.path >> Shift;
209	conn: ref Conn;
210	for(i := 0; i < nconns; i++){
211		if(conns[i].n == n){
212			conn = conns[i];
213			break;
214		}
215	}
216	c: chan of (ref Tmsg, ref Conn, ref Fid);
217	if(reqpool == nil){
218		c = chan of (ref Tmsg, ref Conn, ref Fid);
219		spawn requestproc(c);
220	}else{
221		(c, reqpool) = (hd reqpool, tl reqpool);
222		reqidle--;
223	}
224	c <-= (m, conn, fid);
225}
226
227requestproc(req: chan of (ref Tmsg, ref Conn, ref Fid))
228{
229	pid := sys->pctl(0, nil);
230	for(;;){
231		(gm, c, fid) := <-req;
232		if(gm == nil)
233			break;
234		pidregister <-= (pid, gm.tag);
235		path := int fid.path;
236		pick m := gm {
237		Read =>
238			if(c == nil)
239				srv.replydirect(ref Rmsg.Error(m.tag, "connection is dead"));
240			case path & Mask {
241			Qwmctl =>
242				# first read gets number of connection.
243				m.offset = big 0;
244				if(c.nreads++ == 0)
245					srv.replydirect(styxservers->readstr(m, string c.n));
246				else
247					srv.replydirect(styxservers->readstr(m, <-c.wm.ctl));
248			Qptr =>
249				m.offset = big 0;
250				p := <-c.wm.ptr;
251				srv.replydirect(styxservers->readbytes(m,
252					sys->aprint("m%11d %11d %11d %11ud ", p.xy.x, p.xy.y, p.buttons, p.msec)));
253			Qkbd =>
254				m.offset = big 0;
255				s := "";
256				s[0] = <-c.wm.kbd;
257				srv.replydirect(styxservers->readstr(m, s));
258			Qwinname =>
259				m.offset = big 0;
260				srv.replydirect(styxservers->readstr(m, c.iname));
261			* =>
262				srv.replydirect(ref Rmsg.Error(m.tag, "what was i thinking1?"));
263			}
264		Write =>
265			if(c == nil)
266				srv.replydirect(ref Rmsg.Error(m.tag, "connection is dead"));
267			case path & Mask {
268			Qwmctl =>
269				if(sys->write(c.wm.connfd, m.data, len m.data) == -1){
270					srv.replydirect(ref Rmsg.Error(m.tag, sys->sprint("%r")));
271					break;
272				}
273				if(len m.data > 0 && int m.data[0] == '!'){
274					i := <-c.wm.images;
275					if(i == nil)
276						i = <-c.wm.images;
277					c.iname = nameimage(c, i);
278				}
279				srv.replydirect(ref Rmsg.Write(m.tag, len m.data));
280			* =>
281				srv.replydirect(ref Rmsg.Error(m.tag, "what was i thinking2?"));
282			}
283		Open =>
284			if(c == nil && path != Qclone)
285				srv.replydirect(ref Rmsg.Error(m.tag, "connection is dead"));
286			err: string;
287			q := qid(path);
288			case path & Mask {
289			Qclone =>
290				cch := chan of (ref Conn, string);
291				makeconn <-= cch;
292				(c, err) = <-cch;
293				if(c != nil)
294					q = qid(Qwmctl | (c.n << Shift));
295			Qptr =>
296				if(sys->fprint(c.wm.connfd, "start ptr") == -1)
297					err = sys->sprint("%r");
298			Qkbd =>
299				if(sys->fprint(c.wm.connfd, "start kbd") == -1)
300					err = sys->sprint("%r");
301			Qwmctl =>
302				;
303			Qwinname =>
304				;
305			* =>
306				err = "what was i thinking3?";
307			}
308			if(err != nil)
309				srv.replydirect(ref Rmsg.Error(m.tag, err));
310			else{
311				srv.replydirect(ref Rmsg.Open(m.tag, q, 0));
312				fid.open(m.mode, q);
313			}
314		Clunk =>
315			case path & Mask {
316			Qwmctl =>
317				if(c != nil)
318					delconn <-= c;
319			}
320		* =>
321			srv.replydirect(ref Rmsg.Error(gm.tag, "oh dear"));
322		}
323		pidregister <-= (pid, -1);
324		reqdone <-= req;
325	}
326}
327
328qid(path: int): Sys->Qid
329{
330	return dirgen(path).t0.qid;
331}
332
333replyproc(c: chan of ref Rmsg, replydone: chan of chan of ref Rmsg)
334{
335	# hmm, this could still send a reply out-of-order with a flush
336	while((m := <-c) != nil){
337		srv.replydirect(m);
338		replydone <-= c;
339	}
340}
341
342# deal with reply messages coming from styxservers.
343replymarshal(c: chan of ref Styx->Rmsg)
344{
345	replypool: list of chan of ref Rmsg;
346	n := 0;
347	replydone := chan of chan of ref Rmsg;
348	for(;;) alt{
349	m := <-c =>
350		c: chan of ref Rmsg;
351		if(replypool == nil){
352			c = chan of ref Rmsg;
353			spawn replyproc(c, replydone);
354		}else{
355			(c, replypool) = (hd replypool, tl replypool);
356			n--;
357		}
358		c <-= m;
359	replypool = <-replydone :: replypool =>
360		if(++n > Maxreplyidle){
361			hd replypool <-= nil;
362			replypool = tl replypool;
363			n--;
364		}
365	}
366}
367
368navigator(navops: chan of ref Navop)
369{
370	while((m := <-navops) != nil){
371		path := int m.path;
372		pick n := m {
373		Stat =>
374			n.reply <-= dirgen(int n.path);
375		Walk =>
376			name := n.name;
377			case path & Mask {
378			Qdir =>
379				dp := path & ~Mask;
380				case name {
381				".." =>
382					path = Qroot;
383				"wmctl" =>
384					path = Qwmctl | dp;
385				"pointer" =>
386					path = Qptr | dp;
387				"keyboard" =>
388					path = Qkbd | dp;
389				"winname" =>
390					path = Qwinname | dp;
391				* =>
392					path = Qerror;
393				}
394			Qroot =>
395				case name{
396				"clone" =>
397					path = Qclone;
398				* =>
399					x := int name;
400					path = Qerror;
401					if(string x == name){
402						for(i := 0; i < nconns; i++)
403							if(conns[i].n == x){
404								path = (x << Shift) | Qdir;
405								break;
406							}
407					}
408				}
409			}
410			n.reply <-= dirgen(path);
411		Readdir =>
412			err := "";
413			d: array of int;
414			case path & Mask {
415			Qdir =>
416				d = array[] of {Qwmctl, Qptr, Qkbd, Qwinname};
417				for(i := 0; i < len d; i++)
418					d[i] |= path & ~Mask;
419			Qroot =>
420				d = array[nconns + 1] of int;
421				d[0] = Qclone;
422				for(i := 0; i < nconns; i++)
423					d[i + 1] = (conns[i].n<<Shift) | Qdir;
424			}
425			if(d == nil){
426				n.reply <-= (nil, Enotdir);
427				break;
428			}
429			for (i := n.offset; i < len d; i++)
430				n.reply <-= dirgen(d[i]);
431			n.reply <-= (nil, nil);
432		}
433	}
434}
435
436dirgen(path: int): (ref Sys->Dir, string)
437{
438	name: string;
439	perm: int;
440	case path & Mask {
441	Qroot =>
442		name = ".";
443		perm = 8r555|Sys->DMDIR;
444	Qdir =>
445		name = string (path >> Shift);
446		perm = 8r555|Sys->DMDIR;
447	Qclone =>
448		name = "clone";
449		perm = 8r666;
450	Qwmctl =>
451		name = "wmctl";
452		perm = 8r666;
453	Qptr =>
454		name = "pointer";
455		perm = 8r444;
456	Qkbd =>
457		name = "keyboard";
458		perm = 8r444;
459	Qwinname =>
460		name = "winname";
461		perm = 8r444;
462	* =>
463		return (nil, Enotfound);
464	}
465	return (dir(path, name, perm), nil);
466}
467
468dir(path: int, name: string, perm: int): ref Sys->Dir
469{
470	d := ref sys->zerodir;
471	d.qid.path = big path;
472	if(perm & Sys->DMDIR)
473		d.qid.qtype = Sys->QTDIR;
474	d.mode = perm;
475	d.name = name;
476	d.uid = user;
477	d.gid = user;
478	return d;
479}
480
481flushproc(flush: chan of (int, int, chan of int))
482{
483	a: array of (int, int);		# (pid, tag)
484	n := 0;
485	for(;;)alt{
486	(pid, tag) := <-pidregister =>
487		if(tag == -1){
488			for(i := 0; i < n; i++)
489				if(a[i].t0 == pid)
490					break;
491			n--;
492			if(i < n)
493				a[i] = a[n];
494		}else{
495			if(n >= len a){
496				na := array[n + 5] of (int, int);
497				na[0:] = a;
498				a = na;
499			}
500			a[n++] = (pid, tag);
501		}
502	(tag, oldtag, done) := <-flush =>
503		for(i := 0; i < n; i++)
504			if(a[i].t1 == oldtag){
505				spawn doflush(tag, a[i].t0, done);
506				break;
507			}
508		if(i == n)
509			spawn doflush(tag, -1, done);
510	}
511}
512
513doflush(tag: int, pid: int, done: chan of int)
514{
515	if(pid != -1){
516		kill(pid, "kill");
517		pidregister <-= (pid, -1);
518	}
519	srv.replydirect(ref Rmsg.Flush(tag));
520	done <-= 1;
521}
522
523# return number of characters from s that will fit into
524# max bytes when encoded as utf-8.
525fullutf(s: string, max: int): int
526{
527	Bit1:	con 7;
528	Bitx:	con 6;
529	Bit2:	con 5;
530	Bit3:	con 4;
531	Bit4:	con 3;
532	Rune1:	con (1<<(Bit1+0*Bitx))-1;		# 0000 0000 0111 1111
533	Rune2:	con (1<<(Bit2+1*Bitx))-1;		# 0000 0111 1111 1111
534	Rune3:	con (1<<(Bit3+2*Bitx))-1;		# 1111 1111 1111 1111
535	nb := 0;
536	for(i := 0; i < len s; i++){
537		c := s[i];
538		if(c <= Rune1)
539			nb += 1;
540		else if(c <= Rune2)
541			nb += 2;
542		else
543			nb += 3;
544		if(nb > max)
545			break;
546	}
547	return i;
548}
549
550kill(pid: int, note: string): int
551{
552	fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE);
553	if(fd == nil || sys->fprint(fd, "%s", note) < 0)
554		return -1;
555	return 0;
556}
557