summaryrefslogtreecommitdiff
path: root/appl/examples/minitel/modem.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/examples/minitel/modem.b')
-rw-r--r--appl/examples/minitel/modem.b620
1 files changed, 620 insertions, 0 deletions
diff --git a/appl/examples/minitel/modem.b b/appl/examples/minitel/modem.b
new file mode 100644
index 00000000..b7a21c1d
--- /dev/null
+++ b/appl/examples/minitel/modem.b
@@ -0,0 +1,620 @@
+#
+# Copyright © 1998 Vita Nuova Limited. All rights reserved.
+#
+
+#modem states for direct connection
+MSstart, MSdialing, MSconnected, MSdisconnecting,
+
+# special features
+Ecp # error correction
+ : con (1 << iota);
+
+Ecplen: con 17; # error correction block length: data[15], crc, validation (=0)
+
+Modem: adt {
+ m: ref Module; # common attributes
+ in: chan of ref Event;
+
+ connect: int; # None, Direct, Network
+ state: int; # modem dialing state
+ saved: string; # response, so far (direct dial)
+ initstr: string; # softmodem init string (direct dial)
+ dialstr: string; # softmodem dial string (direct dial)
+ lastdialstr: string;
+
+ spec: int; # special features
+ fd: ref Sys->FD; # modem data file, if != nil
+ cfd: ref Sys->FD; # modem ctl file, if != nil (direct dial only)
+ devpath: string; # path to the modem;
+ avail: array of byte; # already read
+ rd: chan of array of byte; # reader -> rd
+ pid: int; # reader pid if != 0
+
+ seq: int; # ECP block sequence number
+ waitsyn: int; # awaiting restart SYN SYN ... sequence
+ errforce: int;
+ addparity: int; # must add parity to outgoing data
+
+ init: fn(m: self ref Modem, connect: int, initstr, dialstr: string);
+ reset: fn(m: self ref Modem);
+ run: fn(m: self ref Modem);
+ quit: fn(m: self ref Modem);
+ runstate: fn(m: self ref Modem, data: array of byte);
+ write: fn(m: self ref Modem, data: array of byte):int; # to network
+ reader: fn(m: self ref Modem, pidc: chan of int);
+};
+
+partab: array of byte;
+
+dump(a: array of byte, n: int): string
+{
+ s := sys->sprint("[%d]", n);
+ for(i := 0; i < n; i++)
+ s += sys->sprint(" %.2x", int a[i]);
+ return s;
+}
+
+Modem.init(m: self ref Modem, connect: int, initstr, dialstr: string)
+{
+ partab = array[128] of byte;
+ for(c := 0; c < 128; c++)
+ if(parity(c))
+ partab[c] = byte (c | 16r80);
+ else
+ partab[c] = byte c;
+ m.in = chan of ref Event;
+ m.connect = connect;
+ m.state = MSstart;
+ m.initstr = initstr;
+ m.dialstr = dialstr;
+ m.pid = 0;
+ m.spec = 0;
+ m.seq = 0;
+ m.waitsyn = 0;
+ m.errforce = 0;
+ m.addparity = 0;
+ m.avail = array[0] of byte;
+ m.rd = chan of array of byte;
+ m.reset();
+}
+
+Modem.reset(m: self ref Modem)
+{
+ m.m = ref Module(Pscreen, 0);
+}
+
+Modem.run(m: self ref Modem)
+{
+ if(m.dialstr != nil)
+ send(ref Event.Eproto(Pmodem, Mmodem, Cconnect, "", 0,0,0));
+Runloop:
+ for(;;){
+ alt {
+ ev := <- m.in =>
+ pick e := ev {
+ Equit =>
+ break Runloop;
+ Edata =>
+ if(debug['m'] > 0)
+ fprint(stderr, "Modem <- %s\n", e.str());
+ m.write(e.data);
+ if(T.state == Local || T.spec & Echo) { # loopback
+ if(e.from == Mkeyb) {
+ send(ref Event.Eproto(Pscreen, Mkeyb, Ccursor, "", 0,0,0));
+ send(ref Event.Edata(Pscreen, Mkeyb, e.data));
+ }
+ }
+ Eproto =>
+ case e.cmd {
+ Creset =>
+ m.reset();
+ Cconnect =>
+ if(m.pid != 0)
+ break;
+ m.addparity = 1;
+ T.state = Connecting;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+
+ case m.connect {
+ Direct =>
+ S.msg("Appel "+m.dialstr+" ...");
+ dev := "/dev/modem";
+ if(openmodem(m, dev) < 0) {
+ S.msg("Modem non prêt");
+ T.state = Local;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+ break;
+ }
+ m.state = MSdialing;
+ m.saved = "";
+ dialout(m);
+ T.terminalid = TERMINALID2;
+ Network =>
+ S.msg("Connexion au serveur ...");
+ if(debug['m'] > 0 || debug['M'] > 0)
+ sys->print("dial(%s)\n", m.dialstr);
+ (ok, cx) := sys->dial(m.dialstr, "");
+ if (ok == -1){
+ S.msg("Echec de la connexion");
+ T.state = Local;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+ if(debug['m'] > 0)
+ sys->print("can't dial %s: %r\n", m.dialstr);
+ break;
+ }
+ m.fd = sys->open(cx.dir + "/data", Sys->ORDWR);
+ m.cfd = cx.cfd;
+ if(len m.dialstr >= 3 && m.dialstr[0:3] == "tcp")
+ m.addparity = 0; # Internet gateway apparently doesn't require parity
+ if(m.fd != nil) {
+ S.msg(nil);
+ m.state = MSconnected;
+ T.state = Online;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+ }
+ T.terminalid = TERMINALID1;
+ }
+ if(m.fd != nil) {
+ pidc := chan of int;
+ spawn m.reader(pidc);
+ m.pid = <-pidc;
+ }
+ Cdisconnect =>
+ if(m.pid != 0) {
+ S.msg("Déconnexion ...");
+ m.state = MSdisconnecting;
+ }
+ if(m.connect == Direct)
+ hangup(m);
+ else
+ nethangup(m);
+ Cplay => # for testing
+ case e.s {
+ "play" =>
+ replay(m);
+ }
+ Crequestecp =>
+ if(m.spec & Ecp){ # for testing: if already active, force an error
+ m.errforce = 1;
+ break;
+ }
+ m.write(array[] of {byte SEP, byte 16r4A});
+sys->print("sending request for ecp\n");
+ Cstartecp =>
+ m.spec |= Ecp;
+ m.seq = 0; # not in spec
+ m.waitsyn = 0; # not in spec
+ Cstopecp =>
+ m.spec &= ~Ecp;
+ * => break;
+ }
+ }
+ b := <- m.rd =>
+ if(debug['m'] > 0){
+ fprint(stderr, "Modem -> %s\n", dump(b,len b));
+ }
+ if(b == nil) {
+ m.pid = 0;
+ case m.state {
+ MSdialing =>
+ S.msg("Echec appel");
+ MSdisconnecting =>
+ S.msg(nil);
+ }
+ m.state = MSstart;
+ T.state = Local;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cscreenon, "",0,0,0));
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+ break;
+ }
+ m.runstate(b);
+ }
+ }
+ if(m.pid != 0)
+ kill(m.pid);
+ send(nil);
+}
+
+Modem.quit(nil: self ref Modem)
+{
+}
+
+Modem.runstate(m: self ref Modem, data: array of byte)
+{
+ if(debug['m']>0)
+ sys->print("runstate %d %s\n", m.state, dump(data, len data));
+ case m.state {
+ MSstart => ;
+ MSdialing =>
+ for(i:=0; i<len data; i++) {
+ ch := int data[i];
+ if(ch != '\n' && ch != '\r') {
+ m.saved[len m.saved] = ch;
+ continue;
+ }
+ (code, str) := seenreply(m.saved);
+ case code {
+ Noise or Ok => ;
+ Success =>
+ S.msg(nil);
+ m.state = MSconnected;
+ T.state = Online;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+ Failure =>
+ hangup(m);
+ S.msg(str);
+ m.state = MSstart;
+ T.state = Local;
+ send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0));
+ }
+ m.saved = "";
+ }
+ MSconnected =>
+ send(ref Event.Edata(m.m.path, Mmodem, data));
+ MSdisconnecting => ;
+ }
+}
+
+Modem.write(m: self ref Modem, data: array of byte): int
+{
+ if(m.fd == nil)
+ return -1;
+ if(len data == 0)
+ return 0;
+ if(m.addparity){
+ # unfortunately must copy data to add parity for direct modem connection
+ pa := array[len data] of byte;
+ for(i := 0; i<len data; i++)
+ pa[i] = partab[int data[i] & 16r7F];
+ data = pa;
+ }
+ if(debug['m']>0)
+ sys->print("WRITE %s\n", dump(data, len data));
+ return sys->write(m.fd, data, len data);
+}
+
+#
+# minitel error correction protocol
+#
+# SYN, SYN, block number start of retransmission
+# NUL ignored
+# DLE escapes {DLE, SYN, NACK, NUL}
+# NACK, block restart request
+#
+
+crctab: array of int;
+Crcpoly: con 16r9; # crc7 = x^7+x^3+1
+
+# precalculate the CRC7 remainder for all bytes
+
+mktabs()
+{
+ crctab = array[256] of int;
+ for(c := 0; c < 256; c++){
+ v := c;
+ crc := 0;
+ for(i := 0; i < 8; i++){
+ crc <<= 1; # align remainder's MSB with value's
+ if((v^crc) & 16r80)
+ crc ^= Crcpoly;
+ v <<= 1;
+ }
+ crctab[c] = (crc<<1) & 16rFE; # pre-align the result to save <<1 later
+ }
+}
+
+# return the index of the first non-NUL character (the start of a block)
+
+nextblock(a: array of byte, i: int, n: int): int
+{
+ for(; i < n; i++)
+ if(a[i] != byte NUL)
+ break;
+ return i;
+}
+
+# return the data in the ecp block in a[0:Ecplen] (return nil for bad format)
+
+decode(a: array of byte): array of byte
+{
+ if(debug['M']>0)
+ sys->print("DECODE: %s\n", dump(a, Ecplen));
+ badpar := 0;
+ oldcrc := int a[Ecplen-2];
+ crc := 0;
+ op := 0;
+ dle := 0;
+ for(i:=0; i<Ecplen-2; i++){ # first byte is high-order byte of polynomial (MSB first)
+ c := int a[i];
+ nc := c & 16r7F; # strip parity
+ if((c^int partab[nc]) & 16r80)
+ badpar++;
+ crc = crctab[crc ^ c];
+ # collapse DLE sequences
+ if(!dle){
+ if(nc == DLE && i+1 < Ecplen-2){
+ dle = 1;
+ continue;
+ }
+ if(nc == NUL)
+ continue; # strip non-escaped NULs
+ }
+ dle = 0;
+ a[op++] = byte nc;
+ }
+ if(badpar){
+ if(debug['E'] > 0)
+ sys->print("bad parity\n");
+ return nil;
+ }
+ crc = (crc>>1)&16r7F;
+ if(int partab[crc] != oldcrc){
+ if(debug['E'] > 0)
+ sys->print("bad crc: in %ux got %ux\n", oldcrc, int partab[crc]);
+ return nil;
+ }
+ b := array[op] of byte;
+ b[0:] = a[0:op];
+ if(debug['M'] > 0)
+ sys->print("OUT: %s [%x :: %x]\n", dump(b,op), crc, oldcrc);
+ return b;
+}
+
+Modem.reader(m: self ref Modem, pidc: chan of int)
+{
+ pidc <-= sys->pctl(0, nil);
+ if(crctab == nil)
+ mktabs();
+ a := array[Sys->ATOMICIO] of byte;
+ inbuf := 0;
+ while(m.fd != nil) {
+ while((n := read(m.fd, a[inbuf:], len a-inbuf)) > 0){
+ n += inbuf;
+ inbuf = 0;
+ if((m.spec & Ecp) == 0){
+ b := array[n] of byte;
+ for(i := 0; i<n; i++)
+ b[i] = byte (int a[i] & 16r7F); # strip parity
+ m.rd <-= b;
+ }else{
+ #sys->print("IN: %s\n", dump(a,n));
+ i := 0;
+ if(m.waitsyn){
+ sys->print("seeking SYN #%x\n", m.seq);
+ syn := byte (SYN | 16r80);
+ lim := n-3;
+ for(; i <= lim; i++)
+ if(a[i] == syn && a[i+1] == syn && (int a[i+2]&16r0F) == m.seq){
+ i += 3;
+ m.waitsyn = 0;
+ sys->print("found SYN #%x@%d\n", m.seq, i-3);
+ break;
+ }
+ }
+ lim := n-Ecplen;
+ for(; (i = nextblock(a, i, n)) <= lim; i += Ecplen){
+ b := decode(a[i:]);
+ if(m.errforce || b == nil){
+ m.errforce = 0;
+ b = array[2] of byte;
+ b[0] = byte NACK;
+ b[1] = byte (m.seq | 16r40);
+ sys->print("NACK #%x\n", m.seq);
+ m.write(b);
+ m.waitsyn = 1;
+ i = n; # discard rest of block
+ break;
+ }
+ m.seq = (m.seq+1) & 16rF; # mod 16 counter
+ m.rd <-= b;
+ }
+ if(i < n){
+ a[0:] = a[i:n];
+ inbuf = n-i;
+ }
+ }
+ }
+ if(n <= 0)
+ break;
+ }
+# m.fd = nil;
+ m.rd <-= nil;
+}
+
+playfd: ref Sys->FD;
+in_code, in_char: con iota;
+
+replay(m: ref Modem)
+{
+ buf := array[8192] of byte;
+ DMAX: con 10;
+ d := 0;
+ da := array[DMAX] of byte;
+ playfd = nil;
+ if(playfd == nil)
+ playfd = sys->open("minitel.txt", Sys->OREAD);
+ if(playfd == nil)
+ return;
+ nl := 1;
+ discard := 1;
+ state := in_code;
+ hs := "";
+ start := 0;
+mainloop:
+ for(;;) {
+ n := sys->read(playfd, buf, len buf);
+ if(n <= 0)
+ break;
+ for(i:=0; i<n; i++) {
+ ch := int buf[i];
+ if(nl)
+ case ch {
+ '>' => discard = 0;
+ '<' => discard = 1;
+ if(start)
+ sys->sleep(1000);
+ '{' => start = 1;
+ '}' => break mainloop;
+ }
+ if(ch == '\n')
+ nl = 1;
+ else
+ nl = 0;
+ if(discard)
+ continue;
+ if(!start)
+ continue;
+ if(state == in_code && ((ch >= '0' && ch <= '9') || (ch >= 'a' && ch <= 'z')))
+ hs[len hs] = ch;
+ else if(ch == '(') {
+ state = in_char;
+ (v, nil) := toint(hs, 16);
+ da[d++] = byte v;
+ if(d == DMAX) {
+ send(ref Event.Edata(m.m.path, Mmodem, da));
+ d = 0;
+ da = array[DMAX] of byte;
+ sys->sleep(50);
+ }
+ hs = "";
+ }else if(ch == ')')
+ state = in_code;
+ }
+ }
+ playfd = nil;
+
+}
+
+kill(pid : int)
+{
+ prog := "#p/" + string pid + "/ctl";
+ fd := sys->open(prog, Sys->OWRITE);
+ if (fd != nil) {
+ cmd := array of byte "kill";
+ sys->write(fd, cmd, len cmd);
+ }
+}
+
+
+# Modem stuff
+
+
+# modem return codes
+Ok, Success, Failure, Noise, Found: con iota;
+
+#
+# modem return messages
+#
+Msg: adt {
+ text: string;
+ trans: string;
+ code: int;
+};
+
+msgs: array of Msg = array [] of {
+ ("OK", "Ok", Ok),
+ ("NO CARRIER", "No carrier", Failure),
+ ("ERROR", "Bad modem command", Failure),
+ ("NO DIALTONE", "No dial tone", Failure),
+ ("BUSY", "Busy tone", Failure),
+ ("NO ANSWER", "No answer", Failure),
+ ("CONNECT", "", Success),
+};
+
+msend(m: ref Modem, x: string): int
+{
+ a := array of byte x;
+ return sys->write(m.fd, a, len a);
+}
+
+#
+# apply a string of commands to modem
+#
+apply(m: ref Modem, s: string): int
+{
+ buf := "";
+ for(i := 0; i < len s; i++){
+ c := s[i];
+ buf[len buf] = c; # assume no Unicode
+ if(c == '\r' || i == (len s -1)){
+ if(c != '\r')
+ buf[len buf] = '\r';
+ if(msend(m, buf) < 0)
+ return Failure;
+ buf = "";
+ }
+ }
+ return Ok;
+}
+
+openmodem(m: ref Modem, dev: string): int
+{
+ m.fd = sys->open(dev, Sys->ORDWR);
+ m.cfd = sys->open(dev+"ctl", Sys->ORDWR);
+ if(m.fd == nil || m.cfd == nil)
+ return -1;
+# hangup(m);
+# m.fd = sys->open(dev, Sys->ORDWR);
+# m.cfd = sys->open(dev+"ctl", Sys->ORDWR);
+# if(m.fd == nil || m.cfd == nil)
+# return -1;
+ return 0;
+}
+
+hangup(m: ref Modem)
+{
+ sys->sleep(1020);
+ msend(m, "+++");
+ sys->sleep(1020);
+ apply(m, "ATH0");
+ m.fd = nil;
+# sys->write(m.cfd, array of byte "f", 1);
+ sys->write(m.cfd, array of byte "h", 1);
+ m.cfd = nil;
+ # HACK: shannon softmodem "off-hook" bug fix
+ sys->open("/dev/modem", Sys->OWRITE);
+}
+
+nethangup(m: ref Modem)
+{
+ m.fd = nil;
+ sys->write(m.cfd, array of byte "hangup", 6);
+ m.cfd = nil;
+}
+
+
+#
+# check `s' for a known reply or `substr'
+#
+seenreply(s: string): (int, string)
+{
+ for(k := 0; k < len msgs; k++)
+ if(len s >= len msgs[k].text && s[0:len msgs[k].text] == msgs[k].text) {
+ return (msgs[k].code, msgs[k].trans);
+ }
+ return (Noise, s);
+}
+
+contains(s, t: string): int
+{
+ if(t == nil)
+ return 1;
+ if(s == nil)
+ return 0;
+ n := len t;
+ for(i := 0; i+n <= len s; i++)
+ if(s[i:i+n] == t)
+ return 1;
+ return 0;
+}
+
+dialout(m: ref Modem)
+{
+ if(m.initstr != nil)
+ apply(m, "AT"+m.initstr);
+ if(m.dialstr != nil) {
+ apply(m, "ATD"+m.dialstr);
+ m.lastdialstr = m.dialstr;
+ m.dialstr = nil;
+ }
+}