summaryrefslogtreecommitdiff
path: root/appl/collab
diff options
context:
space:
mode:
Diffstat (limited to 'appl/collab')
-rw-r--r--appl/collab/clients/chat.b224
-rw-r--r--appl/collab/clients/poll.b282
-rw-r--r--appl/collab/clients/poller.b330
-rw-r--r--appl/collab/clients/whiteboard.b586
-rw-r--r--appl/collab/collabsrv.b176
-rw-r--r--appl/collab/connect.b156
-rw-r--r--appl/collab/lib/messages.b86
-rw-r--r--appl/collab/lib/messages.m42
-rw-r--r--appl/collab/mkfile62
-rw-r--r--appl/collab/proxy.b177
-rw-r--r--appl/collab/proxy.m5
-rwxr-xr-xappl/collab/runcollab8
-rw-r--r--appl/collab/servers/chatsrv.b263
-rw-r--r--appl/collab/servers/memfssrv.b20
-rw-r--r--appl/collab/servers/mpx.b301
-rw-r--r--appl/collab/servers/wbsrv.b226
-rw-r--r--appl/collab/service.m4
-rw-r--r--appl/collab/srvmgr.b190
-rw-r--r--appl/collab/srvmgr.m22
19 files changed, 3160 insertions, 0 deletions
diff --git a/appl/collab/clients/chat.b b/appl/collab/clients/chat.b
new file mode 100644
index 00000000..d9c78d4b
--- /dev/null
+++ b/appl/collab/clients/chat.b
@@ -0,0 +1,224 @@
+implement Chat;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+ draw: Draw;
+
+include "tk.m";
+ tk: Tk;
+
+include "tkclient.m";
+ tkclient: Tkclient;
+
+Chat: module {
+ init: fn(ctxt: ref Draw->Context, args: list of string);
+};
+
+stderr: ref Sys->FD;
+
+tksetup := array [] of {
+ "frame .f",
+ "text .f.t -state disabled -wrap word -yscrollcommand {.f.sb set}",
+ "scrollbar .f.sb -orient vertical -command {.f.t yview}",
+ "entry .e -bg white",
+ "bind .e <Key-\n> {send cmd send}",
+ "pack .f.sb -in .f -side left -fill y",
+ "pack .f.t -in .f -side left -fill both -expand 1",
+ "pack .f -side top -fill both -expand 1",
+ "pack .e -side bottom -fill x",
+ "pack propagate . 0",
+ "update",
+};
+
+init(ctxt: ref Draw->Context, args: list of string)
+{
+ sys = load Sys Sys->PATH;
+ sys->pctl(Sys->NEWPGRP, nil);
+ stderr = sys->fildes(2);
+
+ draw = load Draw Draw->PATH;
+ if (draw == nil)
+ badmodule(Draw->PATH);
+
+ tk = load Tk Tk->PATH;
+ if (tk == nil)
+ badmodule(Tk->PATH);
+
+ tkclient = load Tkclient Tkclient->PATH;
+ if (tkclient == nil)
+ badmodule(Tkclient->PATH);
+
+
+ if (len args < 2) {
+ sys->fprint(stderr, "usage: chat [servicedir] room\n");
+ raise "fail:init";
+ }
+ args = tl args;
+
+ servicedir := "/n/remote/services";
+ if(len args == 2)
+ (servicedir, args) = (hd args, tl args);
+ room := hd args;
+
+ tkclient->init();
+ (win, winctl) := tkclient->toplevel(ctxt, nil, sys->sprint("Chat %s", room), Tkclient->Appl);
+
+ cmd := chan of string;
+ tk->namechan(win, cmd, "cmd");
+ tkcmds(win, tksetup);
+ tkcmd(win, ". configure -height 300");
+ fittoscreen(win);
+ tkclient->onscreen(win, nil);
+ tkclient->startinput(win, "kbd"::"ptr"::nil);
+
+ msgs := chan of string;
+ conn := chan of (string, ref Sys->FD);
+ spawn connect(servicedir, room, msgs, conn);
+ msgsfd: ref Sys->FD;
+
+ for (;;) alt {
+ (e, fd) := <-conn =>
+ if (msgsfd == nil) {
+ if (e == nil) {
+ output(win, "*** connected");
+ msgsfd = fd;
+ } else
+ output(win, "*** " + e);
+ } else {
+ output(win, "*** disconnected");
+ msgsfd = nil;
+ }
+
+ txt := <-msgs =>
+ output(win, txt);
+
+ <- cmd =>
+ msg := tkcmd(win, ".e get");
+ if (msgsfd != nil && msg != nil) {
+ tkcmd(win, ".f.t see end");
+ tkcmd(win, ".e delete 0 end");
+ tkcmd(win, "update");
+ d := array of byte msg;
+ sys->write(msgsfd, d, len d);
+ }
+
+ s := <-win.ctxt.kbd =>
+ tk->keyboard(win, s);
+ s := <-win.ctxt.ptr =>
+ tk->pointer(win, *s);
+ s := <-win.ctxt.ctl or
+ s = <-win.wreq or
+ s = <-winctl =>
+ tkclient->wmctl(win, s);
+ }
+}
+
+err(s: string)
+{
+ sys->fprint(stderr, "chat: %s\n", s);
+ raise "fail:err";
+}
+
+badmodule(path: string)
+{
+ err(sys->sprint("can't load module %s: %r", path));
+}
+
+tkcmds(t: ref Tk->Toplevel, cmds: array of string)
+{
+ for (i := 0; i < len cmds; i++)
+ tkcmd(t, cmds[i]);
+}
+
+tkcmd(t: ref Tk->Toplevel, cmd: string): string
+{
+ s := tk->cmd(t, cmd);
+ if (s != nil && s[0] == '!')
+ sys->fprint(stderr, "chat: tk error: %s [%s]\n", s, cmd);
+ return s;
+}
+
+connect(dir, name: string, msgs: chan of string, conn: chan of (string, ref Sys->FD))
+{
+ (ctlfd, srvdir, emsg) := opensvc(dir, "chat", name);
+ if(ctlfd == nil) {
+ conn <-= (emsg, nil);
+ return;
+ }
+ srvpath := srvdir+"/msgs";
+ msgsfd := sys->open(srvpath, Sys->ORDWR);
+ if(msgsfd == nil) {
+ conn <-= (sys->sprint("internal error: can't open %s: %r", srvpath), nil);
+ return;
+ }
+ conn <-= (nil, msgsfd);
+ buf := array[Sys->ATOMICIO] of byte;
+ while((n := sys->read(msgsfd, buf, len buf)) > 0)
+ msgs <-= string buf[0:n];
+ conn <-= (nil, nil);
+}
+
+opensvc(dir: string, svc: string, name: string): (ref Sys->FD, string, string)
+{
+ ctlfd := sys->open(dir+"/ctl", Sys->ORDWR);
+ if(ctlfd == nil)
+ return (nil, nil, sys->sprint("can't open %s/ctl: %r", dir));
+ if(sys->fprint(ctlfd, "%s %s", svc, name) <= 0)
+ return (nil, nil, sys->sprint("can't access %s service %s: %r", svc, name));
+ buf := array [32] of byte;
+ sys->seek(ctlfd, big 0, Sys->SEEKSTART);
+ n := sys->read(ctlfd, buf, len buf);
+ if (n <= 0)
+ return (nil, nil, sys->sprint("%s/ctl: protocol error: %r", dir));
+ return (ctlfd, dir+"/"+string buf[0:n], nil);
+}
+
+firstmsg := 1;
+output(win: ref Tk->Toplevel, txt: string)
+{
+ if (firstmsg)
+ firstmsg = 0;
+ else
+ txt = "\n" + txt;
+ yview := tkcmd(win, ".f.t yview");
+ (nil, toks) := sys->tokenize(yview, " ");
+ toks = tl toks;
+
+ tkcmd(win, ".f.t insert end '" + txt);
+ if (hd toks == "1")
+ tkcmd(win, ".f.t see end");
+ tkcmd(win, "update");
+}
+
+KEYBOARDH: con 90;
+
+fittoscreen(win: ref Tk->Toplevel)
+{
+ Point, Rect: import draw;
+ if (win.image == nil || win.image.screen == nil)
+ return;
+ r := win.image.screen.image.r;
+ scrsize := Point((r.max.x - r.min.x), (r.max.y - r.min.y)- KEYBOARDH);
+ bd := int tkcmd(win, ". cget -bd");
+ winsize := Point(int tkcmd(win, ". cget -actwidth") + bd * 2, int tkcmd(win, ". cget -actheight") + bd * 2);
+ if (winsize.x > scrsize.x)
+ tkcmd(win, ". configure -width " + string (scrsize.x - bd * 2));
+ if (winsize.y > scrsize.y)
+ tkcmd(win, ". configure -height " + string (scrsize.y - bd * 2));
+ actr: Rect;
+ actr.min = Point(int tkcmd(win, ". cget -actx"), int tkcmd(win, ". cget -acty"));
+ actr.max = actr.min.add((int tkcmd(win, ". cget -actwidth") + bd*2,
+ int tkcmd(win, ". cget -actheight") + bd*2));
+ (dx, dy) := (actr.dx(), actr.dy());
+ if (actr.max.x > r.max.x)
+ (actr.min.x, actr.max.x) = (r.min.x - dx, r.max.x - dx);
+ if (actr.max.y > r.max.y)
+ (actr.min.y, actr.max.y) = (r.min.y - dy, r.max.y - dy);
+ if (actr.min.x < r.min.x)
+ (actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
+ if (actr.min.y < r.min.y)
+ (actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
+ tkcmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
+}
diff --git a/appl/collab/clients/poll.b b/appl/collab/clients/poll.b
new file mode 100644
index 00000000..ffb79c73
--- /dev/null
+++ b/appl/collab/clients/poll.b
@@ -0,0 +1,282 @@
+implement Poll;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+
+include "tk.m";
+ tk: Tk;
+
+include "tkclient.m";
+ tkclient: Tkclient;
+
+include "dialog.m";
+ dialog: Dialog;
+
+include "arg.m";
+
+Poll: module
+{
+ init: fn(nil: ref Draw->Context, nil: list of string);
+};
+
+Maxanswer: con 4;
+
+contents := array[] of {
+ "frame .f",
+ "frame .a",
+ "radiobutton .a.a1 -state disabled -variable answer -value A -text {A} -command {send entry A}",
+ "radiobutton .a.a2 -state disabled -variable answer -value B -text {B} -command {send entry B}",
+ "radiobutton .a.a3 -state disabled -variable answer -value C -text {C} -command {send entry C}",
+ "radiobutton .a.a4 -state disabled -variable answer -value D -text {D} -command {send entry D}",
+ "pack .a.a1 -side top -fill x -expand 1",
+ "pack .a.a2 -side top -fill x -expand 1",
+ "pack .a.a3 -side top -fill x -expand 1",
+ "pack .a.a4 -side top -fill x -expand 1",
+ "pack .a -side top -fill both -expand 1",
+ "pack .f -side top -fill both",
+};
+
+dbcontents := array[] of {
+ "text .f.t -state disabled -wrap word -yscrollcommand {.f.sb set} -height 4h",
+ "scrollbar .f.sb -orient vertical -command {.f.t yview}",
+ "pack .f.sb -side left -fill y",
+ "pack .f.t -side left -fill both -expand 1",
+};
+
+usage()
+{
+ sys->fprint(sys->fildes(2), "usage: poll [-d] [servicedir] pollname\n");
+ raise "fail:usage";
+}
+
+init(ctxt: ref Draw->Context, args: list of string)
+{
+ sys = load Sys Sys->PATH;
+ tk = load Tk Tk->PATH;
+ tkclient = load Tkclient Tkclient->PATH;
+ dialog = load Dialog Dialog->PATH;
+
+ arg := load Arg Arg->PATH;
+ if(arg == nil){
+ sys->fprint(sys->fildes(2), "poll: can't load %s: %r\n", Arg->PATH);
+ raise "fail:load";
+ }
+ arg->init(args);
+ debug := 0;
+ while((ch := arg->opt()) != 0)
+ case ch {
+ 'd' =>
+ debug = 1;
+ * =>
+ usage();
+ }
+ args = arg->argv();
+ arg = nil;
+ if(len args < 1)
+ usage();
+ sys->pctl(Sys->NEWPGRP, nil);
+
+ servicedir := "/n/remote/services";
+ if(len args == 2)
+ (servicedir, args) = (hd args, tl args);
+ pollname := hd args;
+
+ (cfd, dir, emsg) := opensvc(servicedir, "mpx", pollname);
+ if(cfd == nil){
+ sys->fprint(sys->fildes(2), "poll: can't access poll %s: %s\n", pollname, emsg);
+ raise "fail:error";
+ }
+ fd := sys->open(dir+"/leaf", Sys->ORDWR);
+ if(fd == nil){
+ sys->fprint(sys->fildes(2), "poll: can't open %s/leaf: %r\n", dir);
+ raise "fail:open";
+ }
+
+ tkclient->init();
+ dialog->init();
+ (frame, wmctl) := tkclient->toplevel(ctxt, nil, sys->sprint("Poll %s", pollname), Tkclient->Appl);
+ entry := chan of string;
+ tk->namechan(frame, entry, "entry");
+ tkcmds(frame, contents);
+ if(debug)
+ tkcmds(frame, dbcontents);
+ tkcmd(frame, "pack propagate . 0");
+ fittoscreen(frame);
+ tk->cmd(frame, "update");
+ tkclient->onscreen(frame, nil);
+ tkclient->startinput(frame, "kbd"::"ptr"::nil);
+
+ in := chan of string;
+ spawn reader(fd, in);
+ first := 1;
+ lastval := -1;
+ qno := -1;
+ for(;;)
+ alt{
+ s := <-frame.ctxt.kbd =>
+ tk->keyboard(frame, s);
+ s := <-frame.ctxt.ptr =>
+ tk->pointer(frame, *s);
+ s := <-frame.ctxt.ctl or
+ s = <-frame.wreq or
+ s = <-wmctl =>
+ tkclient->wmctl(frame, s);
+
+ msg := <-entry =>
+ if(fd == nil){
+ dialog->prompt(ctxt, frame.image, "error -fg red", "Error", "Lost connection to polling station", 0, "Dismiss"::nil);
+ break;
+ }
+ n := msg[0]-'A';
+ lastval = n;
+ selectonly(frame, n, Maxanswer, "disabled");
+ if(qno >= 0) {
+ # send our answer to the polling station
+ if(sys->fprint(fd, "%d %s", qno, msg) < 0){
+ sys->fprint(sys->fildes(2), "poll: write error: %r\n");
+ fd = nil;
+ }
+ qno = -1; # only one go at it
+ }
+
+ s := <-in =>
+ if(s != nil){
+ if(debug){
+ t := s;
+ if(!first)
+ t = "\n"+t;
+ first = 0;
+ tk->cmd(frame, ".f.t insert end '" + t);
+ tk->cmd(frame, ".f.t see end");
+ tk->cmd(frame, "update");
+ }
+ (nf, flds) := sys->tokenize(s, " ");
+ if(nf > 1 && hd flds == "error:"){
+ dialog->prompt(ctxt, frame.image, "error -fg red", "Error", sys->sprint("polling station reports: %s", s), 0, "Dismiss"::nil);
+ break;
+ }
+ if(nf < 4)
+ break;
+ # seq clientid op name data
+ op, name: string;
+ flds = tl flds; # ignore seq
+ flds = tl flds; # ignore clientid
+ (op, flds) = (hd flds, tl flds);
+ (name, flds) = (hd flds, tl flds);
+ case op {
+ "M" =>
+ # poll qno nanswer opt
+ # stop qno
+ selectonly(frame, -1, Maxanswer, "disabled");
+ if(len flds < 2)
+ break;
+ (op, flds) = (hd flds, tl flds);
+ (s, flds) = (hd flds, tl flds);
+ case op {
+ "poll" =>
+ qno = int s;
+ (s, flds) = (hd flds, tl flds);
+ n := int s;
+ if(n > Maxanswer)
+ n = Maxanswer;
+ if(n < 2)
+ n = 2;
+ selectonly(frame, -1, n, "normal");
+ lastval = -1;
+ "stop" =>
+ selectonly(frame, lastval, Maxanswer, "disabled");
+ }
+ "L" =>
+ dialog->prompt(ctxt, frame.image, "error -fg red", "Notice", sys->sprint("Poller (%s) has gone", name), 0, "Exit"::nil);
+ tkclient->wmctl(frame, "exit");
+ }
+ }else{
+ dialog->prompt(ctxt, frame.image, "error -fg red", "Notice", "Polling station closed", 0, "Exit"::nil);
+ tkclient->wmctl(frame, "exit");
+ }
+ }
+}
+
+selectonly(t: ref Tk->Toplevel, n: int, top: int, state: string)
+{
+ for(i := 0; i < top; i++){
+ path := sys->sprint(".a.a%d", i+1);
+ if(i != n)
+ tkcmd(t, path+" deselect");
+ else
+ tkcmd(t, path+" select");
+ tkcmd(t, path+" configure -state "+state);
+ }
+ tk->cmd(t, "update");
+}
+
+reader(fd: ref Sys->FD, c: chan of string)
+{
+ buf := array[Sys->ATOMICIO] of byte;
+ while((n := sys->read(fd, buf, len buf)) > 0)
+ c <-= string buf[0:n];
+ if(n < 0)
+ c <-= sys->sprint("error: %r");
+ c <-= nil;
+}
+
+opensvc(dir: string, svc: string, name: string): (ref Sys->FD, string, string)
+{
+ ctlfd := sys->open(dir+"/ctl", Sys->ORDWR);
+ if(ctlfd == nil)
+ return (nil, nil, sys->sprint("can't open %s/ctl: %r", dir));
+ if(sys->fprint(ctlfd, "%s %s", svc, name) <= 0)
+ return (nil, nil, sys->sprint("can't access %s service %s: %r", svc, name));
+ buf := array [32] of byte;
+ sys->seek(ctlfd, big 0, Sys->SEEKSTART);
+ n := sys->read(ctlfd, buf, len buf);
+ if (n <= 0)
+ return (nil, nil, sys->sprint("%s/ctl: protocol error: %r", dir));
+ return (ctlfd, dir+"/"+string buf[0:n], nil);
+}
+
+tkcmds(t: ref Tk->Toplevel, cmds: array of string)
+{
+ for (i := 0; i < len cmds; i++)
+ tkcmd(t, cmds[i]);
+}
+
+tkcmd(t: ref Tk->Toplevel, cmd: string): string
+{
+ s := tk->cmd(t, cmd);
+ if (s != nil && s[0] == '!')
+ sys->fprint(sys->fildes(2), "poll: tk error: %s [%s]\n", s, cmd);
+ return s;
+}
+
+fittoscreen(win: ref Tk->Toplevel)
+{
+ draw := load Draw Draw->PATH;
+ Point, Rect: import draw;
+ if (win.image == nil || win.image.screen == nil)
+ return;
+ r := win.image.screen.image.r;
+ scrsize := Point((r.max.x - r.min.x), (r.max.y - r.min.y));
+ bd := int tkcmd(win, ". cget -bd");
+ winsize := Point(int tkcmd(win, ". cget -actwidth") + bd * 2, int tkcmd(win, ". cget -actheight") + bd * 2);
+ if (winsize.x > scrsize.x)
+ tkcmd(win, ". configure -width " + string (scrsize.x - bd * 2));
+ if (winsize.y > scrsize.y)
+ tkcmd(win, ". configure -height " + string (scrsize.y - bd * 2));
+ actr: Rect;
+ actr.min = Point(int tkcmd(win, ". cget -actx"), int tkcmd(win, ". cget -acty"));
+ actr.max = actr.min.add((int tkcmd(win, ". cget -actwidth") + bd*2,
+ int tkcmd(win, ". cget -actheight") + bd*2));
+ (dx, dy) := (actr.dx(), actr.dy());
+ if (actr.max.x > r.max.x)
+ (actr.min.x, actr.max.x) = (r.min.x - dx, r.max.x - dx);
+ if (actr.max.y > r.max.y)
+ (actr.min.y, actr.max.y) = (r.min.y - dy, r.max.y - dy);
+ if (actr.min.x < r.min.x)
+ (actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
+ if (actr.min.y < r.min.y)
+ (actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
+ tkcmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
+}
diff --git a/appl/collab/clients/poller.b b/appl/collab/clients/poller.b
new file mode 100644
index 00000000..90365606
--- /dev/null
+++ b/appl/collab/clients/poller.b
@@ -0,0 +1,330 @@
+implement Poller;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+ draw: Draw;
+ Rect, Point: import draw;
+
+include "tk.m";
+ tk: Tk;
+
+include "tkclient.m";
+ tkclient: Tkclient;
+
+include "dialog.m";
+ dialog: Dialog;
+
+include "arg.m";
+
+Poller: module
+{
+ init: fn(nil: ref Draw->Context, nil: list of string);
+};
+
+Maxanswer: con 4; # Tk below isn't parametrised, but could be
+
+contents := array[] of {
+ "frame .f",
+ "frame .f.n",
+ "label .f.l -anchor nw -text {Number of answers: }",
+ "radiobutton .f.n.a2 -text {2} -variable nanswer -value 2",
+ "radiobutton .f.n.a3 -text {3} -variable nanswer -value 3",
+ "radiobutton .f.n.a4 -text {4} -variable nanswer -value 4",
+ "pack .f.n.a2 .f.n.a3 .f.n.a4 -side left",
+
+ "frame .f.b",
+ "button .f.b.start -text {Start} -command {send cmd start}",
+ "button .f.b.stop -text {Stop} -state disabled -command {send cmd stop}",
+ "pack .f.b.start .f.b.stop -side left",
+
+ "canvas .f.c -height 230 -width 200",
+
+ "pack .f.l -side top -fill x",
+ "pack .f.n -side top -fill x",
+ "pack .f.b -side top -fill x -expand 1",
+ "pack .f.c -side top -pady 2",
+ "pack .f -side top -fill both -expand 1",
+};
+
+dbcontents := array[] of {
+ "text .f.t -state disabled -wrap word -height 4h -yscrollcommand {.f.sb set}", # message log
+ "scrollbar .f.sb -orient vertical -command {.f.t yview}",
+ "pack .f.sb -side left -fill y",
+ "pack .f.t -side left -fill both",
+};
+
+Bar: adt {
+ frame: ref Tk->Toplevel;
+ canvas: string;
+ border: string;
+ inside: string;
+ label: string;
+ r: Rect;
+ v: real;
+
+ draw: fn(nil: self ref Bar);
+};
+
+usage()
+{
+ sys->fprint(sys->fildes(2), "usage: poller [-d] [servicedir] pollname\n");
+ raise "fail:usage";
+}
+
+init(ctxt: ref Draw->Context, args: list of string)
+{
+ sys = load Sys Sys->PATH;
+ draw = load Draw Draw->PATH;
+ tk = load Tk Tk->PATH;
+ tkclient = load Tkclient Tkclient->PATH;
+ dialog = load Dialog Dialog->PATH;
+
+ arg := load Arg Arg->PATH;
+ if(arg == nil){
+ sys->fprint(sys->fildes(2), "poller: can't load %s: %r\n", Arg->PATH);
+ raise "fail:load";
+ }
+ arg->init(args);
+ debug := 0;
+ while((ch := arg->opt()) != 0)
+ case ch {
+ 'd' =>
+ debug = 1;
+ * =>
+ usage();
+ }
+ args = arg->argv();
+ arg = nil;
+ if(len args < 1)
+ usage();
+ sys->pctl(Sys->NEWPGRP, nil);
+
+ servicedir := "/n/remote/services";
+ if(len args == 2)
+ (servicedir, args) = (hd args, tl args);
+ pollname := hd args;
+
+ (cfd, dir, emsg) := opensvc(servicedir, "mpx", pollname);
+ if(cfd == nil){
+ sys->fprint(sys->fildes(2), "poller: can't access polling station %s: %s\n", pollname, emsg);
+ raise "fail:error";
+ }
+ fd := sys->open(dir+"/root", Sys->ORDWR);
+ if(fd == nil){
+ sys->fprint(sys->fildes(2), "poller: can't open %s/root: %r\n", dir);
+ raise "fail:open";
+ }
+
+ tkclient->init();
+ dialog->init();
+ (frame, wmctl) := tkclient->toplevel(ctxt, nil, sys->sprint("Poller: %s", pollname), Tkclient->Appl);
+ cmd := chan of string;
+ tk->namechan(frame, cmd, "cmd");
+ tkcmds(frame, contents);
+ if(debug)
+ tkcmds(frame, dbcontents);
+ tkcmd(frame, "pack propagate . 0");
+ fittoscreen(frame);
+ tk->cmd(frame, "update");
+ tkclient->onscreen(frame, nil);
+ tkclient->startinput(frame, "kbd"::"ptr"::nil);
+
+ bars := mkbars(frame, ".f.c", Maxanswer);
+ count: array of int;
+
+ in := chan of string;
+ spawn reader(fd, in);
+ first := 1;
+ qno := 0;
+ nanswer := 0;
+ opt := 0;
+ total := 0;
+ for(;;)
+ alt{
+ s := <-frame.ctxt.kbd =>
+ tk->keyboard(frame, s);
+ s := <-frame.ctxt.ptr =>
+ tk->pointer(frame, *s);
+ s := <-frame.ctxt.ctl or
+ s = <-frame.wreq or
+ s = <-wmctl =>
+ tkclient->wmctl(frame, s);
+
+ c := <-cmd =>
+ if(fd == nil){
+ dialog->prompt(ctxt, frame.image, "error -fg red", "Error", "Lost connection to polling station", 0, "Dismiss"::nil);
+ break;
+ }
+ case c {
+ "start" =>
+ s := tkcmd(frame, "variable nanswer");
+ if(s == nil || s[0] == '!'){
+ dialog->prompt(ctxt, frame.image, "error -fg red", "Error", "Please select number of answers", 0, "Ok"::nil);
+ break;
+ }
+ nanswer = int s;
+ count = array[Maxanswer] of {* => 0};
+ total = 0;
+ qno++;
+ #opt = (int tkcmd(frame, "variable none") << 1) | int tkcmd(frame, "variable all");
+ tkcmd(frame, ".f.b.start configure -state disabled");
+ tkcmd(frame, ".f.b.stop configure -state normal");
+ if(sys->fprint(fd, "poll %d %d %d", qno, nanswer, opt) <= 0)
+ sys->fprint(sys->fildes(2), "poller: write error: %r\n");
+ "stop" =>
+ tkcmd(frame, ".f.b.stop configure -state disabled");
+ tkcmd(frame, "update");
+ if(sys->fprint(fd, "stop %d", qno) <= 0)
+ sys->fprint(sys->fildes(2), "poller: write error: %r\n");
+ # stop ...
+ tkcmd(frame, ".f.b.start configure -state normal");
+ }
+ tk->cmd(frame, "update");
+
+ s := <-in =>
+ if(s != nil){
+ if(debug){
+ t := s;
+ if(!first)
+ t = "\n"+t;
+ first = 0;
+ tkcmd(frame, ".f.t insert end '" + t);
+ tkcmd(frame, ".f.t see end");
+ tkcmd(frame, "update");
+ }
+ r := getresult(s, qno);
+ if(r < 0)
+ break;
+ if(r >= 0 && r < len count){
+ count[r]++;
+ total++;
+ for(i:=0; i < len count; i++){
+ bars[i].v = real count[i]/real total;
+ bars[i].draw();
+ }
+ tk->cmd(frame, "update");
+ }
+ #sys->print("%d %d\n", qno, r);
+ }else
+ fd = nil;
+ }
+}
+
+mkbars(t: ref Tk->Toplevel, canvas: string, nbars: int): array of ref Bar
+{
+ x := 0;
+ a := array[nbars] of ref Bar;
+ for(i := 0; i < nbars; i++){
+ b := ref Bar(t, canvas, nil, nil, nil, Rect((x,2),(x+20,202)), 0.0);
+ b.border = tkcmd(t, sys->sprint("%s create rectangle %d %d %d %d",
+ canvas, b.r.min.x,b.r.min.y,b.r.max.x,b.r.max.y));
+ r := b.r.inset(1);
+ b.inside = tkcmd(t, sys->sprint("%s create rectangle %d %d %d %d -fill red",
+ canvas, r.max.x, r.max.y,r.max.x,r.max.y));
+ b.label = tkcmd(t, sys->sprint("%s create text %d %d -justify center -anchor n -text '0%%",
+ canvas, (r.min.x+r.max.x)/2, r.max.y+4));
+ a[i] = b;
+ x += 50;
+ }
+ tk->cmd(t, "update");
+ return a;
+}
+
+Bar.draw(b: self ref Bar)
+{
+ r := b.r.inset(2);
+ y := r.max.y - int (b.v * real r.dy());
+ tkcmd(b.frame, sys->sprint("%s coords %s %d %d %d %d",
+ b.canvas, b.inside, r.min.x, y, r.max.x, r.max.y));
+ tkcmd(b.frame, sys->sprint("%s itemconfigure %s -text '%.0f%%",
+ b.canvas, b.label, b.v*100.0));
+}
+
+getresult(msg: string, qno: int): int
+{
+ (nf, flds) := sys->tokenize(msg, " ");
+ if(nf < 5 || hd flds == "error:")
+ return -1; # not of interest
+ op := hd tl tl flds;
+ flds = tl tl tl flds;
+ if(op != "m")
+ return -1; # not a message from leaf
+ if(len flds < 3)
+ return -1; # bad format
+ flds = tl flds; # ignore user name
+ if(int hd flds != qno)
+ return -1; # not current question
+ result := hd tl flds;
+ if(result[0] >= 'A' && result[0] <= 'D')
+ return result[0]-'A';
+ return -1;
+}
+
+reader(fd: ref Sys->FD, c: chan of string)
+{
+ buf := array[Sys->ATOMICIO] of byte;
+ while((n := sys->read(fd, buf, len buf)) > 0)
+ c <-= string buf[0:n];
+ if(n < 0)
+ c <-= sys->sprint("error: %r");
+ c <-= nil;
+}
+
+opensvc(dir: string, svc: string, name: string): (ref Sys->FD, string, string)
+{
+ ctlfd := sys->open(dir+"/ctl", Sys->ORDWR);
+ if(ctlfd == nil)
+ return (nil, nil, sys->sprint("can't open %s/ctl: %r", dir));
+ if(sys->fprint(ctlfd, "%s %s", svc, name) <= 0)
+ return (nil, nil, sys->sprint("can't access %s service %s: %r", svc, name));
+ buf := array [32] of byte;
+ sys->seek(ctlfd, big 0, Sys->SEEKSTART);
+ n := sys->read(ctlfd, buf, len buf);
+ if (n <= 0)
+ return (nil, nil, sys->sprint("%s/ctl: protocol error: %r", dir));
+ return (ctlfd, dir+"/"+string buf[0:n], nil);
+}
+
+tkcmds(t: ref Tk->Toplevel, cmds: array of string)
+{
+ for (i := 0; i < len cmds; i++)
+ tkcmd(t, cmds[i]);
+}
+
+tkcmd(t: ref Tk->Toplevel, cmd: string): string
+{
+ s := tk->cmd(t, cmd);
+ if (s != nil && s[0] == '!')
+ sys->fprint(sys->fildes(2), "poller: tk error: %s [%s]\n", s, cmd);
+ return s;
+}
+
+fittoscreen(win: ref Tk->Toplevel)
+{
+ if (win.image == nil || win.image.screen == nil)
+ return;
+ r := win.image.screen.image.r;
+ scrsize := Point((r.max.x - r.min.x), (r.max.y - r.min.y));
+ bd := int tkcmd(win, ". cget -bd");
+ winsize := Point(int tkcmd(win, ". cget -actwidth") + bd * 2, int tkcmd(win, ". cget -actheight") + bd * 2);
+ if (winsize.x > scrsize.x)
+ tkcmd(win, ". configure -width " + string (scrsize.x - bd * 2));
+ if (winsize.y > scrsize.y)
+ tkcmd(win, ". configure -height " + string (scrsize.y - bd * 2));
+ actr: Rect;
+ actr.min = Point(int tkcmd(win, ". cget -actx"), int tkcmd(win, ". cget -acty"));
+ actr.max = actr.min.add((int tkcmd(win, ". cget -actwidth") + bd*2,
+ int tkcmd(win, ". cget -actheight") + bd*2));
+ (dx, dy) := (actr.dx(), actr.dy());
+ if (actr.max.x > r.max.x)
+ (actr.min.x, actr.max.x) = (r.min.x - dx, r.max.x - dx);
+ if (actr.max.y > r.max.y)
+ (actr.min.y, actr.max.y) = (r.min.y - dy, r.max.y - dy);
+ if (actr.min.x < r.min.x)
+ (actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
+ if (actr.min.y < r.min.y)
+ (actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
+ tkcmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
+}
diff --git a/appl/collab/clients/whiteboard.b b/appl/collab/clients/whiteboard.b
new file mode 100644
index 00000000..e05e1b45
--- /dev/null
+++ b/appl/collab/clients/whiteboard.b
@@ -0,0 +1,586 @@
+implement Whiteboard;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+ draw: Draw;
+ Screen, Display, Image, Rect, Point, Font: import draw;
+
+include "tk.m";
+ tk: Tk;
+
+include "tkclient.m";
+ tkclient: Tkclient;
+
+Whiteboard: module {
+ init: fn(ctxt: ref Draw->Context, args: list of string);
+};
+
+ERASEWIDTH: con 6;
+
+
+stderr: ref Sys->FD;
+srvfd: ref Sys->FD;
+disp: ref Display;
+font: ref Draw->Font;
+drawctxt: ref Draw->Context;
+
+tksetup := array[] of {
+ "frame .f -bd 2",
+ "frame .c -bg white -width 234 -height 279",
+ "menu .penmenu",
+ ".penmenu add command -command {send cmd pen 0} -bitmap @/icons/whiteboard/0.bit",
+ ".penmenu add command -command {send cmd pen 1} -bitmap @/icons/whiteboard/1.bit",
+ ".penmenu add command -command {send cmd pen 2} -bitmap @/icons/whiteboard/2.bit",
+ ".penmenu add command -command {send cmd pen erase} -bitmap @/icons/whiteboard/erase.bit",
+ "menubutton .pen -menu .penmenu -bitmap @/icons/whiteboard/1.bit",
+ "button .colour -bg black -activebackground black -command {send cmd getcolour}",
+ "pack .c -in .f",
+ "pack .f -side top -anchor center",
+ "pack .pen -side left",
+ "pack .colour -side left -fill both -expand 1",
+ "update",
+};
+
+tkconnected := array[] of {
+ "bind .c <Button-1> {send cmd down %x %y}",
+ "bind .c <ButtonRelease-1> {send cmd up %x %y}",
+ "update",
+};
+
+init(ctxt: ref Draw->Context, args: list of string)
+{
+ sys = load Sys Sys->PATH;
+ sys->pctl(Sys->NEWPGRP, nil);
+ stderr = sys->fildes(2);
+
+ draw = load Draw Draw->PATH;
+ tk = load Tk Tk->PATH;
+
+ tkclient = load Tkclient Tkclient->PATH;
+ if (tkclient == nil)
+ badmod(Tkclient->PATH);
+
+ if (len args < 2) {
+ sys->fprint(stderr, "Usage: whiteboard [servicedir] id\n");
+ raise "fail:init";
+ }
+
+ args = tl args;
+ servicedir := "/n/remote/services";
+ if(len args == 2)
+ (servicedir, args) = (hd args, tl args);
+ wbid := hd args;
+
+ disp = ctxt.display;
+ if (disp == nil) {
+ sys->fprint(stderr, "bad Draw->Context\n");
+ raise "fail:init";
+ }
+ drawctxt = ctxt;
+
+ tkclient->init();
+ (win, winctl) := tkclient->toplevel(ctxt, nil, "Whiteboard", 0);
+ font = Font.open(disp, tkcmd(win, ". cget -font"));
+ if(font == nil)
+ font = Font.open(disp, "*default*");
+ cmd := chan of string;
+ tk->namechan(win, cmd, "cmd");
+ tkcmds(win, tksetup);
+ tkclient->onscreen(win, nil);
+ tkclient->startinput(win, "kbd" :: "ptr" :: nil);
+ cimage := makeimage(win);
+
+ sc := chan of array of (Point, Point);
+ cc := chan of (string, ref Image, ref Sys->FD, ref Sys->FD);
+ connected := 0;
+ sfd: ref Sys->FD;
+ ctlfd: ref Sys->FD; # must keep this open to keep service active
+
+ showtext(cimage, "connecting...");
+ spawn connect(servicedir, wbid, cc);
+
+ err: string;
+ strokeimg: ref Image;
+Connect:
+ for (;;) alt {
+ (err, strokeimg, sfd, ctlfd) = <-cc =>
+ if (err == nil)
+ break Connect;
+ else
+ showtext(cimage, "Error: " + err);
+
+ s := <-winctl or
+ s = <-win.wreq or
+ s = <-win.ctxt.ctl =>
+ oldimg := win.image;
+ err = tkclient->wmctl(win, s);
+ if(s[0] == '!' && err == nil && win.image != oldimg){
+ cimage = makeimage(win);
+ showtext(cimage, "connecting...");
+ }
+ p := <-win.ctxt.ptr =>
+ tk->pointer(win, *p);
+ c := <-win.ctxt.kbd =>
+ tk->keyboard(win, c);
+ }
+
+ tkcmd(win, ".c configure -width " + string strokeimg.r.dx());
+ tkcmd(win, ".c configure -height " + string strokeimg.r.dy());
+ tkcmds(win, tkconnected);
+ tkcmd(win, "update");
+ cimage.draw(cimage.r, strokeimg, nil, strokeimg.r.min);
+
+ strokesin := chan of (int, int, array of Point);
+ strokesout := chan of (int, int, Point, Point);
+ spawn reader(sfd, strokesin);
+ spawn writer(sfd, strokesout);
+
+ pendown := 0;
+ p0, p1: Point;
+
+ getcolour := 0;
+ white := disp.white;
+ whitepen := disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, Draw->White);
+ pencolour := Draw->Black;
+ penwidth := 1;
+ erase := 0;
+ drawpen := disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, pencolour);
+
+ for (;;) alt {
+ s := <-winctl or
+ s = <-win.ctxt.ctl or
+ s = <-win.wreq =>
+ oldimg := win.image;
+ err = tkclient->wmctl(win, s);
+ if(s[0] == '!' && err == nil && win.image != oldimg){
+ cimage = makeimage(win);
+ cimage.draw(cimage.r, strokeimg, nil, strokeimg.r.min);
+ }
+ p := <-win.ctxt.ptr =>
+ tk->pointer(win, *p);
+ c := <-win.ctxt.kbd =>
+ tk->keyboard(win, c);
+ (colour, width, strokes) := <-strokesin =>
+ if (strokes == nil)
+ tkclient->settitle(win, "Whiteboard (Disconnected)");
+ else {
+ pen := disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, colour);
+ drawstrokes(cimage, cimage.r.min, pen, width, strokes);
+ drawstrokes(strokeimg, strokeimg.r.min, pen, width, strokes);
+ }
+
+ c := <-cmd =>
+ (nil, toks) := sys->tokenize(c, " ");
+ case hd toks {
+ "down" =>
+ toks = tl toks;
+ x := int hd toks;
+ y := int hd tl toks;
+ if (!pendown) {
+ pendown = 1;
+ p0 = Point(x, y);
+ continue;
+ }
+ p1 = Point(x, y);
+ if (p1.x == p0.x && p1.y == p0.y)
+ continue;
+ pen := drawpen;
+ colour := pencolour;
+ width := penwidth;
+ if (erase) {
+ pen = whitepen;
+ colour = Draw->White;
+ width = ERASEWIDTH;
+ }
+ drawstroke(cimage, cimage.r.min, p0, p1, pen, width);
+ drawstroke(strokeimg, strokeimg.r.min, p0, p1, pen, width);
+ strokesout <-= (colour, width, p0, p1);
+ p0 = p1;
+ "up" =>
+ pendown = 0;
+
+ "getcolour" =>
+ pendown = 0;
+ if (!getcolour)
+ spawn colourmenu(cmd);
+ "colour" =>
+ pendown = 0;
+ getcolour = 0;
+ toks = tl toks;
+ if (toks == nil)
+ # colourmenu was dismissed
+ continue;
+ erase = 0;
+ tkcmd(win, ".pen configure -bitmap @/icons/whiteboard/" + string penwidth + ".bit");
+ tkcmd(win, "update");
+ pencolour = int hd toks;
+ toks = tl toks;
+ tkcolour := hd toks;
+ drawpen = disp.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, pencolour);
+ tkcmd(win, ".colour configure -bg " + tkcolour + " -activebackground " + tkcolour);
+ tkcmd(win, "update");
+
+ "pen" =>
+ pendown = 0;
+ p := hd tl toks;
+ i := "";
+ if (p == "erase") {
+ erase = 1;
+ i = "erase.bit";
+ } else {
+ erase = 0;
+ penwidth = int p;
+ i = p + ".bit";
+ }
+ tkcmd(win, ".pen configure -bitmap @/icons/whiteboard/" + i);
+ tkcmd(win, "update");
+ }
+
+ }
+}
+
+makeimage(win: ref Tk->Toplevel): ref Draw->Image
+{
+ if(win.image == nil)
+ return nil;
+ scr := Screen.allocate(win.image, win.image.display.white, 0);
+ w := scr.newwindow(tk->rect(win, ".c", Tk->Local), Draw->Refnone, Draw->Nofill);
+ return w;
+}
+
+showtext(img: ref Image, s: string)
+{
+ r := img.r;
+ r.max.y = img.r.min.y + font.height;
+ img.draw(r, disp.white, nil, (0, 0));
+ img.text(r.min, disp.black, (0, 0), font, s);
+}
+
+penmenu(t: ref Tk->Toplevel, p: Point)
+{
+ topy := int tkcmd(t, ".penmenu yposition 0");
+ boty := int tkcmd(t, ".penmenu yposition end");
+ dy := boty - topy;
+ p.y -= dy;
+ tkcmd(t, ".penmenu post " + string p.x + " " + string p.y);
+}
+
+colourcmds := array[] of {
+ "label .l -height 10",
+ "frame .c -height 224 -width 224",
+ "pack .l -fill x -expand 1",
+ "pack .c -side bottom -fill both -expand 1",
+ "pack propagate . 0",
+ "bind .c <Button-1> {send cmd push %x %y}",
+ "bind .c <ButtonRelease-1> {send cmd release}",
+};
+
+lastcolour := "255";
+lasttkcolour := "#000000";
+
+colourmenu(c: chan of string)
+{
+ (t, winctl) := tkclient->toplevel(drawctxt, nil, "Whiteboard", Tkclient->OK);
+ cmd := chan of string;
+ tk->namechan(t, cmd, "cmd");
+ tkcmds(t, colourcmds);
+ tkcmd(t, ".l configure -bg " + lasttkcolour);
+ tkcmd(t, "update");
+ tkclient->onscreen(t, "onscreen");
+ tkclient->startinput(t, "kbd" :: "ptr" :: nil);
+
+ drawcolours(t.image, tk->rect(t, ".c", Tk->Local));
+
+ for(;;) alt {
+ p := <-t.ctxt.ptr =>
+ tk->pointer(t, *p);
+ s := <-t.ctxt.kbd =>
+ tk->keyboard(t, s);
+ s := <-winctl or
+ s = <-t.ctxt.ctl or
+ s = <-t.wreq =>
+ case s{
+ "ok" =>
+ c <-= "colour " + lastcolour + " " + lasttkcolour;
+ return;
+ "exit" =>
+ c <-= "colour";
+ return;
+ * =>
+ oldimage := t.image;
+ e := tkclient->wmctl(t, s);
+ if(s[0] == '!' && e == nil && oldimage != t.image)
+ drawcolours(t.image, tk->rect(t, ".c", Tk->Local));
+ }
+
+ press := <-cmd =>
+ (n, word) := sys->tokenize(press, " ");
+ case hd word {
+ "push" =>
+ (lastcolour, lasttkcolour) = color(int hd tl word, int hd tl tl word, tk->rect(t, ".c", 0).size());
+ tkcmd(t, ".l configure -bg " + lasttkcolour);
+ }
+ }
+}
+
+drawcolours(img: ref Image, cr: Rect)
+{
+ # use writepixels because it's much faster than allocating all those colors.
+ tmp := disp.newimage(((0,0),(cr.dx(),cr.dy()/16+1)), Draw->CMAP8, 0, 0);
+ if(tmp == nil)
+ return;
+ buf := array[tmp.r.dx()*tmp.r.dy()] of byte;
+ dx := cr.dx();
+ dy := cr.dy();
+ for(y:=0; y<16; y++){
+ for(i:=tmp.r.dx()-1; i>=0; --i)
+ buf[i] = byte (16*y+(16*i)/dx);
+ for(k:=tmp.r.dy()-1; k>=1; --k)
+ buf[dx*k:] = buf[0:dx];
+ tmp.writepixels(tmp.r, buf);
+ r: Rect;
+ r.min.x = cr.min.x;
+ r.max.x = cr.max.x;
+ r.min.y = cr.min.y+(dy*y)/16;
+ r.max.y = cr.min.y+(dy*(y+1))/16;
+ img.draw(r, tmp, nil, tmp.r.min);
+ }
+}
+
+color(x, y: int, size: Point): (string, string)
+{
+ x = (16*x)/size.x;
+ y = (16*y)/size.y;
+ col := 16*y+x;
+ (r, g, b) := disp.cmap2rgb(col);
+ tks := sys->sprint("#%.2x%.2x%.2x", r, g, b);
+ return (string disp.cmap2rgba(col), tks);
+}
+
+opensvc(dir: string, svc: string, name: string): (ref Sys->FD, string, string)
+{
+ ctlfd := sys->open(dir+"/ctl", Sys->ORDWR);
+ if(ctlfd == nil)
+ return (nil, nil, sys->sprint("can't open %s/ctl: %r", dir));
+ if(sys->fprint(ctlfd, "%s %s", svc, name) <= 0)
+ return (nil, nil, sys->sprint("can't access %s service %s: %r", svc, name));
+ buf := array [32] of byte;
+ sys->seek(ctlfd, big 0, Sys->SEEKSTART);
+ n := sys->read(ctlfd, buf, len buf);
+ if (n <= 0)
+ return (nil, nil, sys->sprint("%s/ctl: protocol error: %r", dir));
+ return (ctlfd, dir+"/"+string buf[0:n], nil);
+}
+
+connect(dir, name: string, res: chan of (string, ref Image, ref Sys->FD, ref Sys->FD))
+{
+ (ctlfd, srvdir, emsg) := opensvc(dir, "whiteboard", name);
+ if(ctlfd == nil) {
+ res <-= (emsg, nil, nil, nil);
+ return;
+ }
+
+ bitpath := srvdir + "/wb.bit";
+ strokepath := srvdir + "/strokes";
+
+ sfd := sys->open(strokepath, Sys->ORDWR);
+ if (sfd == nil) {
+ err := sys->sprint("cannot open whiteboard data: %r");
+ res <-= (err, nil, nil, nil);
+ srvfd = nil;
+ return;
+ }
+
+ bfd := sys->open(bitpath, Sys->OREAD);
+ if (bfd == nil) {
+ err := sys->sprint("cannot open whiteboard image: %r");
+ res <-= (err, nil, nil, nil);
+ srvfd = nil;
+ return;
+ }
+
+ img := disp.readimage(bfd);
+ if (img == nil) {
+ err := sys->sprint("cannot read whiteboard image: %r");
+ res <-= (err, nil, nil, nil);
+ srvfd = nil;
+ return;
+ }
+sys->print("read image ok\n");
+
+ # make sure image is depth 8 (because of image.line() bug)
+ if (img.depth != 8) {
+sys->print("depth is %d, not 8\n", img.depth);
+ nimg := disp.newimage(img.r, Draw->CMAP8, 0, 0);
+ if (nimg == nil) {
+ res <-= ("cannot allocate local image", nil, nil, nil);
+ srvfd = nil;
+ return;
+ }
+ nimg.draw(nimg.r, img, nil, img.r.min);
+ img = nimg;
+ }
+
+ res <-= (nil, img, sfd, ctlfd);
+}
+
+reader(fd: ref Sys->FD, sc: chan of (int, int, array of Point))
+{
+ buf := array [Sys->ATOMICIO] of byte;
+
+ for (;;) {
+ n := sys->read(fd, buf, len buf);
+ if (n <= 0) {
+ sc <-= (0, 0, nil);
+ return;
+ }
+ s := string buf[0:n];
+ (npts, toks) := sys->tokenize(s, " ");
+ if (npts & 1)
+ # something wrong
+ npts--;
+ if (npts < 6)
+ # ignore
+ continue;
+
+ colour, width: int;
+ (colour, toks) = (int hd toks, tl toks);
+ (width, toks) = (int hd toks, tl toks);
+ pts := array [(npts - 2)/ 2] of Point;
+ for (i := 0; toks != nil; i++) {
+ x, y: int;
+ (x, toks) = (int hd toks, tl toks);
+ (y, toks) = (int hd toks, tl toks);
+ pts[i] = Point(x, y);
+ }
+ sc <-= (colour, width, pts);
+ pts = nil;
+ }
+}
+
+Wmsg: adt {
+ data: array of byte;
+ datalen: int;
+ next: cyclic ref Wmsg;
+};
+
+writer(fd: ref Sys->FD, sc: chan of (int, int, Point, Point))
+{
+ lastcol := -1;
+ lastw := -1;
+ lastpt := Point(-1, -1);
+ curmsg: ref Wmsg;
+ nextmsg: ref Wmsg;
+
+ eofc := chan of int;
+ wc := chan of ref Wmsg;
+ wseof := 0;
+ spawn wslave(fd, wc, eofc);
+
+ for (;;) {
+ colour := -1;
+ width := 0;
+ p0, p1: Point;
+
+ if (curmsg == nil || wseof)
+ (colour, width, p0, p1) = <-sc;
+ else alt {
+ wseof = <-eofc =>
+ ;
+
+ (colour, width, p0, p1) = <-sc =>
+ ;
+
+ wc <-= curmsg =>
+ curmsg = curmsg.next;
+ continue;
+ }
+
+ newseq := 0;
+ if (curmsg == nil) {
+ curmsg = ref Wmsg(array [Sys->ATOMICIO] of byte, 0, nil);
+ nextmsg = curmsg;
+ newseq = 1;
+ }
+
+ if (colour != lastcol || width != lastw || p0.x != lastpt.x || p0.y != lastpt.y)
+ newseq = 1;
+
+ d: array of byte = nil;
+ if (!newseq) {
+ d = sys->aprint(" %d %d", p1.x, p1.y);
+ if (nextmsg.datalen + len d >= Sys->ATOMICIO) {
+ nextmsg.next = ref Wmsg(array [Sys->ATOMICIO] of byte, 0, nil);
+ nextmsg = nextmsg.next;
+ newseq = 1;
+ }
+ }
+ if (newseq) {
+ d = sys->aprint(" %d %d %d %d %d %d", colour, width, p0.x, p0.y, p1.x, p1.y);
+ if (nextmsg.datalen != 0) {
+ nextmsg.next = ref Wmsg(array [Sys->ATOMICIO] of byte, 0, nil);
+ nextmsg = nextmsg.next;
+ }
+ }
+ nextmsg.data[nextmsg.datalen:] = d;
+ nextmsg.datalen += len d;
+ lastcol = colour;
+ lastw = width;
+ lastpt = p1;
+ }
+}
+
+wslave(fd: ref Sys->FD, wc: chan of ref Wmsg, eof: chan of int)
+{
+ for (;;) {
+ wm := <-wc;
+ n := sys->write(fd, wm.data, wm.datalen);
+ if (n != wm.datalen)
+ break;
+ }
+ eof <-= 1;
+}
+
+drawstroke(img: ref Image, offset, p0, p1: Point, pen: ref Image, width: int)
+{
+ p0 = p0.add(offset);
+ p1 = p1.add(offset);
+ img.line(p0, p1, Draw->Endsquare, Draw->Endsquare, width, pen, p0);
+}
+
+drawstrokes(img: ref Image, offset: Point, pen: ref Image, width: int, pts: array of Point)
+{
+ if (len pts < 2)
+ return;
+ p0, p1: Point;
+ p0 = pts[0].add(offset);
+ for (i := 1; i < len pts; i++) {
+ p1 = pts[i].add(offset);
+ img.line(p0, p1, Draw->Endsquare, Draw->Endsquare, width, pen, p0);
+ p0 = p1;
+ }
+}
+
+badmod(mod: string)
+{
+ sys->fprint(stderr, "cannot load %s: %r\n", mod);
+ raise "fail:bad module";
+}
+
+tkcmd(t: ref Tk->Toplevel, cmd: string): string
+{
+ s := tk->cmd(t, cmd);
+ if (s != nil && s[0] == '!') {
+ sys->fprint(stderr, "%s\n", cmd);
+ sys->fprint(stderr, "tk error: %s\n", s);
+ }
+ return s;
+}
+
+tkcmds(t: ref Tk->Toplevel, cmds: array of string)
+{
+ for (i := 0; i < len cmds; i++)
+ tkcmd(t, cmds[i]);
+}
diff --git a/appl/collab/collabsrv.b b/appl/collab/collabsrv.b
new file mode 100644
index 00000000..f9f26011
--- /dev/null
+++ b/appl/collab/collabsrv.b
@@ -0,0 +1,176 @@
+implement Collabsrv;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+
+include "keyring.m";
+include "security.m";
+ auth: Auth;
+
+include "srvmgr.m";
+include "proxy.m";
+
+include "arg.m";
+
+Collabsrv: module
+{
+ init: fn (ctxt: ref Draw->Context, args: list of string);
+};
+
+authinfo: ref Keyring->Authinfo;
+
+stderr: ref Sys->FD;
+Srvreq, Srvreply: import Srvmgr;
+
+usage()
+{
+ sys->fprint(stderr, "usage: collabsrv [-k keyfile] [-n netaddress] [dir]\n");
+ raise "fail:usage";
+}
+
+init(nil: ref Draw->Context, args: list of string)
+{
+ sys = load Sys Sys->PATH;
+ sys->pctl(Sys->NEWPGRP, nil);
+ stderr = sys->fildes(2);
+
+ (err, user) := user();
+ if (err != nil)
+ error(err);
+
+ netaddr := "tcp!*!9999";
+ keyfile := "/usr/" + user + "/keyring/default";
+ root := "/services/collab";
+
+ arg := load Arg Arg->PATH;
+ arg->init(args);
+ while ((opt := arg->opt()) != 0)
+ case opt {
+ 'k' =>
+ keyfile = arg->arg();
+ if (keyfile == nil)
+ usage();
+ if (keyfile[0] != '/' && (len keyfile < 2 || keyfile[0:2] != "./"))
+ keyfile = "/usr/" + user + "/keyring/" + keyfile;
+ 'n' =>
+ netaddr = arg->arg();
+ if (netaddr == nil)
+ usage();
+ * =>
+ usage();
+ }
+ args = arg->argv();
+ arg = nil;
+ if(args != nil)
+ root = hd args;
+
+ auth = load Auth Auth->PATH;
+ if (auth == nil)
+ badmodule(Auth->PATH);
+
+ kr := load Keyring Keyring->PATH;
+ if (kr == nil)
+ badmodule(Keyring->PATH);
+
+ srvmgr := load Srvmgr Srvmgr->PATH;
+ if (srvmgr == nil)
+ badmodule(Srvmgr->PATH);
+
+ err = auth->init();
+ if (err != nil)
+ error(sys->sprint("failed to init Auth: %s", err));
+
+ authinfo = kr->readauthinfo(keyfile);
+ kr = nil;
+ if (authinfo == nil)
+ error(sys->sprint("cannot read %s: %r", keyfile));
+
+ netaddr = netmkaddr(netaddr, "tcp", "9999");
+ (ok, c) := sys->announce(netaddr);
+ if (ok < 0)
+ error(sys->sprint("cannot announce %s: %r", netaddr));
+
+ rc: chan of ref Srvreq;
+ (err, rc) = srvmgr->init(root);
+ if (err != nil)
+ error(err);
+
+ sys->print("Srvmgr started\n");
+
+ for (;;) {
+ (okl, nc) := sys->listen(c);
+ if (okl < 0) {
+ sys->print("listen failed: %r\n");
+ sys->sleep(1000);
+ return;
+ }
+ fd := sys->open(nc.dir+"/data", Sys->ORDWR);
+ if(nc.cfd != nil)
+ sys->fprint(nc.cfd, "keepalive");
+ nc.cfd = nil;
+ if (fd != nil)
+ spawn newclient(rc, fd, root);
+ fd = nil;
+ }
+}
+
+badmodule(path: string)
+{
+ error(sys->sprint("cannot load module %s: %r", path));
+}
+
+error(s: string)
+{
+ sys->fprint(stderr, "collabsrv: %s\n", s);
+ raise "fail:error";
+}
+
+user(): (string, string)
+{
+ sys = load Sys Sys->PATH;
+ fd := sys->open("/dev/user", sys->OREAD);
+ if(fd == nil)
+ return (sys->sprint("can't open /dev/user: %r"), nil);
+ buf := array[128] of byte;
+ n := sys->read(fd, buf, len buf);
+ if(n <= 0)
+ return (sys->sprint("failed to read /dev/user: %r"), nil);
+ return (nil, string buf[0:n]);
+}
+
+newclient(rc: chan of ref Srvreq, fd: ref Sys->FD, root: string)
+{
+ algs := "none" :: "clear" :: "md4" :: "md5" :: nil;
+ sys->print("new client\n");
+ proxy := load Proxy Proxy->PATH;
+ if (proxy == nil) {
+ sys->fprint(stderr, "collabsrv: cannot load %s: %r\n", Proxy->PATH);
+ return;
+ }
+ sys->pctl(Sys->NEWPGRP|Sys->FORKNS|Sys->FORKENV, nil);
+ s := "";
+ (fd, s) = auth->server(algs, authinfo, fd, 1);
+ if (fd == nil){
+ sys->fprint(stderr, "collabsrv: cannot authenticate: %s\n", s);
+ return;
+ }
+ sys->fprint(stderr, "uname: %s\n", s);
+ spawn proxy->init(root, fd, rc, s);
+}
+
+netmkaddr(addr, net, svc: string): string
+{
+ if(net == nil)
+ net = "net";
+ (n, l) := sys->tokenize(addr, "!");
+ if(n <= 1){
+ if(svc== nil)
+ return sys->sprint("%s!%s", net, addr);
+ return sys->sprint("%s!%s!%s", net, addr, svc);
+ }
+ if(svc == nil || n > 2)
+ return addr;
+ return sys->sprint("%s!%s", addr, svc);
+}
diff --git a/appl/collab/connect.b b/appl/collab/connect.b
new file mode 100644
index 00000000..a8dbffde
--- /dev/null
+++ b/appl/collab/connect.b
@@ -0,0 +1,156 @@
+implement Connect;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+include "keyring.m";
+include "security.m";
+include "arg.m";
+
+Connect: module
+{
+ init: fn(ctxt: ref Draw->Context, argv: list of string);
+};
+
+remotedir := "/n/remote";
+localdir := "/n/ftree/collab";
+COLLABPORT: con "9999"; # TO DO: needs symbolic name in services
+
+usage()
+{
+ sys->fprint(sys->fildes(2), "Usage: connect [-v] [-C cryptoalg] [-k keyring] [net!addr [localdir]]\n");
+ raise "fail:usage";
+}
+
+init(nil: ref Draw->Context, args: list of string)
+{
+ sys = load Sys Sys->PATH;
+
+ vflag := 0;
+ alg := "none";
+ keyfile := "";
+ netaddr := "$collab";
+
+ arg := load Arg Arg->PATH;
+ if(arg != nil){
+ arg->init(args);
+ while((c := arg->opt()) != 0)
+ case c {
+ 'C' =>
+ alg = arg->arg();
+ 'k' =>
+ keyfile = arg->arg();
+ 'v' =>
+ vflag++;
+ * =>
+ usage();
+ }
+ }
+ args = arg->argv();
+ arg = nil;
+
+ if(args != nil){
+ netaddr = hd args;
+ args = tl args;
+ if(args != nil)
+ localdir = hd args;
+ }
+
+ if(vflag)
+ sys->print("connect: dial %s\n", netaddr);
+ (fd, user) := authdial(netaddr, keyfile, alg);
+ if(vflag)
+ sys->print("remote username is %s\n", user);
+ if(sys->mount(fd, nil, remotedir, Sys->MREPL, nil) < 0)
+ error(sys->sprint("can't mount %s on %s: %r", netaddr, remotedir));
+ fd = nil;
+
+ connectdir := remotedir+"/collab";
+ if (sys->bind(connectdir, localdir, Sys->MCREATE|Sys->MREPL) < 0){
+ error(sys->sprint("cannot bind %s onto %s: %r\n", connectdir, localdir));
+ raise "fail:error";
+ }
+
+ # if something such as ftree is running and watching for changes, tell it about this one
+ fd = sys->open("/chan/nsupdate", Sys->OWRITE);
+ if(fd != nil)
+ sys->fprint(fd, "/n/ftree/collab");
+ if(vflag)
+ sys->print("collab connected\n");
+}
+
+authdial(addr, keyfile, alg: string): (ref Sys->FD, string)
+{
+ cert : string;
+
+ kr := load Keyring Keyring->PATH;
+ if(kr == nil)
+ error(sys->sprint("cannot load %s: %r", Keyring->PATH));
+
+ kd := "/usr/" + user() + "/keyring/";
+ if (keyfile == nil) {
+ cert = kd + netmkaddr(addr, "tcp", "");
+ (ok, nil) := sys->stat(cert);
+ if (ok < 0)
+ cert = kd + "default";
+ }
+ else if (len keyfile > 0 && keyfile[0] != '/')
+ cert = kd + keyfile;
+ else
+ cert = keyfile;
+ ai := kr->readauthinfo(cert);
+ if (ai == nil)
+ error(sys->sprint("cannot read authentication data from %s: %r", cert));
+
+ au := load Auth Auth->PATH;
+ if(au == nil)
+ error(sys->sprint("cannot load %s: %r", Auth->PATH));
+ err := au->init();
+ if(err != nil)
+ error(sys->sprint("cannot init Auth: %s", err));
+
+ (ok, c) := sys->dial(netmkaddr(addr, "tcp", COLLABPORT), nil);
+ if(ok < 0)
+ error(sys->sprint("can't dial %s: %r", addr));
+ (fd, id_or_err) := au->client(alg, ai, c.dfd);
+ if(fd == nil)
+ error(sys->sprint("authentication failed: %s", id_or_err));
+
+ return (fd, id_or_err);
+}
+
+user(): string
+{
+ fd := sys->open("/dev/user", sys->OREAD);
+ if(fd == nil)
+ return "";
+
+ buf := array[Sys->NAMEMAX] of byte;
+ n := sys->read(fd, buf, len buf);
+ if(n < 0)
+ return "";
+
+ return string buf[0:n];
+}
+
+netmkaddr(addr, net, svc: string): string
+{
+ if(net == nil)
+ net = "net";
+ (n, l) := sys->tokenize(addr, "!");
+ if(n <= 1){
+ if(svc== nil)
+ return sys->sprint("%s!%s", net, addr);
+ return sys->sprint("%s!%s!%s", net, addr, svc);
+ }
+ if(svc == nil || n > 2)
+ return addr;
+ return sys->sprint("%s!%s", addr, svc);
+}
+
+error(m: string)
+{
+ sys->fprint(sys->fildes(2), "connect: %s\n", m);
+ raise "fail:error";
+}
diff --git a/appl/collab/lib/messages.b b/appl/collab/lib/messages.b
new file mode 100644
index 00000000..ab982339
--- /dev/null
+++ b/appl/collab/lib/messages.b
@@ -0,0 +1,86 @@
+implement Messages;
+
+#
+# message queues and their users
+#
+
+include "messages.m";
+
+clientidgen := 1;
+
+init()
+{
+ clientidgen = 1;
+}
+
+Msglist.new(): ref Msglist
+{
+ msgs := ref Msglist;
+ msgs.tail = ref Msg; # valid Msg when .next != nil
+ return msgs;
+}
+
+Msglist.queue(msgs: self ref Msglist): ref Msg
+{
+ return msgs.tail;
+}
+
+Msglist.wait(msgs: self ref Msglist, u: ref User, rd: ref Readreq)
+{
+ msgs.readers = (u, rd) :: msgs.readers; # list reversed, but currently does not matter
+}
+
+Msglist.write(msgs: self ref Msglist, m: ref Msg): list of (ref User, ref Readreq)
+{
+ tail := msgs.tail;
+ tail.from = m.from;
+ tail.data = m.data;
+ tail.next = ref Msg(nil, nil, nil);
+ msgs.tail = tail.next; # next message will be formed in tail.next
+ rl := msgs.readers;
+ msgs.readers = nil;
+ return rl;
+}
+
+Msglist.flushtag(msgs: self ref Msglist, tag: int)
+{
+ rl := msgs.readers;
+ msgs.readers = nil;
+ for(; rl != nil; rl = tl rl){
+ (nil, req) := hd rl;
+ if(req.tag != tag)
+ msgs.readers = hd rl :: msgs.readers;
+ }
+}
+
+Msglist.flushfid(msgs: self ref Msglist, fid: int)
+{
+ rl := msgs.readers;
+ msgs.readers = nil;
+ for(; rl != nil; rl = tl rl){
+ (nil, req) := hd rl;
+ if(req.fid != fid)
+ msgs.readers = hd rl :: msgs.readers;
+ }
+}
+
+User.new(fid: int, name: string): ref User
+{
+ return ref User(clientidgen++, fid, name, nil);
+}
+
+User.initqueue(u: self ref User, msgs: ref Msglist)
+{
+ u.queue = msgs.tail;
+}
+
+User.read(u: self ref User): ref Msg
+{
+ if((m := u.queue).next != nil){
+ u.queue = m.next;
+ m = ref *m; # copy to ensure no aliasing
+ m.next = nil;
+ return m;
+ }
+ return nil;
+}
diff --git a/appl/collab/lib/messages.m b/appl/collab/lib/messages.m
new file mode 100644
index 00000000..ab1c679a
--- /dev/null
+++ b/appl/collab/lib/messages.m
@@ -0,0 +1,42 @@
+Messages: module
+{
+ PATH: con "/dis/collab/lib/messages.dis";
+
+ Msg: adt {
+ from: cyclic ref User;
+ data: array of byte;
+ next: cyclic ref Msg;
+ };
+
+ Msglist: adt {
+ tail: ref Msg;
+ readers: list of (ref User, ref Readreq);
+
+ new: fn(): ref Msglist;
+ flushfid: fn(nil: self ref Msglist, fid: int);
+ flushtag: fn(nil: self ref Msglist, tag: int);
+ wait: fn(nil: self ref Msglist, u: ref User, r: ref Readreq);
+ write: fn(nil: self ref Msglist, m: ref Msg): list of (ref User, ref Readreq);
+ queue: fn(nil: self ref Msglist): ref Msg;
+ };
+
+ Readreq: adt {
+ tag: int;
+ fid: int;
+ count: int;
+ offset: big;
+ };
+
+ User: adt {
+ id: int;
+ fid: int;
+ name: string;
+ queue: cyclic ref Msg;
+
+ new: fn(fid: int, name: string): ref User;
+ initqueue: fn(nil: self ref User, msgs: ref Msglist);
+ read: fn(nil: self ref User): ref Msg;
+ };
+
+ init: fn();
+};
diff --git a/appl/collab/mkfile b/appl/collab/mkfile
new file mode 100644
index 00000000..b26c9626
--- /dev/null
+++ b/appl/collab/mkfile
@@ -0,0 +1,62 @@
+<../../mkconfig
+
+SERVERS=\
+ servers/chatsrv.dis \
+ servers/memfssrv.dis \
+ servers/mpx.dis \
+ servers/wbsrv.dis \
+
+CLIENTS=\
+ clients/chat.dis \
+ clients/poll.dis \
+ clients/poller.dis \
+ clients/whiteboard.dis \
+
+LIB=\
+ lib/messages.dis \
+
+MAIN=\
+ collabsrv.dis \
+ connect.dis \
+ proxy.dis \
+ srvmgr.dis \
+
+MODULES=\
+ proxy.m\
+ service.m\
+ srvmgr.m\
+
+SYSMODULES=\
+ arg.m\
+ cfg.m\
+ draw.m\
+ keyring.m\
+ security.m\
+ sys.m\
+
+DEST=$ROOT/dis/collab
+
+ALL = $SERVERS $CLIENTS $LIB $MAIN
+
+all:V: $ALL
+
+install:V: ${SERVERS:%=$DEST/%} \
+ ${CLIENTS:%=$DEST/%} \
+ ${LIB:%=$DEST/%} \
+ ${MAIN:%=$DEST/%}
+
+$DEST/%.dis: %.dis
+ cp $stem.dis $target
+
+%.dis: $MODULES ${SYSMODULES:%=$ROOT/module/%}
+
+%.dis: %.b
+ limbo -gw -I$ROOT/module -Ilib -I. -o $stem.dis $stem.b
+
+$ENGINES $MAIN $LIB: service.m srvmgr.m proxy.m lib/messages.m
+
+clean:NV:
+ rm -f *.dis *.sbl */*.dis */*.sbl
+
+nuke:NV: clean
+ cd $DEST && rm -f $ALL
diff --git a/appl/collab/proxy.b b/appl/collab/proxy.b
new file mode 100644
index 00000000..83999495
--- /dev/null
+++ b/appl/collab/proxy.b
@@ -0,0 +1,177 @@
+implement Proxy;
+
+include "sys.m";
+ sys: Sys;
+
+include "srvmgr.m";
+include "proxy.m";
+
+Srvreq, Srvreply: import Srvmgr;
+
+init(root: string, fd: ref Sys->FD, rc: chan of ref Srvreq, user: string)
+{
+ sys = load Sys Sys->PATH;
+
+ sys->chdir(root);
+ sys->bind("export/services", "export/services", Sys->MCREATE);
+ sys->bind("#s", "export/services", Sys->MBEFORE);
+
+ ctlio := sys->file2chan("export/services", "ctl");
+
+ hangup := chan of int;
+ spawn export(fd, "export", hangup);
+ fd = nil;
+
+ for (;;) alt {
+ <- hangup =>
+ # closedown all clients
+ sys->print("client exit [%s]\n", user);
+ rmclients(rc);
+ return;
+ (offset, count, fid, r) := <- ctlio.read =>
+ client := fid2client(fid);
+ if (r == nil) {
+ if (client != nil)
+ rmclient(rc, client);
+ continue;
+ }
+ if (client == nil) {
+ rreply(r, (nil, "service not set"));
+ continue;
+ }
+ rreply(r, reads(client.path, offset, count));
+
+ (offset, data, fid, w) := <- ctlio.write =>
+ client := fid2client(fid);
+ if (w == nil) {
+ if (client != nil)
+ rmclient(rc, client);
+ continue;
+ }
+ if (client != nil) {
+ wreply(w, (0, "service set"));
+ continue;
+ }
+ err := newclient(rc, user, fid, string data);
+ if (err != nil)
+ wreply(w, (0, err));
+ else
+ wreply(w, (len data, nil));
+ }
+
+}
+
+rreply(rc: chan of (array of byte, string), reply: (array of byte, string))
+{
+ alt {
+ rc <-= reply =>;
+ * =>;
+ }
+}
+
+wreply(wc: chan of (int, string), reply: (int, string))
+{
+ alt {
+ wc <-= reply=>;
+ * =>;
+ }
+}
+
+reads(str: string, off, nbytes: int): (array of byte, string)
+{
+ bstr := array of byte str;
+ slen := len bstr;
+ if(off < 0 || off >= slen)
+ return (nil, nil);
+ if(off + nbytes > slen)
+ nbytes = slen - off;
+ if(nbytes <= 0)
+ return (nil, nil);
+ return (bstr[off:off+nbytes], nil);
+}
+
+export(exportfd: ref Sys->FD, dir: string, done: chan of int)
+{
+ sys->export(exportfd, dir, Sys->EXPWAIT);
+ done <-= 1;
+}
+
+Client: adt {
+ fid: int;
+ path: string;
+ sname: string;
+ id: string;
+};
+
+clients: list of ref Client;
+freepaths: list of string;
+nextpath := 0;
+
+fid2client(fid: int): ref Client
+{
+ for(cl := clients; cl != nil; cl = tl cl)
+ if ((c := hd cl).fid == fid)
+ return c;
+ return nil;
+}
+
+newclient(rc: chan of ref Srvreq, user: string, fid: int, cmd: string): string
+{
+sys->print("new Client %s [%s]\n", user, cmd);
+ for (i := 0; i < len cmd; i++)
+ if (cmd[i] == ' ')
+ break;
+ if (i == 0 || i == len cmd)
+ return "bad command";
+
+ sname := cmd[:i];
+ id := cmd[i:];
+ reply := chan of Srvreply;
+ rc <-= ref Srvreq.Acquire(sname, id, user, reply);
+ (err, root, fd) := <- reply;
+ if (err != nil)
+ return err;
+
+ path := "";
+ if (freepaths != nil)
+ (path, freepaths) = (hd freepaths, tl freepaths);
+ else
+ path = string nextpath++;
+
+ sys->mount(fd, nil, "mnt", Sys->MREPL, nil); # connection to the active service fs
+ mkdir("export/services/"+path);
+ sys->bind("mnt/"+root, "export/services/"+path, Sys->MREPL|Sys->MCREATE);
+ sys->unmount("mnt", nil);
+ clients = ref Client(fid, path, sname, id) :: clients;
+ return nil;
+}
+
+rmclient(rc: chan of ref Srvreq, client: ref Client)
+{
+sys->print("rmclient [%s %s]\n", client.sname, client.id);
+ nl: list of ref Client;
+ for(cl := clients; cl != nil; cl = tl cl)
+ if((c := hd cl) == client){
+ sys->unmount("export/services/" + client.path, nil);
+ freepaths = client.path :: freepaths;
+ rc <-= ref Srvreq.Release(client.sname, client.id);
+ } else
+ nl = c :: nl;
+ clients = nl;
+}
+
+rmclients(rc: chan of ref Srvreq)
+{
+ for(cl := clients; cl != nil; cl = tl cl){
+ c := hd cl;
+sys->print("rmclients [%s %s]\n", c.sname, c.id);
+ rc <-= ref Srvreq.Release(c.sname, c.id);
+ }
+ clients = nil;
+}
+
+mkdir(path: string)
+{
+ sys->print("mkdir [%s]\n", path);
+ sys->create(path, Sys->OREAD, 8r777 | Sys->DMDIR);
+}
diff --git a/appl/collab/proxy.m b/appl/collab/proxy.m
new file mode 100644
index 00000000..d4169bc7
--- /dev/null
+++ b/appl/collab/proxy.m
@@ -0,0 +1,5 @@
+Proxy: module
+{
+ PATH: con "/dis/collab/proxy.dis";
+ init: fn (root: string, fd: ref Sys->FD, rc: chan of ref Srvmgr->Srvreq, user: string);
+};
diff --git a/appl/collab/runcollab b/appl/collab/runcollab
new file mode 100755
index 00000000..c8e980dc
--- /dev/null
+++ b/appl/collab/runcollab
@@ -0,0 +1,8 @@
+#!/dis/sh
+
+load std
+and {~ $#* 0} {echo usage: runcollab collabname >[2=1]; exit usage}
+pctl forkns
+or {bind -bc /services/$1 /services/collab} {exit fail}
+or {bind /dis/collab/servers /services/collab/servers} {exit fail}
+collab/collabsrv /services/collab
diff --git a/appl/collab/servers/chatsrv.b b/appl/collab/servers/chatsrv.b
new file mode 100644
index 00000000..072c0617
--- /dev/null
+++ b/appl/collab/servers/chatsrv.b
@@ -0,0 +1,263 @@
+implement Service;
+
+#
+# simple text-based chat service
+#
+
+include "sys.m";
+ sys: Sys;
+ Qid: import Sys;
+
+include "styx.m";
+ styx: Styx;
+ Tmsg, Rmsg: import Styx;
+
+include "styxservers.m";
+ styxservers: Styxservers;
+ Styxserver, Navigator: import styxservers;
+ nametree: Nametree;
+ Tree: import nametree;
+
+include "../service.m";
+
+Qdir, Qusers, Qmsgs: con iota;
+
+tc: chan of ref Tmsg;
+srv: ref Styxserver;
+
+user := "inferno";
+
+dir(name: string, perm: int, path: int): Sys->Dir
+{
+ d := sys->zerodir;
+ d.name = name;
+ d.uid = user;
+ d.gid = user;
+ d.qid.path = big path;
+ if(perm & Sys->DMDIR)
+ d.qid.qtype = Sys->QTDIR;
+ else
+ d.qid.qtype = Sys->QTFILE;
+ d.mode = perm;
+ return d;
+}
+
+init(nil: list of string): (string, string, ref Sys->FD)
+{
+ sys = load Sys Sys->PATH;
+ styx = load Styx Styx->PATH;
+ if(styx == nil)
+ return (sys->sprint("can't load %s: %r", Styx->PATH), nil, nil);
+ styxservers = load Styxservers Styxservers->PATH;
+ if(styxservers == nil)
+ return (sys->sprint("can't load %s: %r", Styxservers->PATH), nil, nil);
+ nametree = load Nametree Nametree->PATH;
+ if(nametree == nil)
+ return (sys->sprint("can't load %s: %r", Nametree->PATH), nil, nil);
+ styx->init();
+ styxservers->init(styx);
+ nametree->init();
+
+ (tree, treeop) := nametree->start();
+ tree.create(big Qdir, dir(".", Sys->DMDIR|8r555, Qdir));
+ tree.create(big Qdir, dir("users", 8r444, Qusers));
+ tree.create(big Qdir, dir("msgs", 8r666, Qmsgs));
+
+ p := array [2] of ref Sys->FD;
+ if (sys->pipe(p) < 0){
+ tree.quit();
+ return (sys->sprint("cannot create pipe: %r"), nil, nil);
+ }
+
+ nextmsg = ref Msg (0, nil, nil, nil);
+
+ (tc, srv) = Styxserver.new(p[1], Navigator.new(treeop), big Qdir);
+ spawn chatsrv(tree);
+
+ return (nil, "/", p[0]);
+}
+
+chatsrv(tree: ref Tree)
+{
+ while((tmsg := <-tc) != nil){
+ pick tm := tmsg {
+ Readerror =>
+ break;
+ Flush =>
+ cancelpending(tm.tag);
+ srv.reply(ref Rmsg.Flush(tm.tag));
+ Open =>
+ c := srv.open(tm);
+ if (c == nil)
+ break;
+ if (int c.path == Qmsgs){
+ newmsgclient(tm.fid, c.uname);
+ #root[0].qid.vers++; # TO DO
+ }
+ Read =>
+ c := srv.getfid(tm.fid);
+ if (c == nil || !c.isopen) {
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Ebadfid));
+ break;
+ }
+ case int c.path {
+ Qdir =>
+ srv.read(tm);
+ Qmsgs =>
+ mc := getmsgclient(tm.fid);
+ if (mc == nil) {
+ srv.reply(ref Rmsg.Error(tm.tag, "internal error -- lost client"));
+ continue;
+ }
+ tm.offset = big 0;
+ msg := getnextmsg(mc);
+ if (msg == nil) {
+ if(mc.pending != nil)
+ srv.reply(ref Rmsg.Error(tm.tag, "read already pending"));
+ else
+ mc.pending = tm;
+ continue;
+ }
+ srv.reply(styxservers->readstr(tm, msg));
+ Qusers =>
+ srv.reply(styxservers->readstr(tm, usernames()));
+ * =>
+ srv.reply(ref Rmsg.Error(tm.tag, "phase error -- bad path"));
+ }
+ Write =>
+ c := srv.getfid(tm.fid);
+ if (c == nil || !c.isopen) {
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Ebadfid));
+ continue;
+ }
+ if (int c.path != Qmsgs) {
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Eperm));
+ continue;
+ }
+ writemsgclients(tm.fid, c.uname, string tm.data);
+ srv.reply(ref Rmsg.Write(tm.tag, len tm.data));
+ Clunk =>
+ c := srv.clunk(tm);
+ if (c != nil && int c.path == Qmsgs){
+ closemsgclient(tm.fid);
+ # root[0].qid.vers++; # TO DO
+ }
+ * =>
+ srv.default(tmsg);
+ }
+ }
+ tree.quit();
+ sys->print("chatsrv exit\n");
+}
+
+Msg: adt {
+ fromfid: int;
+ from: string;
+ msg: string;
+ next: cyclic ref Msg;
+};
+
+Msgclient: adt {
+ fid: int;
+ name: string;
+ nextmsg: ref Msg;
+ pending: ref Tmsg.Read;
+ next: cyclic ref Msgclient;
+};
+
+nextmsg: ref Msg;
+msgclients: ref Msgclient;
+
+usernames(): string
+{
+ s := "";
+ for (c := msgclients; c != nil; c = c.next)
+ s += c.name+"\n";
+ return s;
+}
+
+newmsgclient(fid: int, name: string)
+{
+ writemsgclients(fid, nil, "+++ " + name + " has arrived");
+ msgclients = ref Msgclient(fid, name, nextmsg, nil, msgclients);
+}
+
+getmsgclient(fid: int): ref Msgclient
+{
+ for (c := msgclients; c != nil; c = c.next)
+ if (c.fid == fid)
+ return c;
+ return nil;
+}
+
+cancelpending(tag: int)
+{
+ for (c := msgclients; c != nil; c = c.next)
+ if((tm := c.pending) != nil && tm.tag == tag){
+ c.pending = nil;
+ break;
+ }
+}
+
+closemsgclient(fid: int)
+{
+ prev: ref Msgclient;
+ s := "";
+ for (c := msgclients; c != nil; c = c.next) {
+ if (c.fid == fid) {
+ if (prev == nil)
+ msgclients = c.next;
+ else
+ prev.next = c.next;
+ s = "--- " + c.name + " has left";
+ break;
+ }
+ prev = c;
+ }
+ if (s != nil)
+ writemsgclients(fid, nil, s);
+}
+
+writemsgclients(fromfid: int, from: string, msg: string)
+{
+ nm := ref Msg(0, nil, nil, nil);
+ nextmsg.fromfid = fromfid;
+ nextmsg.from = from;
+ nextmsg.msg = msg;
+ nextmsg.next = nm;
+
+ for (c := msgclients; c != nil; c = c.next) {
+ if (c.pending != nil) {
+ s := msgtext(c, nextmsg);
+ srv.reply(styxservers->readstr(c.pending, s));
+ c.pending = nil;
+ c.nextmsg = nm;
+ }
+ }
+ nextmsg = nm;
+}
+
+getnextmsg(mc: ref Msgclient): string
+{
+# uncomment next two lines to eliminate queued messages to self
+# while(mc.nextmsg.next != nil && mc.nextmsg.fromfid == mc.fid)
+# mc.nextmsg = mc.nextmsg.next;
+ if ((m := mc.nextmsg).next != nil){
+ mc.nextmsg = m.next;
+ return msgtext(mc, m);
+ }
+ return nil;
+}
+
+msgtext(mc: ref Msgclient, m: ref Msg): string
+{
+ prefix := "";
+ if (m.from != nil) {
+ # not a system message
+ if (mc.fid == m.fromfid)
+ prefix = "<you>: ";
+ else
+ prefix = m.from + ": ";
+ }
+ return prefix + m.msg;
+}
diff --git a/appl/collab/servers/memfssrv.b b/appl/collab/servers/memfssrv.b
new file mode 100644
index 00000000..8c44cd5d
--- /dev/null
+++ b/appl/collab/servers/memfssrv.b
@@ -0,0 +1,20 @@
+implement Service;
+
+include "sys.m";
+include "../service.m";
+include "memfs.m";
+
+init(nil : list of string) : (string, string, ref Sys->FD)
+{
+ sys := load Sys Sys->PATH;
+ memfs := load MemFS MemFS->PATH;
+ if (memfs == nil) {
+ err := sys->sprint("cannot load %s: %r", MemFS->PATH);
+ return (err, nil, nil);
+ }
+ err := memfs->init();
+ if (err != nil)
+ return (err, nil, nil);
+ fd := memfs->newfs(1024 * 512);
+ return (nil, "/", fd);
+}
diff --git a/appl/collab/servers/mpx.b b/appl/collab/servers/mpx.b
new file mode 100644
index 00000000..ea0c2c1c
--- /dev/null
+++ b/appl/collab/servers/mpx.b
@@ -0,0 +1,301 @@
+implement Service;
+
+#
+# 1 to many and many to 1 multiplexor
+#
+
+include "sys.m";
+ sys: Sys;
+ Qid: import Sys;
+
+include "styx.m";
+ styx: Styx;
+ Tmsg, Rmsg: import styx;
+
+include "styxservers.m";
+ styxservers: Styxservers;
+ Styxserver, Navigator: import styxservers;
+ nametree: Nametree;
+ Tree: import nametree;
+
+include "service.m";
+
+include "messages.m";
+ messages: Messages;
+ Msg, Msglist, Readreq, User: import messages;
+
+Qdir, Qroot, Qusers, Qleaf: con iota;
+
+srv: ref Styxserver;
+clientidgen := 0;
+
+Einactive: con "not currently active";
+
+toleaf: ref Msglist;
+toroot: ref Msglist;
+userlist: list of ref User;
+
+user := "inferno";
+
+dir(name: string, perm: int, path: int): Sys->Dir
+{
+ d := sys->zerodir;
+ d.name = name;
+ d.uid = user;
+ d.gid = user;
+ d.qid.path = big path;
+ if(perm & Sys->DMDIR)
+ d.qid.qtype = Sys->QTDIR;
+ else
+ d.qid.qtype = Sys->QTFILE;
+ d.mode = perm;
+ return d;
+}
+
+init(nil: list of string): (string, string, ref Sys->FD)
+{
+ sys = load Sys Sys->PATH;
+ styx = load Styx Styx->PATH;
+ if(styx == nil)
+ return (sys->sprint("can't load %s: %r", Styx->PATH), nil, nil);
+ styxservers = load Styxservers Styxservers->PATH;
+ if(styxservers == nil)
+ return (sys->sprint("can't load %s: %r", Styxservers->PATH), nil, nil);
+ nametree = load Nametree Nametree->PATH;
+ if(nametree == nil)
+ return (sys->sprint("can't load %s: %r", Nametree->PATH), nil, nil);
+ styx->init();
+ styxservers->init(styx);
+styxservers->traceset(1);
+ nametree->init();
+ messages = load Messages Messages->PATH;
+ if(messages == nil)
+ return (sys->sprint("can't load %s: %r", Messages->PATH), nil, nil);
+
+ (tree, treeop) := nametree->start();
+ tree.create(big Qdir, dir(".", Sys->DMDIR|8r555, Qdir));
+ tree.create(big Qdir, dir("leaf", 8r666, Qleaf));
+ tree.create(big Qdir, dir("root", 8r666, Qroot));
+ tree.create(big Qdir, dir("users", 8r444, Qusers));
+
+ p := array [2] of ref Sys->FD;
+ if (sys->pipe(p) < 0){
+ tree.quit();
+ return (sys->sprint("can't create pipe: %r"), nil, nil);
+ }
+
+ toleaf = Msglist.new();
+ toroot = Msglist.new();
+
+ tc: chan of ref Tmsg;
+ (tc, srv) = Styxserver.new(p[1], Navigator.new(treeop), big Qdir);
+ spawn mpx(tc, tree);
+
+ return (nil, "/", p[0]);
+}
+
+mpx(tc: chan of ref Tmsg, tree: ref Tree)
+{
+ root: ref User;
+ while((tmsg := <-tc) != nil){
+ pick tm := tmsg {
+ Readerror =>
+ break;
+ Open =>
+ c := srv.getfid(tm.fid);
+ if(c == nil || c.isopen){
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Ebadfid));
+ continue;
+ }
+ case int c.path {
+ Qroot =>
+ if(root != nil){
+ srv.reply(ref Rmsg.Error(tm.tag, sys->sprint("interaction already directed by %s", root.name)));
+ continue;
+ }
+ c = srv.open(tm);
+ if (c == nil)
+ continue;
+ root = ref User(0, tm.fid, c.uname, nil);
+ root.initqueue(toroot);
+ Qleaf =>
+ if(root == nil){
+ srv.reply(ref Rmsg.Error(tm.tag, Einactive));
+ continue;
+ }
+ c = srv.open(tm);
+ if (c == nil)
+ continue;
+ userarrives(tm.fid, c.uname);
+ # mpxdir[1].qid.vers++; # TO DO
+ * =>
+ srv.open(tm);
+ }
+ Read =>
+ c := srv.getfid(tm.fid);
+ if (c == nil || !c.isopen) {
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Ebadfid));
+ continue;
+ }
+ case int c.path {
+ Qdir =>
+ srv.read(tm);
+ Qroot =>
+ tm.offset = big 0;
+ m := qread(toroot, root, tm, 1);
+ if(m != nil)
+ srv.reply(ref Rmsg.Read(tm.tag, m.data));
+ Qleaf =>
+ u := fid2user(tm.fid);
+ if (u == nil) {
+ srv.reply(ref Rmsg.Error(tm.tag, "internal error -- lost user"));
+ continue;
+ }
+ tm.offset = big 0;
+ m := qread(toleaf, u, tm, 0);
+ if(m == nil){
+ if(root == nil)
+ srv.reply(ref Rmsg.Read(tm.tag, nil));
+ else
+ qread(toleaf, u, tm, 1); # put us on the wait queue
+ }else
+ srv.reply(ref Rmsg.Read(tm.tag, m.data));
+ Qusers =>
+ srv.reply(styxservers->readstr(tm, usernames()));
+ * =>
+ srv.reply(ref Rmsg.Error(tm.tag, "phase error -- bad path"));
+ }
+ Write =>
+ c := srv.getfid(tm.fid);
+ if (c == nil || !c.isopen) {
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Ebadfid));
+ continue;
+ }
+ case int c.path {
+ Qroot =>
+ qwrite(toleaf, msg(root, 'M', tm.data));
+ srv.reply(ref Rmsg.Write(tm.tag, len tm.data));
+ Qleaf =>
+ u := fid2user(tm.fid);
+ if(u == nil) {
+ srv.reply(ref Rmsg.Error(tm.tag, "internal error -- lost user"));
+ continue;
+ }
+ if(root == nil){
+ srv.reply(ref Rmsg.Error(tm.tag, Einactive));
+ continue;
+ }
+ qwrite(toroot, msg(u, 'm', tm.data));
+ srv.reply(ref Rmsg.Write(tm.tag, len tm.data));
+ * =>
+ srv.reply(ref Rmsg.Error(tm.tag, Styxservers->Eperm));
+ }
+ Flush =>
+ cancelpending(tm.tag);
+ srv.reply(ref Rmsg.Flush(tm.tag));
+ Clunk =>
+ c := srv.getfid(tm.fid);
+ if(c.isopen){
+ case int c.path {
+ Qroot =>
+ # shut down?
+ qwrite(toleaf, msg(root, 'L', nil));
+ root = nil;
+ Qleaf =>
+ userleaves(tm.fid);
+ # mpxdir[1].qid.vers++; # TO DO
+ }
+ }
+ * =>
+ srv.default(tmsg);
+ }
+ }
+ tree.quit();
+ sys->print("mpx exit\n");
+}
+
+mpxseqgen := 0;
+
+time(): int
+{
+ return ++mpxseqgen; # server time; assumes 2^31-1 is large enough
+}
+
+userarrives(fid: int, name: string)
+{
+ u := User.new(fid, name);
+ qwrite(toroot, msg(u, 'a', nil));
+ u.initqueue(toleaf); # sees leaf messages from now on
+ userlist = u :: userlist;
+}
+
+fid2user(fid: int): ref User
+{
+ for(ul := userlist; ul != nil; ul = tl ul)
+ if((u := hd ul).fid == fid)
+ return u;
+ return nil;
+}
+
+userleaves(fid: int)
+{
+ ul := userlist;
+ userlist = nil;
+ u: ref User;
+ for(; ul != nil; ul = tl ul)
+ if((hd ul).fid != fid)
+ userlist = hd ul :: userlist;
+ else
+ u = hd ul;
+ if(u != nil)
+ qwrite(toroot, msg(u, 'l', nil));
+}
+
+usernames(): string
+{
+ s := "";
+ for(ul := userlist; ul != nil; ul = tl ul){
+ u := hd ul;
+ s += string u.id+" "+u.name+"\n";
+ }
+ return s;
+}
+
+qwrite(msgs: ref Msglist, m: ref Msg)
+{
+ pending := msgs.write(m);
+ for(; pending != nil; pending = tl pending){
+ (u, req) := hd pending;
+ m = u.read(); # must succeed, or the code is wrong
+ data := m.data;
+ if(req.count < len data)
+ data = data[0:req.count];
+ srv.reply(ref Rmsg.Read(req.tag, data));
+ }
+}
+
+qread(msgs: ref Msglist, u: ref User, tm: ref Tmsg.Read, wait: int): ref Msg
+{
+ m := u.read();
+ if(m != nil){
+ if(tm.count < len m.data)
+ m.data = m.data[0:tm.count];
+ }else if(wait)
+ msgs.wait(u, ref Readreq(tm.tag, tm.fid, tm.count, tm.offset));
+ return m;
+}
+
+cancelpending(tag: int)
+{
+ toroot.flushtag(tag);
+ toleaf.flushtag(tag);
+}
+
+msg(u: ref User, op: int, data: array of byte): ref Msg
+{
+ a := sys->aprint("%ud %d %c %s ", time(), u.id, op, u.name);
+ m := ref Msg(u, array[len a + len data] of byte, nil);
+ m.data[0:] = a;
+ m.data[len a:] = data;
+ return m;
+}
diff --git a/appl/collab/servers/wbsrv.b b/appl/collab/servers/wbsrv.b
new file mode 100644
index 00000000..2492db7e
--- /dev/null
+++ b/appl/collab/servers/wbsrv.b
@@ -0,0 +1,226 @@
+implement Service;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+ draw: Draw;
+ Chans, Display, Image, Rect, Point : import draw;
+
+include "../service.m";
+
+WBW : con 234;
+WBH : con 279;
+
+init(nil : list of string) : (string, string, ref Sys->FD)
+{
+ sys = load Sys Sys->PATH;
+ draw = load Draw Draw->PATH;
+ if (draw == nil)
+ return ("cannot load Draw module", nil, nil);
+
+ p := array [2] of ref Sys->FD;
+ if (sys->pipe(p) == -1)
+ return (sys->sprint("cannot create pipe: %r"), nil, nil);
+
+ display := Display.allocate(nil);
+ if (display == nil)
+ return (sys->sprint("cannot allocate display: %r"), nil, nil);
+
+ r := Rect(Point(0,0), Point(WBW, WBH));
+ wb := display.newimage(r, Draw->CMAP8, 0, Draw->White);
+ if (wb == nil)
+ return (sys->sprint("cannot allocate whiteboard image: %r"), nil, nil);
+
+ nextmsg = ref Msg (nil, nil);
+ spawn wbsrv(p[1], wb);
+ return (nil, "/chan", p[0]);
+}
+
+wbsrv(fd : ref Sys->FD, wb: ref Image)
+{
+ sys->pctl(Sys->FORKNS, nil);
+ sys->unmount(nil, "/chan");
+ sys->bind("#s", "/chan", Sys->MREPL);
+
+ bit := sys->file2chan("/chan", "wb.bit");
+ strokes := sys->file2chan("/chan", "strokes");
+
+ hangup := chan of int;
+ spawn export(fd, hangup);
+
+ nwbbytes := draw->bytesperline(wb.r, wb.depth) * wb.r.dy();
+ bithdr := sys->aprint("%11s %11d %11d %11d %11d ", wb.chans.text(), 0, 0, WBW, WBH);
+
+ for (;;) alt {
+ <-hangup =>
+ sys->print("whiteboard:hangup\n");
+ return;
+
+ (offset, count, fid, r) := <-bit.read =>
+ if (r == nil) {
+ closeclient(fid);
+ continue;
+ }
+ c := getclient(fid);
+ if (c == nil) {
+ # new client
+ c = newclient(fid);
+ data := array [len bithdr + nwbbytes] of byte;
+ data[0:] = bithdr;
+ wb.readpixels(wb.r, data[len bithdr:]);
+ c.bitdata = data;
+ }
+ if (offset >= len c.bitdata) {
+ rreply(r, (nil, nil));
+ continue;
+ }
+ rreply(r, (c.bitdata[offset:], nil));
+
+ (offset, data, fid, w) := <-bit.write =>
+ if (w != nil)
+ wreply(w, (0, "permission denied"));
+
+ (offset, count, fid, r) := <-strokes.read =>
+ if (r == nil) {
+ closeclient(fid);
+ continue;
+ }
+ c := getclient(fid);
+ if (c == nil) {
+ c = newclient(fid);
+ c.nextmsg = nextmsg;
+ }
+ d := c.nextmsg.data;
+ if (d == nil) {
+ c.pending = r;
+ c.pendlen = count;
+ continue;
+ }
+ c.nextmsg = c.nextmsg.next;
+ rreply(r, (d, nil));
+
+ (offset, data, fid, w) := <-strokes.write =>
+ if (w == nil) {
+ closeclient(fid);
+ continue;
+ }
+ err := drawstrokes(wb, data);
+ if (err != nil) {
+ wreply(w, (0, err));
+ continue;
+ }
+ wreply(w, (len data, nil));
+ writeclients(data);
+ }
+}
+
+rreply(rc: chan of (array of byte, string), reply: (array of byte, string))
+{
+ alt {
+ rc <-= reply =>;
+ * =>;
+ }
+}
+
+wreply(wc: chan of (int, string), reply: (int, string))
+{
+ alt {
+ wc <-= reply=>;
+ * =>;
+ }
+}
+
+export(fd : ref Sys->FD, done : chan of int)
+{
+ sys->export(fd, "/", Sys->EXPWAIT);
+ done <-= 1;
+}
+
+Msg : adt {
+ data : array of byte;
+ next : cyclic ref Msg;
+};
+
+Client : adt {
+ fid : int;
+ bitdata : array of byte; # bit file client
+ nextmsg : ref Msg; # strokes file client
+ pending : Sys->Rread;
+ pendlen : int;
+};
+
+nextmsg : ref Msg;
+clients : list of ref Client;
+
+newclient(fid : int) : ref Client
+{
+ c := ref Client(fid, nil, nil, nil, 0);
+ clients = c :: clients;
+ return c;
+}
+
+getclient(fid : int) : ref Client
+{
+ for(cl := clients; cl != nil; cl = tl cl)
+ if((c := hd cl).fid == fid)
+ return c;
+ return nil;
+}
+
+closeclient(fid : int)
+{
+ nl: list of ref Client;
+ for(cl := clients; cl != nil; cl = tl cl)
+ if((hd cl).fid != fid)
+ nl = hd cl :: nl;
+ clients = nl;
+}
+
+writeclients(data : array of byte)
+{
+ nm := ref Msg(nil, nil);
+ nextmsg.data = data;
+ nextmsg.next = nm;
+
+ for(cl := clients; cl != nil; cl = tl cl){
+ if ((c := hd cl).pending != nil) {
+ n := c.pendlen;
+ if (n > len data)
+ n = len data;
+ alt{
+ c.pending <-= (data[0:n], nil) => ;
+ * => ;
+ }
+ c.pending = nil;
+ c.nextmsg = nm;
+ }
+ }
+ nextmsg = nm;
+}
+
+# data: colour width p0 p1 pn*
+
+drawstrokes(wb: ref Image, data : array of byte) : string
+{
+ (n, toks) := sys->tokenize(string data, " ");
+ if (n < 6 || n & 1)
+ return "bad data";
+
+ colour, width, x, y : int;
+ (colour, toks) = (int hd toks, tl toks);
+ (width, toks) = (int hd toks, tl toks);
+ (x, toks) = (int hd toks, tl toks);
+ (y, toks) = (int hd toks, tl toks);
+ pen := wb.display.newimage(Rect(Point(0,0), Point(1,1)), Draw->CMAP8, 1, colour);
+ p0 := Point(x, y);
+ while (toks != nil) {
+ (x, toks) = (int hd toks, tl toks);
+ (y, toks) = (int hd toks, tl toks);
+ p1 := Point(x, y);
+ # could use poly() instead of line()
+ wb.line(p0, p1, Draw->Endsquare, Draw->Endsquare, width, pen, pen.r.min);
+ p0 = p1;
+ }
+ return nil;
+}
diff --git a/appl/collab/service.m b/appl/collab/service.m
new file mode 100644
index 00000000..4d160a5b
--- /dev/null
+++ b/appl/collab/service.m
@@ -0,0 +1,4 @@
+Service: module
+{
+ init: fn (args: list of string): (string, string, ref Sys->FD);
+};
diff --git a/appl/collab/srvmgr.b b/appl/collab/srvmgr.b
new file mode 100644
index 00000000..4794f65d
--- /dev/null
+++ b/appl/collab/srvmgr.b
@@ -0,0 +1,190 @@
+implement Srvmgr;
+
+include "sys.m";
+ sys: Sys;
+
+include "srvmgr.m";
+include "service.m";
+include "cfg.m";
+
+Srvinfo: adt {
+ name: string;
+ path: string;
+ args: list of string;
+};
+
+services: list of ref Srvinfo;
+
+init(srvdir: string): (string, chan of ref Srvreq)
+{
+ sys = load Sys Sys->PATH;
+ cfg := load Cfg Cfg->PATH;
+ cfgpath := srvdir + "/services.cfg";
+ if (cfg == nil)
+ return (sys->sprint("cannot load %s: %r", Cfg->PATH), nil);
+ err := cfg->init(cfgpath);
+ if (err != nil)
+ return (err, nil);
+
+ (err, services) = parsecfg(cfgpath, srvdir, cfg);
+ if (err != nil)
+ return (err, nil);
+
+ rc := chan of ref Srvreq;
+ spawn srv(rc);
+ return (nil, rc);
+}
+
+parsecfg(p, srvdir: string, cfg: Cfg): (string, list of ref Srvinfo)
+{
+ srvlist: list of ref Srvinfo;
+ Record, Tuple: import cfg;
+
+ for (slist := cfg->getkeys(); slist != nil; slist = tl slist) {
+ name := hd slist;
+ matches := cfg->lookup(name);
+ if (len matches > 1) {
+ (nil, duplicate) := hd tl matches;
+ primary := hd duplicate.tuples;
+ lnum := primary.lnum;
+ err := sys->sprint("%s:%d: duplicate service name %s", p, lnum, name);
+ return (err, nil);
+ }
+ (nil, r) := hd matches;
+ lnum := (hd r.tuples).lnum;
+
+ (path, tuple) := r.lookup("path");
+ if (path == nil) {
+ err := sys->sprint("%s:%d: missing path for service %s", p, lnum, name);
+ return (err, nil);
+ }
+ if (path[0] != '/')
+ path = srvdir + "/" + path;
+
+ args: list of string = nil;
+ for (tuples := tl r.tuples; tuples != nil; tuples = tl tuples) {
+ t := hd tuples;
+ arg := t.lookup("arg");
+ if (arg != nil)
+ args = arg :: args;
+ }
+ nargs: list of string = nil;
+ for (; args != nil; args = tl args)
+ nargs = hd args :: nargs;
+ srvlist = ref Srvinfo(name, path, args) ::srvlist;
+ }
+ if (srvlist == nil) {
+ err := sys->sprint("%s: no services", p);
+ return (err, nil);
+ }
+ return (nil, srvlist);
+}
+
+srv(rc: chan of ref Srvreq)
+{
+ for (;;) {
+ req := <- rc;
+ id := req.sname + " " + req.id;
+ pick r := req {
+ Acquire =>
+ # r.user not used, but could control access
+ service := acquire(id);
+ err := "";
+ if (service.fd == nil) {
+ (err, service.root, service.fd) = startservice(req.sname);
+ if (err != nil)
+ release(id);
+ }
+ r.reply <-= (err, service.root, service.fd);
+ Release =>
+ release(id);
+ }
+ }
+}
+
+#
+# returns (error, service root, service FD)
+#
+startservice(name: string): (string, string, ref Sys->FD)
+{
+sys->print("startservice [%s]\n", name);
+ srv: ref Srvinfo;
+ for (sl := services; sl != nil; sl = tl sl) {
+ s := hd sl;
+ if (s.name == name) {
+ srv = s;
+ break;
+ }
+ }
+ if (srv == nil)
+ return ("unknown service", nil, nil);
+
+ service := load Service srv.path;
+ if (service == nil) {
+ err := sys->sprint("cannot load %s: %r", srv.path);
+ return (err, nil, nil);
+ }
+
+ return service->init(srv.args);
+}
+
+Srvmap: adt {
+ id: string;
+ root: string;
+ fd: ref Sys->FD;
+ nref: int;
+ next: cyclic ref Srvmap;
+};
+
+PRIME: con 211;
+buckets := array[PRIME] of ref Srvmap;
+
+hash(id: string): int
+{
+ # HashPJW
+ h := 0;
+ for (i := 0; i < len id; i++) {
+ h = (h << 4) + id[i];
+ g := h & int 16rf0000000;
+ if (g != 0) {
+ h = h ^ ((g >> 24) & 16rff);
+ h = h ^ g;
+ }
+ }
+ if (h < 0)
+ h &= ~(1<<31);
+ return int (h % PRIME);
+}
+
+acquire(id: string): ref Srvmap
+{
+ h := hash(id);
+ for (p := buckets[h]; p != nil; p = p.next)
+ if (p.id == id) {
+ p.nref++;
+ return p;
+ }
+ p = ref Srvmap(id, nil, nil, 1, buckets[h]);
+ buckets[h] = p;
+ return p;
+}
+
+release(id: string)
+{
+ h :=hash(id);
+ prev: ref Srvmap;
+ for (p := buckets[h]; p != nil; p = p.next) {
+ if (p.id == id){
+ p.nref--;
+ if (p.nref == 0) {
+ sys->print("release [%s]\n", p.id);
+ if (prev == nil)
+ buckets[h] = p.next;
+ else
+ prev.next = p.next;
+ }
+ return;
+ }
+ prev = p;
+ }
+}
diff --git a/appl/collab/srvmgr.m b/appl/collab/srvmgr.m
new file mode 100644
index 00000000..c1bd3a78
--- /dev/null
+++ b/appl/collab/srvmgr.m
@@ -0,0 +1,22 @@
+Srvmgr: module
+{
+ PATH: con "/dis/collab/srvmgr.dis";
+ Srvreq: adt {
+ sname: string;
+ id: string;
+ pick {
+ Acquire =>
+ uname: string;
+ reply: chan of Srvreply;
+ Release =>
+ }
+ };
+
+ Srvreply: type (
+ string, # error
+ string, # root path
+ ref Sys->FD # styx fd
+ );
+
+ init: fn(cfg: string): (string, chan of ref Srvreq);
+};
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 14:11:14 +0000