ref: 44ce0097b612a1fefd754065bdf8d9d2e5ef60c8
dir: /appl/cmd/os.purgatorio.b/
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;
}