implement Gopher;

include "sys.m";
	sys: Sys;
	sprint: import sys;
include "draw.m";
include "exception.m";
include "arg.m";
include "sh.m";
include "dial.m";
	dial: Dial;
include "registries.m";
include "timers.m";
	timers: Timers;
	Timer: import timers;
include "bufio.m";
	bufio: Bufio;
	Iobuf: import bufio;
include "readdir.m";
	readdir: Readdir;
include "http.m";
include "/appl/http/lib/helpers.m";
	mime: Mime;

Gopher: module {
	init:	fn(nil: ref Draw->Context, nil: list of string);
};

GConn: adt {
	seq:	int;
	path:	string;
	sent:	big;

	new:	fn(iob: ref Bufio->Iobuf): ref GConn;
	puts:	fn(nil: self ref GConn, s: string): int;
	write:	fn(nil: self ref GConn, buf: array of byte, n: int): int;

	iob:	ref Bufio->Iobuf;
};

progname: string;
ourhost, ourport, root: string;
devtime, logfd, regfd: ref Sys->FD;
seqc: chan of int;

init(nil: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	dial = load Dial Dial->PATH;
	bufio = load Bufio Bufio->PATH;
	timers = load Timers Timers->PATH;
	readdir = load Readdir Readdir->PATH;
	mime = load Mime Mime->PATH;

	sys->pctl(Sys->NEWPGRP | Sys->FORKFD, nil);

	# make an exception from listener or logger kill everyone
	exc := load Exception Exception->PATH;
	if(exc->setexcmode(Exception->PROPAGATE) < 0)
		fail(sprint("setexcmode: %r"));
	exc = nil;

	arg := load Arg Arg->PATH;
	arg->init(args);
	arg->setusage(hd args + " [-l logdir] [-a addr] host root");
	addr: string;
	while((c := arg->opt()) != '\0') {
		case c {
		'a' =>
			addr = arg->earg();
		'l' =>
			fdc := chan of ref Sys->FD;
			spawn logger(fdc, arg->earg());
			logfd = <- fdc;
		* =>
			arg->usage();
		}
	}
	args = arg->argv();

	if(len args != 2)
		arg->usage();
	progname = arg->progname();
	ourhost = hd args;
	root = hd tl args;
	arg = nil;

	if(addr == nil)
		addr = "tcp!*!gopher";
	else
		dial->netmkaddr(addr, "tcp", "gopher");

	seqc = chan[1] of int;
	seqc <-= 1;
	if((devtime = sys->open("/dev/time", Sys->OREAD)) == nil)
		fail(sprint("open /dev/time: %r"));

	if((aconn := dial->announce(addr)) == nil)
		fail(sprint("announce %s: %r", addr));
	info := dial->netinfo(aconn);
	ourport = info.lserv;

	timers->init(5000);
	spawn listener(addr, info, aconn);
}

warn(msg: string)
{
	sys->fprint(sys->fildes(2), "%s: %s\n", progname, msg);
}

fail(msg: string)
{
	for(i := 0; i < len msg; i++) {
		if(msg[i] == ':')
			break;
	}
	fmsg := msg[:i];
	warn(msg);
	raise "fail:" + fmsg;
}

GConn.new(iob: ref Bufio->Iobuf): ref GConn
{
	(path, err) := getpath(iob);
	if(err != nil) {
		sys->werrstr("path: " + err);
		return nil;
	}

	seq := <-seqc;
	seqc <-= seq + 1;

	return ref GConn(seq, path, big 0, iob);
}

GConn.puts(g: self ref GConn, s: string): int
{
	a := array of byte s;
	return g.write(a, len a);
}

GConn.write(g: self ref GConn, buf: array of byte, n: int): int
{
	if((m := g.iob.write(buf, n)) > 0)
		g.sent += big m;
	return n;
}

getpath(iob: ref Bufio->Iobuf): (string, string)
{
	pidc := chan[1] of int;
	pathc := chan[1] of (string, string);
	spawn getpathproc(pidc, iob, pathc);
	pid := <-pidc;

	t := Timer.start(15000);
	alt {
	<-t.timeout =>
		if((ctl := sys->open("/prog/" + string pid + "/ctl", Sys->OWRITE)) == nil
		|| sys->fprint(ctl, "kill") < 0 )
			warn(sprint("runaway getpath: %d: %r", pid));
		return (nil, "timeout");
	result := <-pathc =>
		t.stop();
		return result;
	}
}

getpathproc(pidc: chan of int, iob: ref Bufio->Iobuf, pathc: chan of (string, string))
{
	pidc <-= sys->pctl(0, nil);
	s := iob.gets('\n');
	if((n := len s) < 2 || s[n-2] != '
') {
		pathc <-= (nil, "malformed selector");
		return;
	}
	n -= 2;

	# ignore search queries
	for(i := 0; i < n; i++) {
		if(s[i] == '	')
			n = i;
	}

	pathc <-= (s[:n], nil);
}

getregaddr(addr: string, info: ref Dial->Conninfo): string
{
	for(i := len addr - 1; i >= 0; i--) {
		if(addr[i] == '/') {	# disallowed by registry(4)
			addr = addr[i+1:];
			break;
		}
	}

	(n, toks) := sys->tokenize(addr, "!");
	if(n != 3)
		return addr;
	net := hd toks;
	host := hd tl toks;
	port := hd tl tl toks;

	if(host == "*") {
		if((host = readfile("/dev/sysname")) == nil)
			fail(sprint("readfile /dev/sysname: %r"));
	}
	if(port == "0")
		port = info.lserv;
	return net + "!" + host + "!" + port;
}

readfile(file: string): string
{
	fd := sys->open(file, Sys->OREAD);
	if(fd == nil)
		return nil;	# return errstr unchanged
	buf := array[256] of byte;
	n := sys->read(fd, buf, len buf);
	if(n < 0)
		return nil;	# return errstr unchanged
	if(n == 0) {
		sys->werrstr("empty");
		return nil;
	}
	return string buf[:n];
}

nowμs(): big
{
	buf := array[32] of byte;
	n := sys->pread(devtime, buf, len buf, big 0);
	if(n < 0) {
		sys->fprint(sys->fildes(2), "read /dev/time: %r\n");
		return big -1;
	}
	return big (string buf[:n]);
}

logger(fdc: chan of ref Sys->FD, logdir: string)
{
	p := array[2] of ref Sys->FD;
	if(sys->pipe(p) < 0)
		fail(sprint("pipe: %r"));
	fdc <-= p[1];

	sys->pctl(Sys->NEWFD | Sys->FORKNS | Sys->FORKENV, p[0].fd :: 2 :: nil);
	if(sys->dup(p[0].fd, 0) < 0)
		fail(sprint("dup: %r"));

	sh := load Sh Sh->PATH;
	raise sh->system(nil, sprint("stamp μs | rotate day %#q", logdir));
}
	

register(addr: string, info: ref Dial->Conninfo)
{
	regs := load Registries Registries->PATH;
	Registry, Attributes: import regs;
	regs->init();
	if((reg := Registry.new(nil)) != nil) {
		regaddr := getregaddr(addr, info);
		pid := string sys->pctl(0, nil);
		attrs := Attributes.new(("name", ourhost) :: ("pid", pid) :: ("resource", "gopher") :: nil);
		(rv, err) := reg.register(regaddr, attrs, 0);
		if(err != nil)
			fail("register: " + err);
		regfd = rv.fd;
	}
}

listener(addr: string, info: ref Dial->Conninfo, aconn: ref Dial->Connection)
{
	register(addr, info);
	for(;;) {
		if((lconn := dial->listen(aconn)) == nil) {
			warn(sprint("listen: %r"));
			sys->sleep(15000);
		} else {
			spawn accept(lconn);
			if((lconn = nil) == nil)
				sys->sprint("state of the art garbage collection");
		}
	}
}

accept(conn: ref Dial->Connection)
{
	t0 := nowμs();
	sys->pctl(Sys->FORKFD | Sys->FORKNS | Sys->FORKENV, nil);
	if((fd := dial->accept(conn)) == nil)
		fail(sprint("accept %s: %r", conn.dir));
	if((info := dial->netinfo(conn)) == nil)
		fail(sprint("netinfo %s: %r", conn.dir));

	if((iob := bufio->fopen(fd, Bufio->ORDWR)) == nil)
		fail(sprint("fopen %s: %r", conn.dir));
	if((g := GConn.new(iob)) == nil) {
		fail(sprint("%s	%r\n", info.rsys));
	} else {
		{
			if((err := handle(g)) != nil)
				g.puts(sprint("3%s	/	%s	%s\r\n", err, ourhost, ourport));
		} exception {
		"*" =>	# don't propagate exceptions to listener or logger
			;
		}
	}
	iob.close();

	if(logfd != nil) {
		Δt := real(nowμs() - t0) / 1e6;
		sys->fprint(logfd, "%d	%#.6f	%s	%bd	%s\n",
			g.seq, Δt, info.rsys, g.sent, g.path );
	}
}

handle(g: ref GConn): string {
	if(g.path == "")
		g.path = "/";

	if(sys->bind(root, "/", Sys->MREPL) < 0
	|| sys->chdir("/") < 0 )
		return sprint("chroot: %r");
	sys->pctl(Sys->NODEVS, nil);

	if((fd := sys->open(g.path, Sys->OREAD)) == nil)
		return sprint("open %s: %r", g.path);
	(failed, dir) := sys->fstat(fd);
	if(failed)
		return sprint("stat %s: %r", g.path);

	if(dir.mode & Sys->DMDIR)
		listing(g, fd);
	else
		sendfile(g, fd);

	return nil;
}

hasprefix(a, b: string): int
{
	if(len a < (n := len b))
		return 0;
	if(a[:n] == b)
		return 1;
	return 0;
}

findtype(d: ref Sys->Dir): int
{
	if(d.mode & Sys->DMDIR)
		return '1';
	mtype := mime->findtype(d.name);
	if(hasprefix(mtype, "image"))
		return 'I';
	if(hasprefix(mtype, "text/html"))
		return 'h';
	if(hasprefix(mtype, "audio"))
		return 's';
	return '0';
}

listing(g: ref GConn, fd: ref Sys->FD): string
{
	(dirs, n) := readdir->readall(fd, Readdir->NAME | Readdir->COMPACT);
	if(n < 0)
		return sprint("readdir %s: %r", g.path);

	dirname := g.path;
	while(len dirname > 1 && dirname[0] == dirname[1] == '/')
		dirname = dirname[1:];
	if(dirname == "/")
		dirname = "";
	for(i := 0; i < len dirs; i++) {
		d := dirs[i];
		t := findtype(d);
		g.puts(sprint("%c%s	%s	%s	%s\r\n", t, d.name, dirname + "/" + d.name, ourhost, ourport));
	}
	g.puts(".\r\n");
	return nil;
}

sendfile(g: ref GConn, fd: ref Sys->FD)
{
	buf := array[Sys->ATOMICIO] of byte;

	while((n := sys->read(fd, buf, len buf)) > 0) {
		if(g.write(buf, n) < 0)
			return;
	}
}

# rfc1436
# gopher://gopher.floodgap.com/0/gopher/tech/gopherplus.txt