#  This program derives from Plan B's omero, and thus, is twice that big.
#  That puts a limit on the number of omero descendants.

#  The o/mero file server. This program does not draw at all.
#  Viewers are started to perform actual user I/O according to
#  subtrees provided by this file server. 
# 
#  The tree has one directory for applications, /appl. They create their
#  uis inside. Subdirs of /appl represent a top-level panel for the application.
#  Each directory created at the root represents a screen (or viewer),
#  and is provided so that o/live can attach to it. 
#
# Applications use /appl/* files to setup their UI, and perform I/O.
# Viewers use trees outside /appl, to perform I/O.
#
# Selection is maintained outside. /dev/sel /dev/snarf maintain the user selection and
# the clipboard, and can be operated from outside. It is o/live the one filling them upon
# cut and paste operations.
#
# Event channels are not implemented by this program. ports(4) is used to
# listen for o/mero events and to deliver o/mero events. Events posted for applications
# start with "o/mero: <appdir>". Events posted for viewers start with "o/mero: <viewdir>"
# Events:
#	from o/mero to o/live (via o/ports):
#		"o/mero: /screen/path/for/panel update"
#		"o/mero: /screen/path/for/panel image"
#		"o/mero: /screen/path/for/panel top"
#		"o/mero: /screen/path/for/panel ins pos string"
#		"o/mero: /screen/path/for/panel del pos n"
#
#	from o/live or appl. to o/mero (via ctl):
#		show/hide
#		col/row
#		dirty/clean
#		"click %d %d %d %d"
#		"keys %s"
#		"interrupt"
#		"look string"
#		"exec string"
#		"apply string"
#		"copyto /another/path [pos]"
#		"moveto /another/path [pos]"
#		"ins pos string"
#		"del pos n"
#		"top"
#		"pos n"
#		"hold"
#		"release"
#
#	from o/mero to application (via o/ports):
#		"o/mero: /appl/path/for/panel look string"
#		"o/mero: /appl/path/for/panel exec string"
#		"o/mero: /appl/path/for/panel apply string"
#		"o/mero: /appl/path/for/panel close"
#		"o/mero: /appl/path/for/panel click %d %d %d %d"
#		"o/mero: /appl/path/for/panel keys %s"
#		"o/mero: /appl/path/for/panel interrupt"
#		"o/mero: /appl/path/for/panel clean"
#		"o/mero: /appl/path/for/panel dirty"
#
# Qids refer to
# panels and replicas. When panels are replicated the tree is still
# a tree, and not a DAG. Only that several files would refer to the
# same panels (but different replicas).
#
# The main program logic is kept here.
# merotree provides panel routines that deal with both the panels and their
# files in the tree, to avoid races.
# panel keeps the data and attributes for panels, and most basic routines.
# omp* files implement mostly syntax checking for panels, and provide extra
# panel-specific attributes.

implement Omero;
include "sys.m";
	Dir, pctl, NEWPGRP, DMDIR, open, OTRUNC, OREAD, FD, OWRITE, ORCLOSE, FORKFD,
	ORDWR, FORKNS, NEWFD, MREPL, MBEFORE, MAFTER, MCREATE, pipe, mount,
	fprint, write, sprint, tokenize, bind, create, pwrite, read, QTDIR, QTFILE, fildes, Qid: import sys;
include "draw.m";
include "styx.m";
	Rmsg, Tmsg: import styx;
include "error.m";
	checkload, stderr, panic, kill, error: import err;
include "styxservers.m";
	Styxserver, readbytes, readstr, Navigator, Fid: import styxs;
	nametree: Nametree;
	Tree: import nametree;
include "daytime.m";
	now: import daytime;
include "arg.m";
	arg: Arg;
	usage: import arg;
include "string.m";
	splitl, splitr: import str;
include "env.m";
	env: Env;
	getenv: import env;
include "mpanel.m";
	Panel, Repl, Tappl, Trepl, qid2ids: import panels;
include "names.m";
include "dat.m";
	dat: Dat;
	Qdir, Qctl, Qdata, Qimage: import Dat;
include "merotree.m";
	merotree: Merotree;
	pchanged, pcreate, mkcol, chpos, premove,
	moveto, mktree, copyto: import merotree;
include "meroox.m";
	ox: Meroox;

Omero: module {
	init: fn(nil: ref Draw->Context, argv: list of string);
	mnt:		string;
	debug:	int;
	appl:		big;
	slash:	big;
	user:		string;

	srv:		ref Styxserver;
	evc:		chan of (int, string, string);
	sys:	Sys;
	err:	Error;
	str:	String;
	panels: Panels;
	names: Names;
	styx: Styx;
	styxs: Styxservers;
	daytime: Daytime;
};

# The image for each panel is kept empty, until a Image command is issued in
# a viewer. At that point, the image file is updated by the viewer and it can be read
# from the FS. An "image" event to request image dumps from the PC is also needed.

fsopen(m: ref Tmsg.Open): ref Rmsg
{
	(fid, mode, d, e) := srv.canopen(m);
	if (e != nil)
		return ref Rmsg.Error(m.tag, e);
	(pid, rid, qt) := qid2ids(fid.path);
	(p, r) := Panel.lookup(pid, rid);
	if (p == nil || r == nil)
		return ref Rmsg.Error(m.tag, "panel removed");
	case qt {
	Qdir =>
		return nil;
	Qdata or Qimage=>
		if (mode != OREAD && (m.mode&OTRUNC) != 0){
			if (qt == Qdata){
				p.put(nil, big 0);
				pchanged(p, 1, 0);
				if (r.id != 0)
					p.post("update");
				p.vpost(r, "update");
			} else
				p.putimage(nil, big 0);
		}
	}
	fid.open(mode, d.qid);
	return ref Rmsg.Open(m.tag, d.qid, srv.iounit());
}

fscreate(m: ref Tmsg.Create): ref Rmsg
{
	(fid, mode, d, e) := srv.cancreate(m);
	if (e != nil)
		return ref Rmsg.Error(m.tag,  e);
	if ((m.perm&DMDIR) == 0)
		return ref Rmsg.Error(m.tag, "can only create directories");
	(pid, rid, nil) := qid2ids(fid.path);
	(p, r) := Panel.lookup(pid, rid);
	if (p == nil || r == nil)
		return ref Rmsg.Error(m.tag, "panel removed");
	if (!p.container)
		return ref Rmsg.Error(m.tag, "parent is not a container");
	if (1 == 0 && r.tree != Tappl && fid.path != slash)			# permit this by now
		return ref Rmsg.Error(m.tag, "can't create in a view subtree");
	np := pcreate(p, r, d.name);
	if (np == nil)
		return ref Rmsg.Error(m.tag, "bad panel type");
	if (r.dirq == slash && ox != nil)
		ox->start(np.repl[0].path);
	nq := Qid(np.repl[0].dirq,0,QTDIR);
	d.atime = d.mtime = now();
	fid.open(mode, nq);
	return ref Rmsg.Create(m.tag, nq, srv.iounit());
}

fsremove(m: ref Tmsg.Remove): ref Rmsg
{
	(fid, nil, e) := srv.canremove(m);	# childs ?
	srv.delfid(fid);
	if (e != nil)
		return ref Rmsg.Error(m.tag, e);

	(pid, rid, nil) := qid2ids(fid.path);
	(spid, nil, nil) := qid2ids(slash);
	(apid, nil, nil) := qid2ids(appl);
	(p, r) := Panel.lookup(pid, rid);
	if (p == nil || r == nil)
		return ref Rmsg.Error(m.tag, "panel removed");
	if (pid == spid || pid == apid || r.tree == Trepl)
		return ref Rmsg.Error(m.tag, "permission denied");

	# Remove the panel, now. From now on, any request made to files for
	# the removed panel will fail with an error message indicating that
	# the panel was already removed. But the panel is gone now.
	premove(p, r, 0);
	return ref Rmsg.Remove(m.tag);
}

fsclunk(m: ref Tmsg.Clunk): ref Rmsg
{
	fid := srv.getfid(m.fid);
	if(fid == nil)
		return ref Rmsg.Error(m.tag, "bad fid");
	(pid, rid, nil) := qid2ids(fid.path);
	(p, r) := Panel.lookup(pid, rid);
	if (p != nil && r != nil && r.tree == Tappl)
	if (fid.isopen && (fid.mode&ORCLOSE))
		premove(p, r, 0);
	srv.delfid(fid);
	return ref Rmsg.Clunk(m.tag);
}

fsread(m: ref Tmsg.Read): ref Rmsg
{
	(fid, e) := srv.canread(m);
	if (e != nil)
		return ref Rmsg.Error(m.tag, e);
	if (fid.qtype&QTDIR)
		return nil;
	(pid, rid, qt) := qid2ids(fid.path);
	(p, r) := Panel.lookup(pid, rid);
	if (p == nil || r == nil)
		return ref Rmsg.Error(m.tag, "panel removed");
	case qt {
	Qctl =>
		s := p.ctlstr(r);
		return readstr(m, s);
	Qdata =>
		return readbytes(m, p.data);
	Qimage =>
		return readbytes(m, p.image);
	* =>
		panic("bad file type");
	}
	return nil;
}

unescape(s: string): string
{
	for (i := 0; i < len s; i++)
		if (s[i] == 1)
			s[i] = '\n';
	return s;
}

postctl(p: ref Panel, nil: ref Repl, c: string): string
{
	p.post(c);
	return nil;
}

execctl(p: ref Panel, r: ref Repl, c: string): string
{
	cmd := c[5:];
	case cmd {
	"Ox" =>
		if (ox != nil)
			ox->start(r.path);
	"New" =>
		mkcol(p, r);
	"Del" =>
		premove(p, r, 0);
	* =>
		p.post(c);
	}
	return nil;
}

imagectl(p: ref Panel, r: ref Repl, nil: string): string
{
	r.post(p.pid, "image");
	return nil;
}

topctl(p: ref Panel, r: ref Repl, nil: string): string
{
	if (!p.container)
		return "not a container";
	r.post(p.pid, "top");
	return nil;
}

movetoctl(p: ref Panel, r: ref Repl, c: string): string
{
	(n, args) := tokenize(c, " ");
	case n {
	2 =>
		path := hd tl args;
		if (path[0] != '/')
			path = "/" + path;
		return moveto(p, r, path, -1);
	3 =>
		path := hd tl args;
		if (path[0] != '/')
			path = "/" + path;
		return moveto(p, r, path, int hd tl tl args);
	* =>
		return "wrong number of arguments";
	}
} 

copytoctl(p: ref Panel, r: ref Repl, c: string): string
{
	(n, args) := tokenize(c, " ");
	case n {
	2 =>
		path := hd tl args;
		if (path[0] != '/')
			path = "/" + path;
		return copyto(p, r, path, -1);
	3 =>
		path := hd tl args;
		if (path[0] != '/')
			path = "/" + path;
		return copyto(p, r, path, int hd tl tl args);
	* =>
		return "wrong number of arguments";
	}
}

posctl(p: ref Panel, r: ref Repl, c: string): string
{
	(n, args) := tokenize(c, " ");
	case n {
	2 =>
		chpos(p, r, int hd tl args);
	* =>
		return "wrong number of arguments";
	}
}

dumpctl(nil: ref Panel, nil: ref Repl, nil: string): string
{
	panels->dump();
	merotree->dump();
	return nil;
}

nopctl(nil: ref Panel, nil: ref Repl, nil: string): string
{
	return nil;
}

holdrlsectl(p: ref Panel, nil: ref Repl, c: string): string
{
	(n, args) := tokenize(c, " ");
	case n {
	1 =>
		if (hd args == "hold")
			holdc <-= p.pid;
		else
			rlsec <-= p.pid;
	* =>
		return "wrong number of arguments";
	}
}

Ctlcmd: type ref fn(p: ref Panel, r: ref Repl, c: string): string;
Ctl: adt {
	name:	string;
	cmd:		Ctlcmd;
};

ctlcmds: array of Ctl;

fswrite(m: ref Tmsg.Write): ref Rmsg
{
	if (ctlcmds == nil)
		ctlcmds = array[] of {
			Ctl("click ", postctl),
			Ctl("keys ", postctl),
			Ctl("look ", postctl),
			Ctl("exec ", execctl),
			Ctl("apply ", postctl),
			Ctl("moveto ", movetoctl),
			Ctl("copyto ", copytoctl),
			Ctl("dump", dumpctl),
			Ctl("order ", nopctl),
			Ctl("image", imagectl),
			Ctl("top", topctl),
			Ctl("pos", posctl),
			Ctl("hold", holdrlsectl),
			Ctl("release", holdrlsectl)
		};
	(fid, e) := srv.canwrite(m);
	if (e != nil)
		return ref Rmsg.Error(m.tag, e);
	(pid, rid, qt) := qid2ids(fid.path);
	(p, r) := Panel.lookup(pid, rid);
	if (p == nil || r == nil)
		return ref Rmsg.Error(m.tag, "panel removed");
	case qt {
	Qctl =>
		(nil, ctls) := tokenize(string m.data, "\n");
		update := 0;
		dirties := cleans := 0;
		for(; ctls != nil; ctls = tl ctls){
			if (debug)
				fprint(stderr, "o/mero: %s: ctl: %s\n", r.path, hd ctls);
			ctl := unescape(hd ctls);
			for (i := 0; i < len ctlcmds; i++){
				l := len ctlcmds[i].name;
				if (len ctl >= l && ctl[0:l] == ctlcmds[i].name)
					break;
			}
			e: string;
			u := 0;
			if (i == len ctlcmds)
				(u, e) = p.ctl(r, ctl);
			else {
				x := ctlcmds[i];
				e =x.cmd(p, r, ctl);
			}
			if (u == 2){
				# Kludge, ins & del need special update rules.
				# We send data via events posted to replicas to be updated.
				for (rn := 1; rn < len p.repl; rn++)
					if ((pr := p.repl[rn]) != nil && pr != r)
						pr.post(p.pid, hd ctls);
				u = 0;
			}
			update |= u;
			if (e != nil){
				if (update){
					pchanged(p, 0, 1);
					p.vpost(nil, "update");
				}
				return ref Rmsg.Error(m.tag, e);
			}
			# more special cases, ugh.
			if (r.id != 0 && ctl == "dirty")
				dirties = 1;
			if (r.id != 0 && ctl == "clean")
				cleans = 1;
		}
		if (update){
			pchanged(p, 0, 1);
			p.vpost(r, "update");
		}
		# This two ctls cause notification to the application
		if (dirties)
			p.post("dirty");
		if (cleans)
			p.post("clean");
		return ref Rmsg.Write(m.tag, len m.data);
	Qdata =>
		# Can't report errors on close!
		# But why should we bother? nobody checks those anyway.
		(nw, ew) := p.put(m.data, m.offset);
		if (ew != nil)
			return ref Rmsg.Error(m.tag, ew);
		e = p.newdata();
		pchanged(p, 1, 0);
		if (r.id != 0)
			p.post("update");
		p.vpost(r, "update");
		if (e != nil)
			return ref Rmsg.Error(m.tag, e);
		else
			return ref Rmsg.Write(m.tag, nw);
	Qimage =>
		(nw, ew) := p.putimage(m.data, m.offset);
		if (ew != nil)
			return ref Rmsg.Error(m.tag, ew);
		return ref Rmsg.Write(m.tag, nw);
	* =>
		panic("bad file type");
	}
	return nil;
}

fsreq(req: ref Tmsg) : ref Rmsg
{
	pick m := req {
	Open =>
		return fsopen(m);
	Create =>
		return fscreate(m);
	Remove =>
		return fsremove(m);
	Read =>
		return fsread(m);
	Write =>
		return fswrite(m);
	Clunk =>
		return fsclunk(m);
	* =>
		return nil;
	}
}

readall(fname: string) : string
{
	fd := open(fname, OREAD);
	if (fd == nil)
		return "none";
	max : con int 1024;
	data := array[max] of byte;
	tot := nr := 0;
	do {
		nr = read(fd, data[tot:], len data - tot);
		if (nr > 0)
			tot += nr;
	} while(nr > 0 && tot < len data);
	if (tot == 0)
		return "none";
	return string data[0:tot];
	
}

# To hold events, we send the event process the pid of the ones to hold/release.
# Events matching the held pid are kept until the pid is released or the hold is
# timedout.
# It would be better not to post the held events in the first place, but that's quite
# difficult to get right. This is a lot more inefficient but also a lot easier.
Held: adt {
	pid:	int;
	cnt:	int;
	evs:	list of (string, string);	#path, ev
	time:	int;
};

holdc: chan of int;
rlsec: chan of int;

deliver(fd: ref FD, path: string, ev: string)
{
	data := array of byte sprint("o/mero: %s %s\n", path, ev);
	if (write(fd, data, len data) != len data)
		error("o/mero: post: short write");
	if (debug)
		fprint(stderr, "o/mero: event: [o/mero: %s %s]\n", path, ev);
}

pack(l: list of (string, string)): list of (string, string)
{
	return l;
	# for each element in l, remove events that refer to suffixes if
	# the event is the same. This way we send a single event for
	# an entire set of events for a subtree.
	evs := array[len l] of (string, string);
	for(i := 0; l != nil; l = tl l)
		evs[i++] = hd l;
	for(i = 0; i < len evs; i++)
		for(j := 0; j < len evs; j++)
			if (evs[i].t0 != nil)
			if (names->isprefix(evs[i].t0, evs[j].t0) && evs[i].t1 == evs[j].t1)
				evs[j].t0 = nil;
	
	nl: list of (string, string);
	for (i = 0; i < len evs; i++)
		if (evs[i].t0 != nil)
			nl = evs[i]::nl;
	return nl;
}

eventproc(fd: ref FD)
{
	held: list of ref Held;
	held = nil;
	for(;;){
		alt {
		pid := <-holdc =>
			if (debug)
				fprint(stderr, "o/mero: pid %d held\n", pid);
			for (l := held; l != nil; l = tl l){
				h := hd l;
				if (h.pid == pid){
					h.cnt++;
					break;
				}
			}
			if (l == nil)
				held = ref Held(pid, 1, nil, now())::held;
		pid := <-rlsec =>
			nl: list of ref Held;
			nl = nil;
			t := now();
			for (; held != nil; held = tl held){
				h := hd held;
				if ((h.pid == pid && --h.cnt <=0) || t - h.time > 5){
					h.evs = pack(h.evs);
					for (; h.evs != nil; h.evs = tl h.evs)
						deliver(fd, (hd h.evs).t0, (hd h.evs).t1);
				} else
					nl = h::nl;
			}
			held = nl;
		(pid, path, ev) := <- evc =>
			if (ev == nil)
				break;
			for (l := held; l != nil; l = tl l){
				h := hd l;
				if (h.pid == pid){
					h.evs = (path,ev)::h.evs;
					break;
				}
			}
			if (l == nil)
				deliver(fd, path, ev);
		}
	}
	fprint(stderr, "o/mero: exiting\n");
}

fs(pidc: chan of int, fd: ref FD)
{
	styx->init();
	styxs->init(styx);
	if (pidc != nil)
		pctl(FORKNS|NEWPGRP|NEWFD, list of {0,1,2,fd.fd});
	else
		pctl(NEWPGRP, nil);
	stderr = fildes(2);
	efd := open("/mnt/ports/post", OWRITE);
	if (efd == nil){
		fprint(stderr, "o/mero: fatal: ports/post: %r\n");
		pidc <-= -1;
	} else
		pidc <-= pctl(0, nil);
	spawn eventproc(efd);
	efd = nil;
	stderr = fildes(2);
	if (debug)
		fprint(stderr, "echo killgrp >/prog/%d/ctl\n", pctl(0,nil));
	navc := merotree->init(dat);
	nav := Navigator.new(navc);
	(reqc, fssrv) := Styxserver.new(fd, nav, big 0); # / must have qid (0,0,QTDIR)
	srv = fssrv;
	mktree();
	for (;;) {
		req := <-reqc;
		if (req == nil)
			break;
		rep := fsreq(req);
		if (rep == nil)
			srv.default(req);
		else
			srv.reply(rep);
	}
	srv = nil;
	kill(pctl(0, nil),"killgrp");	# be sure to quit
}

init(nil: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	err = load Error Error->PATH;
	err->init();
	str = checkload(load String String->PATH, String->PATH);
	styx = checkload(load Styx Styx->PATH, Styx->PATH);
	styxs = checkload(load Styxservers Styxservers->PATH, Styxservers->PATH);
	nametree = checkload(load Nametree Nametree->PATH, Nametree->PATH);
	names = checkload(load Names Names->PATH, Names->PATH);
	nametree->init();
 	daytime = checkload(load Daytime Daytime->PATH, Daytime->PATH);
	evc = chan[10] of (int, string, string);
	holdc = chan[10] of int;
	rlsec = chan[10] of int;
	dat = load Dat "$self";
	if (dat == nil)
		error(sprint("can't load dat: %r"));
	panels = checkload(load Panels Panels->PATH, Panels->PATH);
	panels->init(dat, "/dis/o");
	env = checkload(load Env Env->PATH, Env->PATH);
	arg = checkload(load Arg Arg->PATH, Arg->PATH);
	panels = checkload(load Panels Panels->PATH, Panels->PATH);
	merotree = checkload(load Merotree Merotree->PATH, Merotree->PATH);
 	user = getenv("user");
	if (user == nil)
		user = readall("/dev/user");
	arg->init(args);
	arg->setusage("o/mero [-abcdi] [-m mnt]");
	mnt = "/n/ui";
	flag := MREPL|MCREATE;
	while((opt := arg->opt()) != 0) {
		case opt{
		'b' =>
			flag = MBEFORE;
		'a' =>
			flag = MAFTER;
		'c' =>
			flag |= MCREATE;
		'i' =>
			mnt = nil;
		'm' =>
			mnt = arg->earg();
		'd' =>
			debug++;
			if (debug > 1)
				styxs->traceset(1);
		* =>
			usage();
		}
	}
	args = arg->argv();
	if (len args != 0)
		usage();
	panels->init(dat, "/dis/o");
	pidc := chan[1] of int;
	if (mnt == nil)
		fs(pidc, fildes(0));
	else {
		# ox = checkload(load Meroox Meroox->PATH, Meroox->PATH);
		pfds := array[2] of ref FD;
		if (pipe(pfds) < 0)
			error(sprint("o/mero: pipe: %r"));
		spawn fs(pidc, pfds[0]);
		pid := <-pidc;
		if (pid < 0)
			exit;
		if (mount(pfds[1], nil, mnt, flag, nil) < 0)
			error(sprint("o/mero: mount: %r"));
		pfds[0] = nil;
	}
}