code: purgatorio

ref: 6042bb8adffe111049edfcb8b2eb1ad84814ed69
dir: /appl/cmd/os.b/

View raw version
implement Os;

include "sys.m";
	sys: Sys;

include "draw.m";

include "string.m";
	str: String;

include "lists.m";

include "env.m";
	env: Env;

include "workdir.m";
	wd: Workdir;

include "arg.m";

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

init(nil: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	str = load String String->PATH;
	if(str == nil)
		fail(sys->sprint("cannot load %s: %r", String->PATH));
	env = load Env Env->PATH;
	if(env == nil)
		fail(sys->sprint("cannot load %s: %r", Env->PATH));
	wd= load Workdir Workdir->PATH;
	if(wd== nil)
		fail(sys->sprint("cannot load %s: %r", Workdir->PATH));
	arg := load Arg Arg->PATH;
	if(arg == nil)
		fail(sys->sprint("cannot load %s: %r", Arg->PATH));

	arg->init(args);
	arg->setusage("os [-DrcCbn] [-d dir] [-m mount] [-N nice] command [arg...]");

	emuroot := env->getenv("emuroot");

	debug := 0;
	nice := 0;
	nicearg: string;
	workdir:= "";
	mntpoint := "";
	foreground := 1;
	convpaths := 1;

	# Root ourselves in the of our cwd inside of Inferno by default
	rooted := 1;
	usecwd := 1;

	while((opt := arg->opt()) != 0) {
		case opt {
		'D' =>
			# Turn on debugging 
			debug = 1;
		'r' =>
			# Don't root at Inferno /
			rooted = 0;
		'c' =>
			# Don't use cwd - will run at Inferno / if -r isn't set
			usecwd = 0;
		'C' =>
			# Don't convert arguments starting with / to $emuroot^/$arg
			convpaths = 0;
		'd' =>
			workdir = arg->earg();
			usecwd = 0;
			rooted = 0;
		'm' =>
			mntpoint = arg->earg();
		'n' =>
			nice = 1;
		'N' =>
			nice = 1;
			nicearg = sys->sprint(" %q", arg->earg());
		'b' =>
			foreground = 0;
		* =>
			arg->usage();
		}
	}
	args = arg->argv();
	if(args == nil)
		arg->usage();
	arg = nil;

	sys->pctl(Sys->FORKNS, nil);
	sys->bind("#p", "/prog", Sys->MREPL);		# don't worry if it fails
	if(mntpoint == nil){
		mntpoint = "/cmd";
		if(sys->stat(mntpoint+"/clone").t0 == -1)
		if(sys->bind("#C", "/", Sys->MBEFORE) < 0)
			fail(sys->sprint("bind #C /: %r"));
	}

	cfd := sys->open(mntpoint+"/clone", sys->ORDWR);
	if(cfd == nil)
		fail(sys->sprint("cannot open /cmd/clone: %r"));
	
	buf := array[32] of byte;
	if((n := sys->read(cfd, buf, len buf)) <= 0)
		fail(sys->sprint("cannot read /cmd/clone: %r"));

	dir := mntpoint+"/"+string buf[0:n];

	wfd := sys->open(dir+"/wait", Sys->OREAD);
	if(nice && sys->fprint(cfd, "nice%s", nicearg) < 0)
		sys->fprint(sys->fildes(2), "os: warning: can't set nice priority: %r\n");

	# Convert arguments beginning with / to $emuroot^/$arg
	if(convpaths && len args > 1){
		lists := load Lists Lists->PATH;
		if(lists == nil)
			raise "cannot load lists";

		nargs: list of string;
		argv0 := hd args;
		args = tl args;

		for(; args != nil; args = tl args){
			a := hd args;
			if(a[0] == '/')
				a = emuroot + a;

			nargs = a :: nargs;
		}

		args = lists->reverse(nargs);
		args = argv0 :: args;
	}

	if(debug){
		sys->fprint(sys->fildes(2), "Args to cmd:\n");
		for(argv := args; argv != nil; argv = tl argv)
			sys->fprint(sys->fildes(2), "\t%s\n", hd argv);
	}

	if(usecwd)
		workdir = wd->init();

	# If $emuroot is not set, don't care, directory is checked below
	if(rooted)
		workdir = emuroot + workdir;

	if(debug)
		sys->fprint(sys->fildes(2), "Workdir = %s\n", workdir);

	if(workdir != nil && sys->fprint(cfd, "dir %s", workdir) < 0)
		fail(sys->sprint("cannot set cwd %q: %r", workdir));

	if(foreground && sys->fprint(cfd, "killonclose") < 0)
		sys->fprint(sys->fildes(2), "os: warning: cannot write killonclose: %r\n");

	if(sys->fprint(cfd, "exec %s", str->quoted(args)) < 0)
		fail(sys->sprint("cannot exec: %r"));

	if(foreground){
		if((tocmd := sys->open(dir+"/data", sys->OWRITE)) == nil)
			fail(sys->sprint("canot open %s/data for writing: %r", dir));
		if((fromcmd := sys->open(dir+"/data", sys->OREAD)) == nil)
			fail(sys->sprint("cannot open %s/data for reading: %r", dir));
		if((errcmd := sys->open(dir+"/stderr", sys->OREAD)) == nil)
			fail(sys->sprint("cannot open %s/stderr for reading: %r", dir));

		spawn copy(sync := chan of int, nil, sys->fildes(0), tocmd);
		pid := <-sync;
		tocmd = nil;

		spawn copy(sync, nil, errcmd, sys->fildes(2));
		epid := <-sync;
		sync = nil;
		errcmd = nil;
	
		spawn copy(nil, done := chan of int, fromcmd, sys->fildes(1));
		fromcmd = nil;

		# cfd is still open, so if we're killgrp'ed and we're on a platform
		# (e.g. windows) where the fromcmd read is uninterruptible,
		# cfd will be closed, so the command will be killed (due to killonclose), and
		# the fromcmd read should complete, allowing that process to be killed.

		<-done;
		kill(pid);
		kill(epid);
	}

	if(wfd != nil){
		status := array[1024] of byte;
		n = sys->read(wfd, status, len status);
		if(n < 0)
			fail(sys->sprint("wait error: %r"));
		s := string status[0:n];
		if(s != nil){
			# pid user sys real status
			flds := str->unquoted(s);
			if(len flds < 5)
				fail(sys->sprint("wait error: odd status: %q", s));
			s = hd tl tl tl tl flds;
			if(0)
				sys->fprint(sys->fildes(2), "WAIT: %q\n", s);
			if(s != nil)
				raise "fail:host: "+s;
		}
	}
}

copy(sync, done: chan of int, f, t: ref Sys->FD)
{
	if(sync != nil)
		sync <-= sys->pctl(0, nil);
	buf := array[8192] of byte;
	for(;;) {
		r := sys->read(f, buf, len buf);
		if(r <= 0)
			break;
		w := sys->write(t, buf, r);
		if(w != r)
			break;
	}
	if(done != nil)
		done <-= 1;
}

kill(pid: int)
{
	fd := sys->open("#p/"+string pid+"/ctl", sys->OWRITE);
	sys->fprint(fd, "kill");
}

fail(msg: string)
{
	sys->fprint(sys->fildes(2), "os: %s\n", msg);
	raise "fail:"+msg;
}