home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / net.mod (.txt) < prev    next >
Oberon Text  |  1994-11-16  |  18KB  |  581 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Net;  (*NW 3.7.88 / 12.11.94*)
  3.     IMPORT SCC, Files, Viewers, Texts, TextFrames, MenuViewers, Oberon;
  4.     CONST PakSize = 512;
  5.         T0 = 300; T1 = 1000;  (*timeouts*)
  6.         ACK = 10H; NAK = 25H; NPR = 26H; (*acknowledgements*)
  7.         NRQ = 34H; NRS = 35H; (*name request, response*)
  8.         SND = 41H; REC = 42H; (*send / receive request*)
  9.         FDIR = 45H; DEL = 49H;
  10.         MSG = 44H; TRQ = 46H; TIM = 47H;
  11.         NPW = 48H;   (*new password request*)
  12.         MDIR = 4AH; SML = 4BH; RML = 4CH; DML = 4DH;
  13.         Menu = "^Edit.Menu.Text System.Close  System.Copy  System.Grow  Edit.Search  Edit.Replace  Edit.Store ";
  14.     VAR W: Texts.Writer;
  15.         Server: Oberon.Task;
  16.         head0, head1: SCC.Header;
  17.         partner, dmy: ARRAY 8 OF CHAR;
  18.         protected: BOOLEAN;  (*write-protection*)
  19.     PROCEDURE SetPartner(VAR name: ARRAY OF CHAR);
  20.     BEGIN head0.dadr := head1.sadr; COPY(name, partner)
  21.     END SetPartner;
  22.     PROCEDURE Send(t: SHORTINT; L: INTEGER; VAR data: ARRAY OF CHAR);
  23.     BEGIN head0.typ := t; head0.len := L; SCC.SendPacket(head0, data)
  24.     END Send;
  25.     PROCEDURE ReceiveHead(timeout: LONGINT);
  26.         VAR time: LONGINT;
  27.     BEGIN time := Oberon.Time() + timeout;
  28.         LOOP SCC.ReceiveHead(head1);
  29.             IF head1.valid THEN
  30.                 IF head1.sadr = head0.dadr THEN EXIT ELSE SCC.Skip(head1.len) END
  31.             ELSIF Oberon.Time() >= time THEN head1.typ := -1; EXIT
  32.             END
  33.         END
  34.     END ReceiveHead;
  35.     PROCEDURE FindPartner(VAR name: ARRAY OF CHAR; VAR res: INTEGER);
  36.         VAR time: LONGINT; k: INTEGER;
  37.     BEGIN SCC.Skip(SCC.Available()); res := 0;
  38.         IF name # partner THEN k := 0;
  39.             WHILE name[k] > 0X DO INC(k) END ;
  40.             head0.dadr := -1; Send(NRQ, k+1, name); time := Oberon.Time() + T1;
  41.             LOOP SCC.ReceiveHead(head1);
  42.                 IF head1.valid THEN
  43.                     IF head1.typ = NRS THEN SetPartner(name); EXIT
  44.                     ELSE SCC.Skip(head1.len)
  45.                     END
  46.                 ELSIF Oberon.Time() >= time THEN res := 1; partner[0] := 0X; EXIT
  47.                 END
  48.             END
  49.         END
  50.     END FindPartner;
  51.     PROCEDURE AppendS(VAR s, d: ARRAY OF CHAR; VAR k: INTEGER);
  52.         VAR i: INTEGER; ch: CHAR;
  53.     BEGIN i := 0;
  54.         REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = 0X
  55.     END AppendS;
  56.     PROCEDURE AppendW(s: LONGINT; VAR d: ARRAY OF CHAR; n: INTEGER; VAR k: INTEGER);
  57.         VAR i: INTEGER;
  58.     BEGIN i := 0;
  59.         REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n
  60.     END AppendW;
  61.     PROCEDURE PickS(VAR s: ARRAY OF CHAR);
  62.         VAR i: INTEGER; ch: CHAR;
  63.     BEGIN i := 0;
  64.         REPEAT SCC.Receive(ch); s[i] := ch; INC(i) UNTIL ch = 0X
  65.     END PickS;
  66.     PROCEDURE PickQ(VAR w: LONGINT);
  67.         VAR c0, c1, c2: CHAR; s: SHORTINT;
  68.     BEGIN SCC.Receive(c0); SCC.Receive(c1); SCC.Receive(c2); SCC.Receive(s);
  69.         w := s; w := ((w * 100H + LONG(c2)) * 100H + LONG(c1)) * 100H + LONG(c0)
  70.     END PickQ;
  71.     PROCEDURE SendData(F: Files.File);
  72.         VAR k: INTEGER;
  73.             seqno: SHORTINT; x: CHAR;
  74.             len: LONGINT;
  75.             R: Files.Rider;
  76.             buf: ARRAY PakSize OF CHAR;
  77.     BEGIN Files.Set(R, F, 0); len := 0; seqno := 0;
  78.         LOOP k := 0;
  79.             LOOP Files.Read(R, x);
  80.                 IF R.eof THEN EXIT END ;
  81.                 buf[k] := x; INC(k);
  82.                 IF k = PakSize THEN EXIT END
  83.             END ;
  84.             REPEAT Send(seqno, k, buf); ReceiveHead(T1)
  85.             UNTIL head1.typ # seqno + ACK;
  86.             seqno := (seqno + 1) MOD 8; len := len + k;
  87.             IF head1.typ # seqno + ACK THEN
  88.                 Texts.WriteString(W, " failed"); EXIT
  89.             END ;
  90.             IF k < PakSize THEN EXIT END
  91.         END ;
  92.         Texts.WriteInt(W, len, 7)
  93.     END SendData;
  94.     PROCEDURE ReceiveData(F: Files.File; VAR done: BOOLEAN);
  95.         VAR k, retry: INTEGER;
  96.             seqno: SHORTINT; x: CHAR;
  97.             len: LONGINT;
  98.             R: Files.Rider;
  99.     BEGIN Files.Set(R, F, 0); seqno := 0; len := 0; retry := 2;
  100.         LOOP
  101.             IF head1.typ = seqno THEN
  102.                 seqno := (seqno + 1) MOD 8; len := len + head1.len; retry := 2;
  103.                 Send(seqno + ACK, 0, dmy); k := 0;
  104.                 WHILE k < head1.len DO
  105.                     SCC.Receive(x); Files.Write(R, x); INC(k)
  106.                 END ;
  107.                 IF k < PakSize THEN done := TRUE; EXIT END
  108.             ELSE DEC(retry);
  109.                 IF retry = 0 THEN
  110.                     Texts.WriteString(W, " failed"); done := FALSE; EXIT
  111.                 END ;
  112.                 Send(seqno + ACK, 0, dmy)
  113.             END ;
  114.             ReceiveHead(T0)
  115.         END ;
  116.         Texts.WriteInt(W, len, 7)
  117.     END ReceiveData;
  118.     PROCEDURE SendText(T: Texts.Text);
  119.         VAR k: INTEGER;
  120.             seqno: SHORTINT; x: CHAR;
  121.             R: Texts.Reader;
  122.             buf: ARRAY PakSize OF CHAR;
  123.     BEGIN Texts.OpenReader(R, T, 0); seqno := 0;
  124.         LOOP k := 0;
  125.             LOOP Texts.Read(R, x);
  126.                 IF x = 0X THEN EXIT END ;
  127.                 buf[k] := x; INC(k);
  128.                 IF k = PakSize THEN EXIT END
  129.             END ;
  130.             REPEAT Send(seqno, k, buf); ReceiveHead(T1)
  131.             UNTIL head1.typ # seqno + ACK;
  132.             seqno := (seqno + 1) MOD 8;
  133.             IF head1.typ # seqno + ACK THEN
  134.                 Texts.WriteString(W, " failed"); EXIT
  135.             END ;
  136.             IF k < PakSize THEN EXIT END
  137.         END
  138.     END SendText;
  139.     PROCEDURE ReceiveText(T: Texts.Text);
  140.         VAR k, retry: INTEGER;
  141.             seqno: SHORTINT; x: CHAR;
  142.     BEGIN seqno := 0; retry := 2;
  143.         LOOP
  144.             IF head1.typ = seqno THEN
  145.                 seqno := (seqno + 1) MOD 8; retry := 2;
  146.                 Send(seqno + 10H, 0, dmy); k := 0;
  147.                 WHILE k < head1.len DO
  148.                     SCC.Receive(x); Texts.Write(W, x); INC(k)
  149.                 END ;
  150.                 Texts.Append(T, W.buf);
  151.                 IF k < PakSize THEN EXIT END
  152.             ELSE DEC(retry);
  153.                 IF retry = 0 THEN
  154.                     Texts.WriteString(W, " failed"); Texts.WriteLn(W);
  155.                     Texts.Append(Oberon.Log, W.buf); EXIT
  156.                 END ;
  157.                 Send(seqno + 10H, 0, dmy)
  158.             END ;
  159.             ReceiveHead(T0)
  160.         END
  161.     END ReceiveText;
  162.     PROCEDURE reply(msg: INTEGER);
  163.     BEGIN
  164.         CASE msg OF
  165.               0:
  166.             | 1: Texts.WriteString(W, " no link")
  167.             | 2: Texts.WriteString(W, " no permission")
  168.             | 3: Texts.WriteString(W, " not done")
  169.             | 4: Texts.WriteString(W, " not found")
  170.             | 5: Texts.WriteString(W, " no response")
  171.             | 6: Texts.WriteString(W, " time set")
  172.             | 7: Texts.WriteString(W, " password set")
  173.             | 8: Texts.WriteString(W, " no recipient")
  174.             | 9: Texts.WriteString(W, " msg too long")
  175.         END ;
  176.         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  177.     END reply;
  178.     PROCEDURE Serve;
  179.         VAR i: INTEGER;
  180.             done: BOOLEAN; ch: CHAR;
  181.             F: Files.File;
  182.             pw: LONGINT;
  183.             Id: ARRAY 10 OF CHAR;
  184.             FileName: ARRAY 32 OF CHAR;
  185.     BEGIN SCC.ReceiveHead(head1);
  186.     IF head1.valid THEN
  187.         IF head1.typ = SND THEN
  188.             PickS(Id); PickQ(pw); PickS(FileName);
  189.             Texts.WriteString(W, Id); Texts.Write(W, " "); Texts.WriteString(W, FileName);
  190.             F := Files.Old(FileName);
  191.             IF F # NIL THEN
  192.                 Texts.WriteString(W, " sending"); SetPartner(Id);
  193.                 Texts.Append(Oberon.Log, W.buf); SendData(F)
  194.             ELSE Send(NAK, 0, dmy); Texts.Write(W, "~")
  195.             END ;
  196.             reply(0)
  197.         ELSIF head1.typ = REC THEN
  198.             PickS(Id); PickQ(pw); PickS(FileName);
  199.             IF ~protected THEN
  200.                 Texts.WriteString(W, Id); Texts.Write(W, " "); Texts.WriteString(W, FileName);
  201.                 F := Files.New(FileName);
  202.                 IF F # NIL THEN
  203.                     Texts.WriteString(W, " receiving"); SetPartner(Id);
  204.                     Texts.Append(Oberon.Log, W.buf);
  205.                     Send(ACK, 0, dmy); ReceiveHead(T0); ReceiveData(F, done);
  206.                     IF done THEN Files.Register(F) END
  207.                 ELSE Send(NAK, 0, dmy); Texts.Write(W, "~")
  208.                 END ;
  209.                 reply(0)
  210.             ELSE Send(NPR, 0, dmy)
  211.             END
  212.         ELSIF head1.typ = MSG THEN i := 0;
  213.             WHILE i < head1.len DO SCC.Receive(ch); Texts.Write(W, ch); INC(i) END ;
  214.             SetPartner(Id); Send(ACK, 0, dmy); reply(0)
  215.         ELSIF head1.typ = NRQ THEN i := 0;
  216.             LOOP SCC.Receive(ch); Id[i] := ch; INC(i);
  217.                 IF ch = 0X THEN EXIT END ;
  218.                 IF i = 7 THEN Id[7] := 0X; EXIT END
  219.             END ;
  220.             WHILE i < head1.len DO SCC.Receive(ch); INC(i) END ;
  221.             IF Id = Oberon.User THEN
  222.                 head1.dadr := head1.sadr; head1.typ := NRS; head1.len := 0;
  223.                 SCC.SendPacket(head1, dmy)
  224.             END
  225.         ELSE SCC.Skip(head1.len)
  226.         END
  227.     END Serve;
  228.     PROCEDURE GetPar1(VAR S: Texts.Scanner);
  229.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S)
  230.     END GetPar1;
  231.     PROCEDURE GetPar(VAR S: Texts.Scanner; VAR end: LONGINT);
  232.         VAR T: Texts.Text; beg, tm: LONGINT;
  233.     BEGIN Texts.Scan(S);
  234.         IF (S.class = Texts.Char) & (S.c = "^") THEN
  235.             Oberon.GetSelection(T, beg, end, tm);
  236.             IF tm >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  237.         ELSE end := Oberon.Par.text.len
  238.         END
  239.     END GetPar;
  240.     PROCEDURE SendFiles*;
  241.         VAR k: INTEGER;
  242.             end: LONGINT;
  243.             S: Texts.Scanner;
  244.             F: Files.File;
  245.             name: ARRAY 32 OF CHAR;
  246.             buf: ARRAY 64 OF CHAR;
  247.     BEGIN GetPar1(S);
  248.         IF S.class = Texts.Name THEN
  249.             FindPartner(S.s, k);
  250.             IF k = 0 THEN
  251.                 GetPar(S, end);
  252.                 LOOP
  253.                     IF S.class # Texts.Name THEN EXIT END ;
  254.                     Texts.WriteString(W, S.s); k := 0; AppendS(S.s, name, k);
  255.                     IF