home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / lineserver.mod (.txt) < prev    next >
Oberon Text  |  1994-10-18  |  17KB  |  505 lines
  1. Syntax10.Scn.Fnt
  2. MODULE LineServer;  (*NW 18.4.89 / 15.9.93*)
  3.     IMPORT SYSTEM, Core, V24, FileDir, Files, Texts, Oberon;
  4. (*packet types:  0ttt00rs
  5.     1 = data,  2 = data ack,
  6.     3 = open,  4 = open ack,
  7.     5 = close,  6 = close ack,
  8.     7 = abort *)
  9.     CONST PakSize = 256; maxLen = 1000000;
  10.         T0 = 1500;  (*timeout 5 sec*)
  11.         ENQ = 40X; SND = 41X; REC = 42X; FDIR = 45X; NPW = 48X; DEL = 49X;
  12.         MDIR = 4AX; SML = 4BX; RML = 4CX; DML = 4DX;
  13.         ACK = 10X; NAK = 25X; NPR = 26X; CX = 63X;
  14.     VAR W: Texts.Writer;
  15.         handler: Oberon.Task;
  16.         Lstat: INTEGER;  (*1: busy, 0: free*)
  17.         Lmode: INTEGER;  (*1: master, 0: server*)
  18.         rx, K: INTEGER;  (*receiver buffer index*)
  19.         rbuf: ARRAY PakSize+4 OF CHAR;  (*receiver buffer*)
  20.         myR, myS: INTEGER;  (*receiver and sender sequence numbers*)
  21.         mailuno, logcnt: INTEGER;
  22.         mailTime: LONGINT;
  23.         MF: Files.File;  (*last mail file accessed*)
  24.         hdch: ARRAY 2 OF CHAR;
  25.         cx400: ARRAY 14 OF CHAR;
  26.         buf: ARRAY 512 OF CHAR;  (*mailbox and filedir commands*)
  27.     PROCEDURE EOL;
  28.     BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  29.     END EOL;
  30.     PROCEDURE Log(ch: CHAR);
  31.     BEGIN Texts.Write(W, ch); INC(logcnt);
  32.         IF logcnt = 80 THEN Texts.WriteLn(W); logcnt := 0 END ;
  33.         Texts.Append(Oberon.Log, W.buf)
  34.     END Log;
  35.     PROCEDURE Rec(VAR ch: CHAR);
  36.         VAR time: LONGINT; ch1: CHAR;
  37.     BEGIN time := Oberon.Time() + T0;
  38.         LOOP
  39.             IF V24.Available() > 0 THEN V24.Receive(ch1); ch := CHR(ORD(ch1) MOD 80H); EXIT END ;
  40.             IF Oberon.Time() > time THEN ch := 1X; EXIT END
  41.         END
  42.     END Rec;
  43.     PROCEDURE SendPacket(typ, len: INTEGER; VAR data: ARRAY OF CHAR);
  44.         VAR i, u, x: INTEGER; cs: LONGINT;
  45.     BEGIN V24.Send(hdch[1-Lmode]);
  46.         cs := typ + 5; i := 0;
  47.         WHILE i < len DO
  48.             cs := (cs*5 + ORD(data[i])) MOD 32767; INC(i)
  49.         END ;
  50.         data[len] := CHR(cs); data[len+1] := CHR(cs DIV 100H); INC(len, 2);
  51.         V24.Send(CHR(typ MOD 64 + 33)); x := typ DIV 64; u := 1; i := 0;
  52.         WHILE i < len DO  (*encode*)
  53.             IF u = 0 THEN
  54.                 x := ORD(data[i]); V24.Send(CHR(x MOD 64 + 33)); x := x DIV 64; u := 1
  55.             ELSIF u = 1 THEN
  56.                 x := ORD(data[i])*4 + x; V24.Send(CHR(x MOD 64 + 33)); x := x DIV 64; u := 2
  57.             ELSIF u = 2 THEN
  58.                 x := ORD(data[i])*16 + x; V24.Send(CHR(x MOD 64 + 33)); V24.Send(CHR(x DIV 64 + 33)); u := 0
  59.             END ;
  60.             INC(i)
  61.         END ;
  62.         IF u > 0 THEN V24.Send(CHR(x MOD 64 + 33)) END ;
  63.         V24.Send(0DX)
  64.     END SendPacket;
  65.     PROCEDURE ReceivePacket(VAR typ, len: INTEGER);
  66.         VAR ch: CHAR;
  67.             i, j, u, x: INTEGER; cs: LONGINT;
  68.     BEGIN len := 0; typ := 0; rbuf[1] := 0X;
  69.         REPEAT Rec(ch) UNTIL ch > 0X;
  70.         IF ch = hdch[Lmode] THEN
  71.             Rec(ch); i := 0; u := 0;
  72.             WHILE (ch > 0DX) & (i < 260) DO
  73.                 IF u = 0 THEN
  74.                     x := ORD(ch) - 33; Rec(ch); x := (ORD(ch) - 33) * 64 + x;
  75.                     rbuf[i] := CHR(x); INC(i); x := x DIV 256; u := 2
  76.                 ELSIF u = 1 THEN
  77.                     x := (ORD(ch) - 33) * 4 + x; rbuf[i] := CHR(x); INC(i); u := 0
  78.                 ELSIF u = 2 THEN
  79.                     x := (ORD(ch) - 33) * 16 + x; rbuf[i] := CHR(x); INC(i); x := x DIV 256; u := 1
  80.                 END ;
  81.                 Rec(ch)
  82.             END ;
  83.             IF (ch = 0DX) & (i > 2) THEN
  84.                 DEC(i, 2); j := 0; cs := 1;
  85.                 WHILE j < i DO
  86.                     cs := (cs*5 + ORD(rbuf[j])) MOD 32767; INC(j)
  87.                 END ;
  88.                 IF (CHR(cs) = rbuf[i]) & (CHR(cs DIV 256) = rbuf[i+1]) THEN
  89.                     rx := 1; typ := ORD(rbuf[0]); len := i-1
  90.                 END
  91.             END
  92.         END
  93.     END ReceivePacket;
  94.     PROCEDURE Send1(len: INTEGER; VAR buf: ARRAY OF CHAR; VAR res: INTEGER);
  95.         VAR retries, typ, plen: INTEGER;
  96.     BEGIN myS := 1 - myS; retries := 3;
  97.         SendPacket(myR*2+myS+14H, len, buf);
  98.         LOOP ReceivePacket(typ, plen);
  99.             IF typ <= 0 THEN (*error*) DEC(retries);
  100.                 IF retries = 0 THEN res := 1; EXIT END ;
  101.                 SendPacket(myR*2+myS+14H, len, buf)
  102.             ELSIF (typ DIV 10H = 2) & (typ DIV 2 MOD 2 = myS) THEN res := 0; EXIT
  103.             ELSIF typ DIV 10H = 7 THEN (*abort*) res := 2; Lstat := 0; EXIT
  104.             END
  105.         END
  106.     END Send1;
  107.     PROCEDURE Receive1(VAR len, res: INTEGER);
  108.         VAR typ: INTEGER; dmy: ARRAY 4 OF CHAR;
  109.     BEGIN
  110.         LOOP ReceivePacket(typ, len);
  111.             IF typ <= 0 THEN (*error*) res := 1; EXIT
  112.             ELSIF typ DIV 10H = 1 THEN (*data*)
  113.                 IF typ MOD 2 # myR THEN
  114.                     myR := 1 - myR; SendPacket(myR*2+myS+20H, 0, dmy); res := 0; EXIT
  115.                 ELSE SendPacket(myR*2+myS+20H, 0, dmy)
  116.                 END
  117.             ELSIF typ DIV 10H = 3 THEN (*open*) SendPacket(40H, 0, dmy)
  118.             END
  119.         END
  120.     END Receive1;
  121.     PROCEDURE SendData(F: Files.File; VAR res: INTEGER);
  122.         VAR  k: INTEGER; x: CHAR;
  123.             R: Files.Rider;
  124.             buf: ARRAY PakSize+4 OF CHAR;
  125.     BEGIN Files.Set(R, F, 0);
  126.         REPEAT k := 0;
  127.             LOOP Files.Read(R, x);
  128.                 IF R.eof THEN EXIT END ;
  129.                 buf[k] := x; INC(k);
  130.                 IF k = PakSize THEN EXIT END
  131.             END ;
  132.             Send1(k, buf, res);
  133.         UNTIL (res # 0) OR (k < PakSize)
  134.     END SendData;
  135.     PROCEDURE SendMail(VAR R: Files.Rider; len: LONGINT; VAR res: INTEGER);
  136.         VAR  k, m, typ: INTEGER; x: CHAR;
  137.             buf: ARRAY PakSize+4 OF CHAR;
  138.     BEGIN
  139.         REPEAT k := 0;
  140.             LOOP Files.Read(R, x);
  141.                 IF k = len THEN EXIT END ;
  142.                 buf[k] := SYSTEM.VAL(CHAR, SYSTEM.ROT(x, 3)); INC(k);
  143.                 IF k = PakSize THEN EXIT END
  144.             END ;
  145.             Send1(k, buf, res); len := len - k
  146.         UNTIL (res # 0) OR (k < PakSize)
  147.     END SendMail;
  148.     PROCEDURE ReceiveData(F: Files.File; VAR L: LONGINT; VAR res: INTEGER);
  149.         VAR k, len: INTEGER;
  150.             R: Files.Rider;
  151.     BEGIN Files.Set(R, F, 0); L := 0;
  152.         LOOP Receive1(len, res);
  153.             IF res = 0 THEN
  154.                 L := L + len; k := 0;
  155.                 IF L > maxLen THEN Log("$"); res := 1; EXIT END ;
  156.                 WHILE k < len DO
  157.                     Files.Write(R, rbuf[rx]); INC(rx); INC(k)
  158.                 END ;
  159.                 IF k < 256 THEN EXIT END
  160.             ELSE EXIT
  161.             END
  162.         END
  163.     END ReceiveData;
  164.     PROCEDURE SendBuffer(VAR res: INTEGER);
  165.         VAR s, d: INTEGER; B0, B1: CHAR;
  166.     BEGIN B0 := buf[PakSize]; B1 := buf[PakSize+1];
  167.         Send1(PakSize, buf, res); buf[PakSize] := B0; buf[PakSize+1] := B1;
  168.         d := 0; s := PakSize;
  169.         WHILE s < K DO buf[d] := buf[s]; INC(d); INC(s) END ;
  170.         K := d
  171.     END SendBuffer;
  172.     PROCEDURE SendToSun(VAR res: INTEGER);
  173.         VAR len, uno: INTEGER;
  174.             id: Core.ShortName;
  175.             F: Files.File;
  176.     BEGIN
  177.         LOOP
  178.             IF Core.LineQueue.n = 0 THEN Send1(0, id, res); EXIT END ;
  179.             Core.GetTask(Core.LineQueue, F, id, uno); Log(".");
  180.             SendData(F, res);
  181.             IF res # 0 THEN EXIT END ;
  182.             Receive1(len, res);
  183.             IF res # 0 THEN EXIT END ;
  184.             Core.RemoveTask(Core.LineQueue)
  185.         END
  186.     END SendToSun;
  187.     PROCEDURE ReceiveFromSun(VAR res: INTEGER);
  188.     VAR len: LONGINT;
  189.             ch: CHAR;
  190.             id: Core.ShortName;
  191.             F: Files.File;
  192.     BEGIN id := "sun";
  193.         LOOP F := Files.New(""); ReceiveData(F, len, res);
  194.             IF (len = 0) OR (res # 0) THEN EXIT END ;
  195.             Files.Close(F); Log(".");
  196.             Core.InsertTask(Core.MailQueue, F, id, -1); Send1(0, id, res)
  197.         END
  198.     END ReceiveFromSun;
  199.     PROCEDURE AppendS(VAR s, d: ARRAY OF CHAR; VAR k: INTEGER);
  200.         VAR i: INTEGER; ch: CHAR;
  201.     BEGIN i := 0;
  202.         REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = 0X
  203.     END AppendS;
  204.     PROCEDURE AppendW(s: LONGINT; VAR d: ARRAY OF CHAR; n: INTEGER; VAR k: INTEGER);
  205.         VAR i: INTEGER;
  206.     BEGIN i := 0;
  207.         REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n
  208.     END AppendW;
  209.     PROCEDURE AppendN(x: LONGINT; VAR d: ARRAY OF CHAR; VAR k: INTEGER);
  210.         VAR i: INTEGER; u: ARRAY 8 OF CHAR;
  211.     BEGIN i := 0;
  212.         REPEAT u[i] := CHR(x MOD 10 + 30H); INC(i); x := x DIV 10 UNTIL x = 0;
  213.         REPEAT DEC(i); d[k] := u[i]; INC(k) UNTIL i = 0
  214.     END AppendN;
  215.     PROCEDURE AppendDate(t, d: INTEGER; VAR buf: ARRAY OF CHAR; VAR k: INTEGER);
  216.         PROCEDURE Pair(ch: CHAR; x: LONGINT);
  217.         BEGIN buf[k] := ch; INC(k);
  218.             buf[k] := CHR(x DIV 10 + 30H); INC(k); buf[k] := CHR(x MOD 10 + 30H); INC(k)
  219.         END Pair;
  220.     BEGIN
  221.         Pair(" ", d MOD 20H); Pair(".", d DIV 20H MOD 10H); Pair(".", d DIV 200H MOD 80H);
  222.         Pair(" ", t DIV 800H MOD 20H); Pair(":", t DIV 20H MOD 40H); Pair(":", t MOD 20H * 2)
  223.     END AppendDate;
  224.     PROCEDURE* AppendDirEntry(name: FileDir.FileName; adr: LONGINT; VAR cont: BOOLEAN);
  225.         VAR i, res: INTEGER;
  226.     BEGIN i := 0;
  227.         WHILE name[i] > 0X DO buf[K] := name[i]; INC(K); INC(i) END ;
  228.         buf[K] := 0DX; INC(K);
  229.         IF K >= PakSize THEN SendBuffer(res);
  230.             IF res # 0 THEN cont := FALSE END
  231.         END
  232.     END AppendDirEntry;
  233.     PROCEDURE PickS(VAR s: ARRAY OF CHAR);
  234.         VAR i: INTEGER; ch: CHAR;
  235.     BEGIN i := 0;
  236.         REPEAT ch := rbuf[rx]; INC(rx); s[i] := ch; INC(i) UNTIL ch = 0X
  237.     END PickS;
  238.     PROCEDURE PickW(VAR w: ARRAY OF SYSTEM.BYTE; n: INTEGER);
  239.         VAR i: INTEGER;
  240.     BEGIN i := 0;
  241.         REPEAT w[i] := rbuf[rx]; INC(rx); INC(i) UNTIL i = n
  242.     END PickW;
  243. (* ---------------