implement Envsrv;

#
# Copyright © 1999 Vita Nuova Limited.  All rights reserved.
#

include "sys.m";
	sys: Sys;
	stderr: ref Sys->FD;
	CHDIR: import Sys;
include "draw.m";
include "styxlib.m";
	styx: Styxlib;
	Dirtab, Styxserver, Tmsg, Rmsg, Chan,
	devdir,
	Eperm, Ebadfid, Eexists, Enotdir, Enotfound: import styx;

Etoobig: con "file too big";
Etooshort: con "read too short";

devgen: Dirgenmod;

MAXVARSIZE: con 16300;		# same as in plan9

Envsrv: module {
	init: fn(nil: ref Draw->Context, argv: list of string);
	dirgen: fn(srv: ref Styxserver, c: ref Styxlib->Chan,
				tab: array of Dirtab, s: int): (int, Sys->Dir);
};

init(nil: ref Draw->Context, argv: list of string)
{
	sys = load Sys Sys->PATH;
	stderr  = sys->fildes(2);
	styx = load Styxlib Styxlib->PATH;
	if (styx == nil) {
		sys->fprint(stderr, "envsrv: couldn't load %s: %r\n", Styxlib->PATH);
		return;
	}

	devgen = load Dirgenmod "$self";
	if (devgen == nil) {
		sys->fprint(stderr, "envsrv: couldn't load self as Dirgenmod: %r\n");
		return;
	}
	mountpoint := "/";
	if (len argv > 1)
		mountpoint = hd tl argv;

	sync := chan of string;
	spawn doit(sync, mountpoint);
	err := <-sync;
	if (err != nil)
		sys->raise("fail:"+err);
}

doit(errsync: chan of string, mountpoint: string)
{
	sys->pctl(Sys->FORKFD, nil);

	fds := array[2] of ref Sys->FD;
	sys->pipe(fds);
	sync := chan of int;
	spawn serveloop(fds[0], sync);
	<-sync;

	if (sys->mount(fds[1], mountpoint, Sys->MAFTER, nil) == -1) {
		sys->fprint(stderr, "envsrv: mount failed: %r\n");
		errsync <-= "mount failed";
	} else
		errsync <-= nil;
}

Qtopdir,
Q2nd,
Q3rd,
Qctl,
Qclone,
Q4th,
Qvar: con iota;

TYPESHIFT	: con 0;
TYPEMASK	: con 16r7;
ENVSHIFT		: con 3;
ENVMASK		: con 16r1fff;
VARSHIFT		: con 16;
VARMASK		: con 16rffff;

VARHASHSIZE	: con 27;

Var: adt {
	id		: int;
	name	: string;
	val		: array of byte;
};

Hashent: adt {
	vars		: list of ref Var;
	maxslotid	: int;
};

Varlist: adt {
	vh		: array of Hashent;
	copies	: int;
};	

Env: adt {
	refcnt	: int;
	id		: int;
	v		: ref Varlist;
};

env := array[10] of ref Env;
maxenvid := 0;

perm := array[TYPEMASK + 1] of {
	Qtopdir =>	8r555,
	Q2nd =>		8r555,
	Q3rd =>		8r555,
	Qctl =>		8r600,
	Qclone =>		8r600,
	Q4th =>		8r755,
	Qvar =>		8r600,
};

dirgen(srv: ref Styxserver, c: ref Styxlib->Chan,
				nil: array of Dirtab, s: int): (int, Sys->Dir)
{
	q: Sys->Qid;
	d: Sys->Dir;
	q.vers = 0;

	t := (c.qid.path >> TYPESHIFT) & TYPEMASK;
	case t {
	Qtopdir =>
		# top level contains just a directory named "env"
		if (s == 0) {
			q.path = CHDIR|(Q2nd<<TYPESHIFT);
			return (1, devdir(c, q, "env", big 0, srv.uname, perm[Q2nd]));
		}
		return (-1, d);
	Q2nd =>
		# second level contains one directory for each environment copy.
		for (i := 0; i < len env; i++)
			if (env[i] != nil && s-- == 0)
				break;
		if (i >= len env)
			return (-1, d);
		e := env[i];
		q.path = CHDIR|(i << ENVSHIFT)|(Q3rd<<TYPESHIFT);
		return (1, devdir(c, q, string e.id, big 0, srv.uname, perm[Q3rd]));
	Q3rd or Qctl or Qclone =>
		# third level contains files ctl and clone, and directory env.
		slot := c.qid.path & (ENVMASK << ENVSHIFT);
		case s {
		0 =>
			q.path = Qctl << TYPESHIFT | slot;
			return (1, devdir(c, q, "ctl", big 0, srv.uname, perm[Qctl]));
		1 =>
			q.path = Qclone << TYPESHIFT | slot;
			return (1, devdir(c, q, "clone", big 0, srv.uname, perm[Qclone]));
		2 =>
			q.path = CHDIR | (Q4th << TYPESHIFT) | slot;
			return (1, devdir(c, q, "env", big 0, srv.uname, perm[Q4th]));
		* =>
			return (-1, d);
		}
	Q4th or Qvar =>
		# fourth level contains one file for each environment variable.
		eslot := (c.qid.path >> ENVSHIFT) & ENVMASK;
		if (eslot >= len env)
			return (-1, d);
		v := env[eslot].v.vh;
		var: ref Var;
		loop: for (i := 0; i < len v; i++) {
			for (vl := v[i].vars; vl != nil; vl = tl vl)
				if (s-- == 0) {
					var = hd vl;
					break loop;
				}
		}
		if (var == nil)
			return (-1, d);

		q.path = (Qvar << TYPESHIFT)
					| ((eslot&ENVMASK)<<ENVSHIFT)
					| (var.id<<VARSHIFT);
		return (1, devdir(c, q, var.name, big len var.val, srv.uname, perm[Qvar]));
	* =>
		return (-1, d);
	}
}

serveloop(fd: ref Sys->FD, sync: chan of int)
{
	sys->pctl(Sys->FORKNS|Sys->NEWFD, 1::2::fd.fd::nil);
	sync <-= 1;

	stderr = sys->fildes(2);	# gotcha!

	(tchan, srv) := Styxserver.new(fd);
	fd = nil;
	env[0] = newenv();
	for (;;) {
		gm := <-tchan;
		if (gm == nil) {
			sys->fprint(stderr, "envsrv: exiting\n");
			exit;
		}
		e := ref Sys->Exception;
		if (sys->rescue("panic:*", e) == Sys->EXCEPTION) {
			sys->rescued(Sys->ACTIVE, nil);
			sys->fprint(stderr, "envsrv: %s\n", e.name);
			srv.reply( ref Rmsg.Error(gm.tag, e.name[len "panic:":]));
			continue;
		}

		pick m := gm {
		Readerror =>
			sys->fprint(stderr, "envsrv: got read error: '%s'; exiting\n", m.error);
			exit;
		Nop =>
			srv.reply( ref Rmsg.Nop(m.tag));
		Flush =>
			srv.devflush(m);
		Clone =>
			c := fid2chan(srv, m.fid);
			case (c.qid.path >> TYPESHIFT) & TYPEMASK {
			Q2nd or Qtopdir =>
				srv.devclone(m);
				break;
			* =>
				eslot := qid2eslot(c.qid.path);
				nc := srv.devclone(m);
				if (nc != nil)
					incref(eslot);
			}
		Walk =>
			envwalk(srv, m);
		Open =>
			c := fid2chan(srv, m.fid);
			t := (c.qid.path >> TYPESHIFT) & TYPEMASK;
			if (c.qid.path & CHDIR && m.mode != Sys->OREAD
					|| !styx->openok(m.mode, perm[t],
							c.uname, srv.uname, srv.uname)) {
				srv.reply( ref Rmsg.Error(m.tag, Eperm));
				break;
			}

			case t {
			Qclone =>
				slot := qid2eslot(c.qid.path);
				nslot := cloneenv(env[slot]);
				c.qid.path = (Qctl << TYPESHIFT) | (nslot << ENVSHIFT);
				decref(slot);
				incref(nslot);
			Qvar =>
				slot := qid2eslot(c.qid.path);
				copyifneeded(env[slot]);
				if (m.mode & Sys->OTRUNC)
					chan2var(c).val = nil;
			}

			c.open = 1;
			c.mode = m.mode;
			srv.reply(ref Rmsg.Open(m.tag, m.fid, c.qid));
		Create =>
			c := fid2chan(srv, m.fid);
			if (((c.qid.path >> TYPESHIFT) & TYPEMASK) != Q4th) {
				srv.reply( ref Rmsg.Error(m.tag, Eperm));
				break;
			}
			eslot := qid2eslot(c.qid.path);
			e := env[eslot];
			if (lookup(e, m.name) != nil) {	
				srv.reply( ref Rmsg.Error(m.tag, Eexists));
				break;
			}
			copyifneeded(e);
			vslot := hashfn(m.name, VARHASHSIZE);
			vent := e.v.vh[vslot:];
			var := ref Var(vslot+vent[0].maxslotid*VARHASHSIZE, m.name, nil);
			vent[0].maxslotid++;
			vent[0].vars = var :: vent[0].vars;
			c.qid.path = (Qvar<<TYPESHIFT)|(eslot<<ENVSHIFT)|(var.id<<VARSHIFT);
			c.open = 1;
			c.path = m.name;
			c.mode = m.mode;
			srv.reply( ref Rmsg.Create(m.tag, m.fid, c.qid));
		Read =>
			c := fid2chan(srv, m.fid);
			if (c.qid.path & CHDIR) {
				srv.devdirread(m, devgen, nil);
				break;
			}
			case (c.qid.path >> TYPESHIFT) & TYPEMASK {
			Qclone =>
				sys->raise("panic: read of clone file");
			Qctl =>
				# offset ignored so that several processes reading
				# on the same fd can all get the correct ctl id.
				ctldata := array of byte string env[qid2eslot(c.qid.path)].id;
				if (m.count < len ctldata)
					srv.reply(ref Rmsg.Error(m.tag, Etooshort));
				else
					srv.reply(ref Rmsg.Read(m.tag, m.fid, ctldata));
			Qvar =>
				srv.reply( styx->readbytes(m, chan2var(c).val));
			* =>
				sys->raise(sys->sprint("panic: bad qid type 16r%ux", c.qid.path));
			}
		Write =>
			envwrite(srv, m);
		Clunk =>
			c := fid2chan(srv, m.fid);
			srv.chanfree(c);
			t := (c.qid.path >> TYPESHIFT) & TYPEMASK;
			if (t != Qtopdir && t != Q2nd)
				decref(qid2eslot(c.qid.path));
			srv.reply( ref Rmsg.Clunk(m.tag, m.fid));
		Stat =>
			srv.devstat(m, devgen, nil);
		Remove =>
			envremove(srv, m);
		Wstat =>
			srv.reply( ref Rmsg.Error(m.tag, Eperm));
		Attach =>
			srv.devattach(m);
		}
	}
}


envwalk(srv: ref Styxserver, m: ref Tmsg.Walk)
{
	c := fid2chan(srv, m.fid);
	if (!c.isdir()) {
		srv.reply( ref Rmsg.Error(m.tag, Enotdir));
		return;
	}
	t := (c.qid.path >> TYPESHIFT) & TYPEMASK;
	if (m.name == "..") {
		case t {
		Q2nd =>
			c.qid.path = CHDIR|(Qtopdir << TYPESHIFT);
			c.path = ".";
		Q3rd =>
			slot := qid2eslot(c.qid.path);
			decref(slot);
			c.qid.path = CHDIR|(Q2nd << TYPESHIFT);
			c.path = "env";
		Q4th =>
			slot := qid2eslot(c.qid.path);
			c.qid.path = CHDIR|(Q3rd<<TYPESHIFT)|(slot<<ENVSHIFT);
			c.path = string slot;
		}
		srv.reply(ref Rmsg.Walk(m.tag, m.fid, c.qid));
		return;
	} else {
		# walk is a common case; optimisation should pay off here.
		case t {
		Q2nd =>
			for (i := 0; i < len m.name; i++)
				if (m.name[i] < '0' || m.name[i] > '9')
					break;
			if (i < len m.name) {
				srv.reply( ref Rmsg.Error(m.tag, Enotfound));
				return;
			}
			id := int m.name;
			for (i = 0; i < len env; i++)
				if (env[i] != nil && env[i].id == id)
					break;
			if (i >= len env) {
				srv.reply( ref Rmsg.Error(m.tag, Enotfound));
				return;
			} else {
				c.qid.path = CHDIR | Q3rd<<TYPESHIFT
						| ((i & ENVMASK) << ENVSHIFT);
				incref(i);
			}
		Q4th =>
			eslot := qid2eslot(c.qid.path);
			var := lookup(env[eslot], m.name);
			if (var == nil) {
				srv.reply( ref Rmsg.Error(m.tag, Enotfound));
				return;
			} else {
				c.qid.path = (Qvar<<TYPESHIFT)
						| (eslot & ENVMASK) << ENVSHIFT
						| (var.id << VARSHIFT);
			}
		* =>
			srv.devwalk(m, devgen, nil);
			return;
		}
	}
	c.path = m.name;
	srv.reply( ref Rmsg.Walk(m.tag, m.fid, c.qid));
}

envwrite(srv: ref Styxserver, m: ref Tmsg.Write)
{
	c := fid2chan(srv, m.fid);
	if (((c.qid.path >> TYPESHIFT) & TYPEMASK) != Qvar) {
		srv.reply( ref Rmsg.Error(m.tag, Eperm));
		return;
	}
	var := chan2var(c);
	vend := int m.offset + len m.data;
	if (vend > MAXVARSIZE) {
		srv.reply( ref Rmsg.Error(m.tag, Etoobig));
		return;
	}
	if (vend > len var.val) {
		# XXX potentially leaves some bytes uninitialised
		nval := array[vend] of byte;
		nval[0:] = var.val;
		var.val = nval;
	}
	var.val[int m.offset:] = m.data;
	srv.reply( ref Rmsg.Write(m.tag, m.fid, len m.data));
}

envremove(srv: ref Styxserver, m: ref Tmsg.Remove)
{
	c := fid2chan(srv, m.fid);
	srv.chanfree(c);
	t := (c.qid.path >> TYPESHIFT) & TYPEMASK;
	if (t != Qtopdir && t != Q2nd)
		decref(qid2eslot(c.qid.path));
	if (t != Qvar) {
		srv.reply( ref Rmsg.Error(m.tag, Eperm));
		return;
	}
	e := env[qid2eslot(c.qid.path)];
	copyifneeded(e);
	vslot := ((c.qid.path >> VARSHIFT) & VARMASK) % VARHASHSIZE;
	vent := e.v.vh[vslot:];
	nvl : list of ref Var = nil;
	for (vl := vent[0].vars; vl != nil; vl = tl vl)
		if ((hd vl).name != c.path)
			nvl = hd vl :: nvl;
	vent[0].vars = nvl;
	srv.reply(ref Rmsg.Remove(m.tag, m.fid));
}

newenv(): ref Env
{
	return ref Env(maxenvid++, 0,
		ref Varlist(array[VARHASHSIZE] of {* =>Hashent(nil, 0)}, 1));
}

incref(slot: int)
{
	env[slot].refcnt++;
}

decref(slot: int)
{
	if (env[slot].refcnt-- <= 1) {
		env[slot].v.copies--;
		env[slot] = nil;
	}
}

fid2chan(srv: ref Styxserver, fid: int): ref Chan
{
	c := srv.fidtochan(fid);
	if (c == nil)
		sys->raise("panic: " + Ebadfid);
	return c;
}

chan2var(c: ref Chan): ref Var
{
	eslot := qid2eslot(c.qid.path);
	e := env[eslot];
	vslot := ((c.qid.path >> VARSHIFT) & VARMASK) % VARHASHSIZE;
	for (vl := e.v.vh[vslot].vars; vl != nil; vl = tl vl)
		if ((hd vl).name == c.path)
			break;
	if (vl == nil)
		sys->raise(sys->sprint("panic: variable '%s' not found (qid 16r%ux, slot %d)",
			c.path, c.qid.path, vslot));
	return hd vl;
}

lookup(e: ref Env, name: string): ref Var
{
	vl := e.v.vh[hashfn(name, VARHASHSIZE)].vars;
	while (vl != nil) {
		if ((hd vl).name == name)
			return hd vl;
		vl = tl vl;
	}
	return nil;
}

qid2eslot(qidpath: int): int
{
	eslot := (qidpath >> ENVSHIFT) & ENVMASK;
	if (eslot > len env || env[eslot] == nil)
		sys->raise(sys->sprint("panic: invalid slot in qid 16r%ux", qidpath));
	return eslot;
}

# clone an environment. (copy-on-write)
cloneenv(e: ref Env): int
{
	i: int;
	for (i = 0; i < len env; i++)
		if (env[i] == nil)
			break;
	if (i >= len env) {
		nenv := array[len env + len env / 2] of ref Env;
		nenv[0:] = env;
		env = nenv;
	}
	ne := env[i] = ref Env(0, maxenvid++, e.v);
	ne.v.copies++;
	return i;
}

# make an in-place copy of an Env, prior to a write.
copyifneeded(e: ref Env)
{
	if (e.v.copies <= 1)
		return;
	nvh := array[VARHASHSIZE] of Hashent;
	for (i := 0; i < len nvh; i++) {
		nvl: list of ref Var = nil;
		maxslot := 0;
		for (vl := e.v.vh[i].vars; vl != nil; vl = tl vl) {
			var := hd vl;
			d := array[len var.val] of byte;
			d[0:] = var.val;
			nvl = ref Var((i+maxslot*VARHASHSIZE)&VARMASK, var.name, d) :: nvl;
			maxslot++;
		}
		nvh[i].maxslotid = maxslot;
		nvh[i].vars = nvl;
	}
	e.v.copies--;
	e.v = ref Varlist(nvh, 1);
}

hashfn(key: string, n : int): int
{
	h := i := 0;
        while(i<len key){
                h = 10*h + key[i];
                h = h%n;
                i++;
        }
        return h%n;
}