5 files changed, 547 insertions, 0 deletions
diff --git a/appl/alphabet/auxi/endpoints.b b/appl/alphabet/auxi/endpoints.b
new file mode 100644
index 00000000..5544da8b
--- /dev/null
+++ b/appl/alphabet/auxi/endpoints.b
@@ -0,0 +1,105 @@
+implement Endpoints;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "string.m";
+	str: String;
+include "sh.m";
+	sh: Sh;
+include "alphabet/endpoints.m";
+
+init()
+{
+	sys = load Sys Sys->PATH;
+	sh = load Sh Sh->PATH;
+	sh->initialise();
+	str = load String String->PATH;
+}
+
+DIR: con "/n/endpoint";
+
+new(nil, addr: string, force: int): string		# XXX don't ignore net directory
+{
+	if(!force && sys->stat(DIR+"/"+addr+"/clone").t0 != -1)
+		return nil;
+	if((e := sh->run(nil, "mount"::"{mntgen}"::DIR::nil)) != nil)
+		return "mount mntgen failed: "+e;
+	if((e = sh->run(nil, "endpointsrv"::addr::DIR+"/"+addr::nil)) != nil)
+		return "endpoint failed: "+e;
+	if((e = sh->run(nil, "listen"::addr::"export"::DIR+"/"+addr::nil)) != nil){
+		sys->unmount(nil, DIR+"/"+addr);
+		return "listen failed: "+e;
+	}
+	return nil;
+}
+
+err(e: string): Endpoint
+{
+	return (nil, nil, e);
+}
+
+create(addr: string): (ref Sys->FD, Endpoint)
+{
+	d := DIR+"/"+addr;
+	fd := sys->open(d+"/clone", Sys->OREAD);
+	if(fd == nil)
+		return (nil, err(sys->sprint("cannot open %s/clone: %r", d)));
+
+	buf := array[1024] of byte;
+	n := sys->read(fd, buf, len buf);
+	if(n <= 0)
+		return (nil, err("read id failed"));
+	s := string buf[0:n];
+	(nt, toks) := sys->tokenize(s, " ");
+	if(nt != 2)
+		return (nil, err(sys->sprint("invalid id read %q", s)));
+	id: string;
+	(addr, id) = (hd toks, hd tl toks);
+	fd = sys->open(d+"/"+id+".in", Sys->OWRITE);
+	if(fd == nil)
+		return (nil, err(sys->sprint("cannot write to %s/%s: %r", d, id)));
+	return (fd, Endpoint(addr, id, nil));
+}
+
+open(net: string, ep: Endpoint): (ref Sys->FD, string)
+{
+	if(hasslash(ep.addr))
+		return (nil, "bad address");
+	if(hasslash(ep.id))
+		return (nil, "bad id");
+	d := DIR+"/"+ep.addr;
+	fd := sys->open(d+"/"+ep.id, Sys->OREAD);
+	if(fd != nil)
+		return (fd, nil);
+	e := sys->sprint("%r");
+	if(sys->stat(d+"/clone").t0 != -1)
+		return (nil, sys->sprint("endpoint does not exist: %s", e));
+	if((e = sh->run(nil, "mount"::"-A"::net+ep.addr::d::nil)) != nil)
+		return (nil, e);
+	fd = sys->open(d+"/"+ep.id, Sys->OREAD);
+	if(fd == nil)
+		return (nil, sys->sprint("endpoint does not exist: %r"));
+	return (fd, nil);
+}
+
+Endpoint.text(ep: self Endpoint): string
+{
+	return sys->sprint("%q %q %q", ep.addr, ep.id, ep.about);
+}
+
+Endpoint.mk(s: string): Endpoint
+{
+	t := str->unquoted(s);
+	if(len t != 3)
+		return err("invalid endpoint string");
+	# XXX could do more validation than this.
+	return (hd t, hd tl t, hd tl tl t);
+}
+
+hasslash(s: string): int
+{
+	for(i := 0; i < len s; i++)
+		if(s[i] == '/')
+			return 1;
+	return 0;
+}
diff --git a/appl/alphabet/auxi/endpointsrv.b b/appl/alphabet/auxi/endpointsrv.b
new file mode 100644
index 00000000..ea5391e5
--- /dev/null
+++ b/appl/alphabet/auxi/endpointsrv.b
@@ -0,0 +1,58 @@
+implement Endpointsrv;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+
+Endpointsrv: module {
+	init: fn(nil: ref Draw->Context, argv: list of string);
+};
+
+init(nil: ref Draw->Context, argv: list of string)
+{
+	sys = load Sys Sys->PATH;
+	if(len argv != 3)
+		fatal("usage: endpointsrv addr [dir]");
+	addr := hd tl argv;
+	dir := hd tl tl argv;
+	if(sys->bind("#s", dir, Sys->MREPL) == -1)
+		fatal(sys->sprint("cannot bind #s onto %q: %r", dir));
+
+	fio := sys->file2chan(dir, "clone");
+	spawn endpointproc(addr, dir, fio);
+}
+
+endpointproc(addr, dir: string, fio: ref Sys->FileIO)
+{
+	n := 0;
+	for(;;) alt {
+	(offset, nil, nil, rc) := <-fio.read =>
+		if(rc != nil){
+			if(offset > 0)
+				rc <-= (nil, nil);
+			else{
+				mkpipe(dir, string n);
+				rc <-= (array of byte (addr+" "+string n++), nil);
+			}
+		}
+	(nil, nil, nil, wc) := <-fio.write =>
+		if(wc != nil)
+			wc <-= (0, "cannot write");
+	}
+}
+
+mkpipe(dir: string, p: string)
+{
+	sys->bind("#|", "/tmp", Sys->MREPL);
+	d := Sys->nulldir;
+	d.name = p;
+	sys->wstat("/tmp/data", d);
+	d.name = p + ".in";
+	sys->wstat("/tmp/data1", d);
+	sys->bind("/tmp", dir, Sys->MBEFORE);
+}
+
+fatal(e: string)
+{
+	sys->fprint(sys->fildes(2), "endpointsrv: %s\n", e);
+	raise "fail:error";
+}
diff --git a/appl/alphabet/auxi/fsfilter.b b/appl/alphabet/auxi/fsfilter.b
new file mode 100644
index 00000000..a83a5c5b
--- /dev/null
+++ b/appl/alphabet/auxi/fsfilter.b
@@ -0,0 +1,62 @@
+implement Fsfilter;
+include "sys.m";
+include "draw.m";
+include "sh.m";
+include "fslib.m";
+	Fschan, Next, Quit, Skip, Down: import Fslib;
+
+filter[T](t: T, src, dst: Fschan)
+	for{
+	T =>
+		query: fn(t: self T, d: ref Sys->Dir, name: string, depth: int): int;
+	}
+{
+	names: list of string;
+	name: string;
+	indent := 0;
+	myreply := chan of int;
+loop:
+	for(;;){
+		(d, reply) := <-src;
+		if(d.dir != nil){
+			p := name;
+			if(indent > 0){
+				if(p != nil && p[len p - 1] != '/')
+					p[len p] = '/';
+			}
+			if(t.query(d.dir, p + d.dir.name, indent) == 0 && indent > 0){
+				reply <-= Next;
+				continue;
+			}
+		}
+		dst <-= (d, myreply);
+		case reply <-= <-myreply {
+		Quit =>
+			break loop;
+		Next =>
+			if(d.dir == nil && d.data == nil){
+				if(--indent == 0)
+					break loop;
+				(name, names) = (hd names, tl names);
+			}
+		Skip =>
+			if(--indent == 0)
+				break loop;
+			(name, names) = (hd names, tl names);
+		Down =>
+			if(d.dir != nil){
+				names = name :: names;
+				if(d.dir.mode & Sys->DMDIR){
+					if(indent == 0)
+						name = d.dir.name;
+					else{
+						if(name[len name - 1] != '/')
+							name[len name] = '/';
+						name += d.dir.name;
+					}
+				}
+				indent++;
+			}
+		}
+	}
+}
diff --git a/appl/alphabet/auxi/mkfile b/appl/alphabet/auxi/mkfile
new file mode 100644
index 00000000..db753a46
--- /dev/null
+++ b/appl/alphabet/auxi/mkfile
@@ -0,0 +1,21 @@
+<../../../mkconfig
+
+TARG=\
+	endpoints.dis\
+	endpointsrv.dis\
+	rexecsrv.dis\
+	fsfilter.dis\
+
+SYSMODULES=\
+	alphabet.m\
+	alphabet/endpoints.m\
+	alphabet/reports.m\
+	draw.m\
+	sh.m\
+	string.m\
+	sys.m\
+
+DISBIN=$ROOT/dis/alphabet
+
+<$ROOT/mkfiles/mkdis
+LIMBOFLAGS=-F $LIMBOFLAGS
diff --git a/appl/alphabet/auxi/rexecsrv.b b/appl/alphabet/auxi/rexecsrv.b
new file mode 100644
index 00000000..9412d617
--- /dev/null
+++ b/appl/alphabet/auxi/rexecsrv.b
@@ -0,0 +1,301 @@
+implement Rexecsrv;
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "sh.m";
+	sh: Sh;
+include "alphabet/endpoints.m";
+	endpoints: Endpoints;
+	Endpoint: import endpoints;
+include "alphabet/reports.m";
+	reports: Reports;
+	Report: import reports;
+include "alphabet.m";
+	alphabet: Alphabet;
+	Value: import alphabet;
+include "alphabet/abc.m";
+include "alphabet/abctypes.m";
+include "string.m";
+	str: String;
+
+Rexecsrv: module {
+	init: fn(nil: ref Draw->Context, argv: list of string);
+};
+drawctxt: ref Draw->Context;
+
+init(ctxt: ref Draw->Context, argv: list of string)
+{
+	sys = load Sys Sys->PATH;
+	endpoints = load Endpoints Endpoints->PATH;
+	if(endpoints == nil)
+		fatal(sys->sprint("cannot load %s: %r", Endpoints->PATH));
+	endpoints->init();
+	sh = load Sh Sh->PATH;
+	if(sh == nil)
+		fatal(sys->sprint("cannot load %s: %r", Sh->PATH));
+	sh->initialise();
+	reports = load Reports Reports->PATH;
+	if(reports == nil)
+		fatal(sys->sprint("cannot load %s: %r", Reports->PATH));
+	str = load String String->PATH;
+	if(str == nil)
+		fatal(sys->sprint("cannot load %s: %r", String->PATH));
+	if(len argv != 3)
+		fatal("usage: rexecsrv dir {decls}");
+	drawctxt = ctxt;
+	if(sys->stat("/n/endpoint/local/clone").t0 == -1)
+		fatal("no local endpoints available");
+	dir := hd tl argv;
+	decls := parse(hd tl tl argv);
+	if(sys->bind("#s", dir, Sys->MREPL) == -1)
+		fatal(sys->sprint("cannot bind #s onto %q: %r", dir));
+
+	alphabet = declares(decls);
+
+	fio := sys->file2chan(dir, "exec");
+	sync := chan of int;
+	spawn rexecproc(sync, fio);
+	<-sync;
+}
+
+stderr(): ref Sys->FD
+{
+	return sys->fildes(2);
+}
+
+# use one alphabet module to bootstrap another
+# with the desired declarations that we can use to
+# execute external commands.
+declares(decls: ref Sh->Cmd): Alphabet
+{
+	alphabet0 := load Alphabet Alphabet->PATH;
+	if(alphabet0 == nil)
+		fatal(sys->sprint("cannot load %s: %r", Alphabet->PATH));
+	alphabet0->init();
+	abctypes := load Abctypes Abctypes->PATH;
+	if(abctypes == nil)
+		fatal(sys->sprint("cannot load %s: %r", Abctypes->PATH));
+	Abccvt: import abctypes;
+	abc := load Abc Abc->PATH;
+	if(abc == nil)
+		fatal(sys->sprint("cannot load %s: %r", Abc->PATH));
+	abc->init();
+	Value: import abc;
+
+	(c, nil, abccvt) := abctypes->proxy0();
+
+	spawn reports->reportproc(errorc := chan of string, nil, reply := chan of ref Report);
+	r := <-reply;
+	if((err := alphabet0->loadtypeset("/abc", c, nil)) != nil)
+		fatal("cannot load typeset /abc: "+err);
+	alphabet0->setautodeclare(1);
+	spawn alphabet0->eval0(
+		parse("{(/cmd);"+
+			"/abc/abc |"+
+			"/abc/declares $1"+
+			"}"
+		),
+		"/abc/abc",
+		nil,
+		r,
+		r.start("evaldecls"),
+		ref (Alphabet->Value).Vc(decls) :: nil,
+		vc := chan of ref Alphabet->Value
+	);
+	r.enable();
+	av: ref Alphabet->Value;
+wait:
+	for(;;)alt{
+	av = <-vc =>
+		;
+	msg := <-errorc =>
+		if(msg == nil)
+			break wait;
+		sys->fprint(stderr(), "rexecsrv: %s\n", msg);
+	}
+	if(av == nil)
+		fatal("declarations failed");
+	v := abccvt.ext2int(av).dup();
+	alphabet0->av.free(1);
+	pick xv := v {
+	VA =>
+		return xv.i.alphabet;
+	}
+	return nil;
+}
+
+parse(s: string): ref Sh->Cmd
+{
+	(c, err) := sh->parse(s);
+	if(c== nil)
+		fatal(sys->sprint("cannot parse %q: %s", s, err));
+	return c;
+}
+
+lc(cmd: ref Sh->Cmd): ref Sh->Listnode
+{
+	return ref Sh->Listnode(cmd, nil);
+}
+
+lw(word: string): ref Sh->Listnode
+{
+	return ref Sh->Listnode(nil, word);
+}
+
+# write endpoints, cmd
+# read endpoints
+rexecproc(sync: chan of int, fio: ref Sys->FileIO)
+{
+	sys->pctl(Sys->FORKNS, nil);
+	pending: list of (int, string);
+	sync <-= 1;
+	for(;;) alt {
+	(nil, data, fid, wc) := <-fio.write =>
+		if(wc == nil)
+			break;
+		req := string data;
+		l := str->unquoted(req);
+		if(len l != 2 || Endpoint.mk(hd l).addr == nil){
+			wc <-= (0, "bad request");
+			break;
+		}
+		pending = (fid, req) :: pending;
+		wc <-= (0, nil);
+	(offset, nil, fid, rc) := <-fio.read =>
+		if(rc == nil){
+			(pending, nil) = removefid(fid, pending);
+			break;
+		}
+		if(offset > 0){
+			rc <-= (nil, nil);
+			break;
+		}
+		req: string;
+		(pending, req) = removefid(fid, pending);
+		if(req == nil){
+			rc <-= (nil, "no pending exec");
+			break;
+		}
+		l := str->unquoted(req);
+		spawn exec(sync1 := chan of int, Endpoint.mk(hd l), hd tl l, rc);
+		<-sync1;
+	}
+}
+
+gather(errorc: chan of string)
+{
+	s := "";
+	while((e := <-errorc) != nil)
+		s += e + "\n";
+	errorc <-= s;
+}
+
+exec(sync: chan of int, ep: Endpoint, expr: string,
+		rc: chan of (array of byte, string))
+{
+	sys->pctl(Sys->FORKNS, nil);
+	sync <-= 1;
+
+	spawn gather(errorc := chan of string);
+	(c, err) := alphabet->parse(expr);
+	if(c == nil){
+		rc <-= (nil, "parse error: "+err);
+		return;
+	}
+	usage: string;
+	(c, usage) = alphabet->rewrite(c, "/fd", errorc);
+	errorc <-= nil;
+	err = <-errorc;
+	if(c == nil){
+		rc <-= (nil, err);
+		return;
+	}
+	if(!alphabet->typecompat("/fd -> /fd", usage).t0)
+		rc <-= (nil, "incompatible type: "+usage);
+
+	fd0: ref Sys->FD;
+	(fd0, err) = endpoints->open(nil, ep);
+	if(fd0 == nil){
+		rc <-= (nil, err);
+		return;
+	}
+	(fd1, ep1) := endpoints->create("local");
+	if(fd1 == nil){
+		rc <-= (nil, "cannot make endpoints: "+ep1.about);
+		return;
+	}
+	rc <-= (array of byte ep1.text(), nil);
+
+	runcmd(c, fd0, fd1);
+}
+
+fdproc(f: chan of ref Sys->FD, fd0: ref Sys->FD)
+{
+	f <-= fd0;
+	fd1 := <-f;
+	if(fd1 == nil)
+		exit;
+	buf := array[Sys->ATOMICIO] of byte;
+	while((n := sys->read(fd0, buf, len buf)) > 0)
+		if(sys->write(fd1, buf, n) == -1)
+			break;
+}
+
+runcmd(c: ref Sh->Cmd, fd0, fd1: ref Sys->FD)
+{
+	f := chan of ref Sys->FD;
+	spawn fdproc(f, fd0);
+
+	spawn reports->reportproc(errorc := chan of string, nil, reply := chan of ref Report);
+	r := <-reply;
+	spawn alphabet->eval0(
+		c,
+		"/fd",
+		drawctxt,
+		r,
+		r.start("evalcmd"),
+		ref (Alphabet->Value).Vf(f) :: nil,
+		vc := chan of ref Alphabet->Value
+	);
+	r.enable();
+	av: ref Alphabet->Value;
+wait:
+	for(;;)alt{
+	av = <-vc =>
+		if(av == nil){
+			sys->fprint(stderr(), "rexecsrv: no value received\n");
+			break;
+		}
+		pick v := av {
+		Vf =>
+			<-v.i;
+			v.i <-= fd1;
+		* =>
+			sys->fprint(stderr(), "rexecsrv: can't happen: expression has wrong type '%c'\n",
+					alphabet->v.typec());
+		}
+	msg := <-errorc =>
+		if(msg == nil)
+			break wait;
+		# XXX could queue diagnostics back to caller here.
+		sys->fprint(stderr(), "rexecsrv: %s\n", msg);
+	}
+	sys->write(fd1, array[0] of byte, 0);
+}
+
+removefid(fid: int, l: list of (int, string)): (list of (int, string), string)
+{
+	if(l == nil)
+		return (nil, nil);
+	if((hd l).t0 == fid)
+		return (removefid(fid, tl l).t0, (hd l).t1);
+	(rl, d) := removefid(fid, tl l);
+	return (hd l :: rl, d);
+}
+
+fatal(e: string)
+{
+	sys->fprint(sys->fildes(2), "rexecsrv: %s\n", e);
+	raise "fail:error";
+}
+