ref: 82b046f36f8084a22bbb5d71edd0edd9179561eb
dir: /appl/wm/telnet.b/
implement WmTelnet;
include "sys.m";
sys: Sys;
Connection: import sys;
include "draw.m";
draw: Draw;
Context: import draw;
include "tk.m";
tk: Tk;
include "tkclient.m";
tkclient: Tkclient;
include "dialog.m";
dialog: Dialog;
WmTelnet: module
{
init: fn(ctxt: ref Draw->Context, args: list of string);
};
Iob: adt
{
fd: ref Sys->FD;
t: ref Tk->Toplevel;
out: cyclic ref Iob;
buf: array of byte;
ptr: int;
nbyte: int;
};
BS: con 8; # ^h backspace character
BSW: con 23; # ^w bacspace word
BSL: con 21; # ^u backspace line
EOT: con 4; # ^d end of file
ESC: con 27; # hold mode
HIWAT: con 2000; # maximum number of lines in transcript
LOWAT: con 1500; # amount to reduce to after high water
Name: con "Telnet";
ctxt: ref Context;
cmds: chan of string;
net: Connection;
stderr: ref Sys->FD;
mcrlf: int;
netinp: ref Iob;
# control characters
Se: con 240; # end subnegotiation
NOP: con 241;
Mark: con 242; # data mark
Break: con 243;
Interrupt: con 244;
Abort: con 245; # TENEX ^O
AreYouThere: con 246;
Erasechar: con 247; # erase last character
Eraseline: con 248; # erase line
GoAhead: con 249; # half duplex clear to send
Sb: con 250; # start subnegotiation
Will: con 251;
Wont: con 252;
Do: con 253;
Dont: con 254;
Iac: con 255;
# options
Binary, Echo, SGA, Stat, Timing,
Det, Term, EOR, Uid, Outmark,
Ttyloc, M3270, Padx3, Window, Speed,
Flow, Line, Xloc, Extend: con iota;
Opt: adt
{
name: string;
code: int;
noway: int;
remote: int; # remote value
local: int; # local value
};
opt := array[] of
{
Binary => Opt("binary", 0, 0, 0, 0),
Echo => Opt("echo", 1, 0, 0, 0),
SGA => Opt("suppress Go Ahead", 3, 0, 0, 0),
Stat => Opt("status", 5, 1, 0, 0),
Timing => Opt("timing", 6, 1, 0, 0),
Det => Opt("det", 20, 1, 0, 0),
Term => Opt("terminal", 24, 0, 0, 0),
EOR => Opt("end of record", 25, 1, 0, 0),
Uid => Opt("uid", 26, 1, 0, 0),
Outmark => Opt("outmark", 27, 1, 0, 0),
Ttyloc => Opt("ttyloc", 28, 1, 0, 0),
M3270 => Opt("3270 mode", 29, 1, 0, 0),
Padx3 => Opt("pad x.3", 30, 1, 0, 0),
Window => Opt("window size", 31, 1, 0, 0),
Speed => Opt("speed", 32, 1, 0, 0),
Flow => Opt("flow control", 33, 1, 0, 0),
Line => Opt("line mode", 34, 0, 0, 0),
Xloc => Opt("X display loc", 35, 1, 0, 0),
Extend => Opt("Extended", 255, 1, 0, 0),
};
shwin_cfg := array[] of {
"menu .m",
".m add command -text Cut -command {send edit cut}",
".m add command -text Paste -command {send edit paste}",
".m add command -text Snarf -command {send edit snarf}",
".m add command -text Send -command {send edit send}",
"frame .ft",
"scrollbar .ft.scroll -command {.ft.t yview}",
"text .ft.t -width 70w -height 25h -yscrollcommand {.ft.scroll set}",
"frame .mb",
"menubutton .mb.c -text Connect -menu .mbc",
"menubutton .mb.t -text Terminal -menu .mbt",
"menu .mbc",
".mbc add command -text {Remote System} -command {send cmd con}",
".mbc add command -text {Disconnect} -state disabled -command {send cmd dis}",
".mbc add command -text {Exit} -command {send cmd exit}",
".mbc add separator",
"menu .mbt",
".mbt add checkbutton -text {Line Mode} -command {send cmd line}",
".mbt add checkbutton -text {Map CR to LF} -command {send cmd crlf}",
"pack .mb.c .mb.t -side left",
"pack .ft.scroll -side left -fill y",
"pack .ft.t -fill both -expand 1",
"pack .mb -fill x",
"pack .ft -fill both -expand 1",
"pack propagate . 0",
"focus .ft.t",
"bind .ft.t <Key> {send keys {%A}}",
"bind .ft.t <Control-d> {send keys {%A}}",
"bind .ft.t <Control-h> {send keys {%A}}",
"bind .ft.t <ButtonPress-3> {send but3 %X %Y}",
"bind .ft.t <ButtonRelease-3> {}",
"bind .ft.t <DoubleButton-3> {}",
"bind .ft.t <Double-ButtonRelease-3> {}",
"bind .ft.t <ButtonPress-2> {}",
"bind .ft.t <ButtonRelease-2> {}",
"update"
};
connect_cfg := array[] of {
"frame .fl",
"label .fl.h -text Host",
"label .fl.p -text Port",
"pack .fl.h .fl.p",
"frame .el",
"entry .el.h",
"entry .el.p",
".el.p insert end 'telnet",
"pack .el.h .el.p",
"pack .Wm_t -fill x",
"pack .fl .el -side left",
"focus .el.h",
"bind .el.h <Key-\n> {send cmd ok}",
"bind .el.p <key-\n> {send cmd ok}",
"update"
};
connected_cfg := array[] of {
"focus .ft.t",
".mbc entryconfigure 0 -state disabled",
".mbc entryconfigure 1 -state normal"
};
menuindex := "0";
holding := 0;
init(C: ref Context, argv: list of string)
{
sys = load Sys Sys->PATH;
if (C == nil) {
sys->fprint(sys->fildes(2), "telnet: no window context\n");
raise "fail:bad context";
}
draw = load Draw Draw->PATH;
tk = load Tk Tk->PATH;
tkclient = load Tkclient Tkclient->PATH;
dialog = load Dialog Dialog->PATH;
ctxt = C;
tkclient->init();
dialog->init();
sys->pctl(Sys->NEWPGRP, nil);
stderr = sys->fildes(2);
tkargs := "";
argv = tl argv;
if(argv != nil) {
tkargs = hd argv;
argv = tl argv;
}
(t, titlectl) := tkclient->toplevel(ctxt, tkargs, Name, Tkclient->Appl);
edit := chan of string;
tk->namechan(t, edit, "edit");
for (cc:=0; cc<len shwin_cfg; cc++)
tk->cmd(t, shwin_cfg[cc]);
keys := chan of string;
tk->namechan(t, keys, "keys");
but3 := chan of string;
tk->namechan(t, but3, "but3");
cmds = chan of string;
tk->namechan(t, cmds, "cmd");
# outpoint is place in text to insert characters printed by programs
tk->cmd(t, ".ft.t mark set outpoint end; .ft.t mark gravity outpoint left");
tkclient->onscreen(t, nil);
tkclient->startinput(t, "kbd"::"ptr"::nil);
for(;;) alt {
s := <-t.ctxt.kbd =>
tk->keyboard(t, s);
s := <-t.ctxt.ptr =>
tk->pointer(t, *s);
s := <-t.ctxt.ctl or
s = <-t.wreq or
s = <-titlectl =>
if(s == "exit") {
kill();
return;
}
tkclient->wmctl(t, s);
ecmd := <-edit =>
editor(t, ecmd);
sendinput(t);
c := <-keys =>
if(opt[Echo].local == 0) {
sys->fprint(net.dfd, "%c", c[1]);
break;
}
cut(t, 1);
char := c[1];
if(char == '\\')
char = c[2];
update := ";.ft.t see insert;update";
case char{
* =>
tk->cmd(t, ".ft.t insert insert "+c+update);
'\n' or EOT =>
tk->cmd(t, ".ft.t insert insert "+c+update);
sendinput(t);
BS =>
if(!insat(t, "outpoint"))
tk->cmd(t, ".ft.t delete insert-1chars"+update);
ESC =>
holding ^= 1;
color := "blue";
if(!holding){
color = "black";
tkclient->settitle(t, Name);
sendinput(t);
}else
tkclient->settitle(t, Name+" (holding)");
tk->cmd(t, ".ft.t configure -foreground "+color+update);
BSL =>
if(insininput(t))
tk->cmd(t, ".ft.t delete outpoint insert"+update);
else
tk->cmd(t, ".ft.t delete {insert linestart} insert"+update);
BSW =>
if(insat(t, "outpoint"))
break;
a0 := isalnum(tk->cmd(t, ".ft.t get insert-1chars"));
a1 := isalnum(tk->cmd(t, ".ft.t get insert"));
start: string;
if(a0 && a1) # middle of word
start = "{insert wordstart}";
else if(a0) # end of word
start = "{insert-1chars wordstart}";
else{ # beginning or not in word; must search
s: string;
for(n:=1; ;){
s = tk->cmd(t, ".ft.t get insert-"+ string n +"chars");
if(s=="" || s=="\n"){
start = "insert-"+ string n+"chars";
break;
}
n++;
if(isalnum(s)){
start = "{insert-"+ string n+"chars wordstart}";
break;
}
}
}
# don't ^w across outpoint
if(tk->cmd(t, ".ft.t compare insert >= outpoint") == "1"
&& tk->cmd(t, ".ft.t compare "+start+" < outpoint") == "1")
start = "outpoint";
tk->cmd(t, ".ft.t delete " + start + " insert"+update);
}
c := <-but3 =>
(nil, l) := sys->tokenize(c, " ");
x := int hd l - 50;
y := int hd tl l - int tk->cmd(t, ".m yposition "+menuindex) - 10;
tk->cmd(t, ".m activate "+menuindex+"; .m post "+string x+" "+string y+
"; grab set .m; update");
c := <-cmds =>
case c {
"con" =>
tk->cmd(t, ".mb.c configure -state disabled");
connect(t);
tk->cmd(t, ".mb.c configure -state normal; update");
"dis" =>
tkclient->settitle(t, "Telnet");
tk->cmd(t, ".mbc entryconfigure 0 -state normal");
tk->cmd(t, ".mbc entryconfigure 1 -state disabled");
net.cfd = nil;
net.dfd = nil;
kill();
"exit" =>
kill();
return;
"crlf" =>
mcrlf = !mcrlf;
break;
"line" =>
if(opt[Line].local == 0)
send3(netinp, Iac, Will, opt[Line].code);
else
send3(netinp, Iac, Wont, opt[Line].code);
}
}
}
insat(t: ref Tk->Toplevel, mark: string): int
{
return tk->cmd(t, ".ft.t compare insert == "+mark) == "1";
}
insininput(t: ref Tk->Toplevel): int
{
if(tk->cmd(t, ".ft.t compare insert >= outpoint") != "1")
return 0;
return tk->cmd(t, ".ft.t compare {insert linestart} == {outpoint linestart}") == "1";
}
isalnum(s: string): int
{
if(s == "")
return 0;
c := s[0];
if('a' <= c && c <= 'z')
return 1;
if('A' <= c && c <= 'Z')
return 1;
if('0' <= c && c <= '9')
return 1;
if(c == '_')
return 1;
if(c > 16rA0)
return 1;
return 0;
}
editor(t: ref Tk->Toplevel, ecmd: string)
{
s, snarf: string;
case ecmd {
"cut" =>
menuindex = "0";
cut(t, 1);
"paste" =>
menuindex = "1";
snarf = tkclient->snarfget();
if(snarf == "")
break;
cut(t, 0);
tk->cmd(t, ".ft.t insert insert '"+snarf);
sendinput(t);
"snarf" =>
menuindex = "2";
if(tk->cmd(t, ".ft.t tag ranges sel") == "")
break;
snarf = tk->cmd(t, ".ft.t get sel.first sel.last");
tkclient->snarfput(snarf);
"send" =>
menuindex = "3";
if(tk->cmd(t, ".ft.t tag ranges sel") != ""){
snarf = tk->cmd(t, ".ft.t get sel.first sel.last");
tkclient->snarfput(snarf);
}else
snarf = tkclient->snarfget();
if(snarf != "")
s = snarf;
else
return;
if(s[len s-1] != '\n' && s[len s-1] != EOT)
s[len s] = '\n';
tk->cmd(t, ".ft.t see end; .ft.t insert end '"+s);
tk->cmd(t, ".ft.t mark set insert end");
tk->cmd(t, ".ft.t tag remove sel sel.first sel.last");
}
tk->cmd(t, "update");
}
cut(t: ref Tk->Toplevel, snarfit: int)
{
if(tk->cmd(t, ".ft.t tag ranges sel") == "")
return;
if(snarfit)
tkclient->snarfput(tk->cmd(t, ".ft.t get sel.first sel.last"));
tk->cmd(t, ".ft.t delete sel.first sel.last");
}
sendinput(t: ref Tk->Toplevel)
{
if(holding)
return;
input := tk->cmd(t, ".ft.t get outpoint end");
slen := len input;
if(slen == 0)
return;
for(i := 0; i < slen; i++)
if(input[i] == '\n' || input[i] == EOT)
break;
if(i >= slen)
return;
advance := string (i+1);
if(input[i] == EOT)
input = input[0:i];
else
input = input[0:i+1];
sys->fprint(net.dfd, "%s", input);
tk->cmd(t, ".ft.t mark set outpoint outpoint+" + advance + "chars");
}
kill()
{
path := sys->sprint("#p/%d/ctl", sys->pctl(0, nil));
fd := sys->open(path, sys->OWRITE);
if(fd != nil)
sys->fprint(fd, "killgrp");
}
connect(t: ref Tk->Toplevel)
{
(b, titlectl) := tkclient->toplevel(ctxt, nil, "Connect", 0);
for (c:=0; c<len connect_cfg; c++)
tk->cmd(b, connect_cfg[c]);
cmd := chan of string;
tk->namechan(b, cmd, "cmd");
tkclient->onscreen(b, nil);
tkclient->startinput(b, "kbd"::"ptr"::nil);
loop: for(;;) alt {
s := <-b.ctxt.kbd =>
tk->keyboard(b, s);
s := <-b.ctxt.ptr =>
tk->pointer(b, *s);
s := <-b.ctxt.ctl or
s = <-b.wreq or
s = <-titlectl =>
if(s == "exit")
return;
tkclient->wmctl(b, s);
<-cmd =>
break loop;
}
addr := sys->sprint("tcp!%s!%s",
tk->cmd(b, ".el.h get"),
tk->cmd(b, ".el.p get"));
tkclient->settitle(b, "Dialing");
tk->cmd(b, "update");
ok: int;
(ok, net) = sys->dial(addr, nil);
if(ok < 0) {
dialog->prompt(ctxt, b.image, "error -fg red",
"Connect", "Connection to host failed\n"+sys->sprint("%r"),
0, "Stop connect" :: nil);
return;
}
tkclient->settitle(t, "Telnet - "+addr);
for (c=0; c<len connected_cfg; c++)
tk->cmd(b, connected_cfg[c]);
spawn fromnet(t);
}
flush(t: ref Tk->Toplevel, data: array of byte)
{
cdata := string data;
ncdata := string len cdata + "chars;";
moveins := insat(t, "outpoint");
tk->cmd(t, ".ft.t insert outpoint '"+ cdata);
s := ".ft.t mark set outpoint outpoint+" + ncdata;
s += ".ft.t see outpoint;";
if(moveins)
s += ".ft.t mark set insert insert+" + ncdata;
s += "update";
tk->cmd(t, s);
nlines := int tk->cmd(t, ".ft.t index end");
if(nlines > HIWAT){
s = ".ft.t delete 1.0 "+ string (nlines-LOWAT) +".0;update";
tk->cmd(t, s);
}
}
iobnew(fd: ref Sys->FD, t: ref Tk->Toplevel, out: ref Iob, size: int): ref Iob
{
iob := ref Iob;
iob.fd = fd;
iob.t = t;
iob.out = out;
iob.buf = array[size] of byte;
iob.nbyte = 0;
iob.ptr = 0;
return iob;
}
iobget(iob: ref Iob): int
{
if(iob.nbyte == 0) {
if(iob.out != nil)
iobflush(iob.out);
iob.nbyte = sys->read(iob.fd, iob.buf, len iob.buf);
if(iob.nbyte <= 0)
return iob.nbyte;
iob.ptr = 0;
}
iob.nbyte--;
return int iob.buf[iob.ptr++];
}
iobput(iob: ref Iob, c: int)
{
iob.buf[iob.ptr++] = byte c;
if(iob.ptr == len iob.buf)
iobflush(iob);
}
iobflush(iob: ref Iob)
{
if(iob.fd == nil) {
flush(iob.t, iob.buf[0:iob.ptr]);
iob.ptr = 0;
}
}
fromnet(t: ref Tk->Toplevel)
{
conout := iobnew(nil, t, nil, 2048);
netinp = iobnew(net.dfd, nil, conout, 2048);
crnls := 0;
freenl := 0;
loop: for(;;) {
c := iobget(netinp);
case c {
-1 =>
cmds <-= "dis";
return;
'\n' => # skip nl after string of cr's */
if(!opt[Binary].local && !mcrlf) {
crnls++;
if(freenl == 0)
break;
freenl = 0;
continue loop;
}
'\r' =>
if(!opt[Binary].local && !mcrlf) {
if(crnls++ == 0){
freenl = 1;
c = '\n';
break;
}
continue loop;
}
Iac =>
c = iobget(netinp);
if(c == Iac)
break;
iobflush(conout);
if(control(netinp, c) < 0)
return;
continue loop;
}
iobput(conout, c);
}
}
control(bp: ref Iob, c: int): int
{
case c {
AreYouThere =>
sys->fprint(net.dfd, "Inferno telnet V1.0\r\n");
Sb =>
return sub(bp);
Will =>
return will(bp);
Wont =>
return wont(bp);
Do =>
return doit(bp);
Dont =>
return dont(bp);
Se =>
sys->fprint(stderr, "telnet: SE without an SB\n");
-1 =>
return -1;
* =>
break;
}
return 0;
}
sub(bp: ref Iob): int
{
subneg: string;
i := 0;
for(;;){
c := iobget(bp);
if(c == Iac) {
c = iobget(bp);
if(c == Se)
break;
subneg[i++] = Iac;
}
if(c < 0)
return -1;
subneg[i++] = c;
}
if(i == 0)
return 0;
sys->fprint(stderr, "sub %d %d n = %d\n", subneg[0], subneg[1], i);
for(i = 0; i < len opt; i++)
if(opt[i].code == subneg[0])
break;
if(i >= len opt)
return 0;
case i {
Term =>
sbsend(opt[Term].code, array of byte "dumb");
}
return 0;
}
sbsend(code: int, data: array of byte): int
{
buf := array[4+len data+2] of byte;
o := 4+len data;
buf[0] = byte Iac;
buf[1] = byte Sb;
buf[2] = byte code;
buf[3] = byte 0;
buf[4:] = data;
buf[o] = byte Iac;
o++;
buf[o] = byte Se;
return sys->write(net.dfd, buf, len buf);
}
will(bp: ref Iob): int
{
c := iobget(bp);
if(c < 0)
return -1;
sys->fprint(stderr, "will %d\n", c);
for(i := 0; i < len opt; i++)
if(opt[i].code == c)
break;
if(i >= len opt) {
send3(bp, Iac, Dont, c);
return 0;
}
rv := 0;
if(opt[i].noway)
send3(bp, Iac, Dont, c);
else
if(opt[i].remote == 0)
rv |= send3(bp, Iac, Do, c);
if(opt[i].remote == 0)
rv |= change(bp, i, Will);
opt[i].remote = 1;
return rv;
}
wont(bp: ref Iob): int
{
c := iobget(bp);
if(c < 0)
return -1;
sys->fprint(stderr, "wont %d\n", c);
for(i := 0; i < len opt; i++)
if(opt[i].code == c)
break;
if(i >= len opt)
return 0;
rv := 0;
if(opt[i].remote) {
rv |= change(bp, i, Wont);
rv |= send3(bp, Iac, Dont, c);
}
opt[i].remote = 0;
return rv;
}
doit(bp: ref Iob): int
{
c := iobget(bp);
if(c < 0)
return -1;
sys->fprint(stderr, "do %d\n", c);
for(i := 0; i < len opt; i++)
if(opt[i].code == c)
break;
if(i >= len opt || opt[i].noway) {
send3(bp, Iac, Wont, c);
return 0;
}
rv := 0;
if(opt[i].local == 0) {
rv |= change(bp, i, Do);
rv |= send3(bp, Iac, Will, c);
}
opt[i].local = 1;
return rv;
}
dont(bp: ref Iob): int
{
c := iobget(bp);
if(c < 0)
return -1;
sys->fprint(stderr, "dont %d\n", c);
for(i := 0; i < len opt; i++)
if(opt[i].code == c)
break;
if(i >= len opt || opt[i].noway)
return 0;
rv := 0;
if(opt[i].local){
opt[i].local = 0;
rv |= change(bp, i, Dont);
rv |= send3(bp, Iac, Wont, c);
}
opt[i].local = 0;
return rv;
}
change(nil: ref Iob, nil: int, nil: int): int
{
return 0;
}
send3(bp: ref Iob, c0: int, c1: int, c2: int): int
{
buf := array[3] of byte;
buf[0] = byte c0;
buf[1] = byte c1;
buf[2] = byte c2;
t: string;
case c0 {
Will => t = "Will";
Wont => t = "Wont";
Do => t = "Do";
Dont => t = "Dont";
}
if(t != nil)
sys->fprint(stderr, "r %s %d\n", t, c1);
r := sys->write(bp.fd, buf, 3);
if(r != 3)
return -1;
return 0;
}