home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / netserver.mod (.txt) < prev    next >
Oberon Text  |  1994-10-18  |  12KB  |  354 lines
  1. Syntax10.Scn.Fnt
  2. MODULE NetServer;  (*NW 15.2.90 / 15.9.93*)
  3.     IMPORT SYSTEM, SCC, Core, FileDir, Files, Texts, Oberon;
  4.     CONST PakSize = 512;
  5.         T0 = 300; T1 = 1000;  (*timeouts*)
  6.         maxFileLen = 100000H;
  7.         ACK = 10H; NAK = 25H; NPR = 26H; (*acknowledgements*)
  8.         NRQ = 34H; NRS = 35H; (*name request, response*)
  9.         SND = 41H; REC = 42H; (*send / receive request*)
  10.         FDIR = 45H; DEL = 49H;  (*directory and delete file requests*)
  11.         PRT = 43H;  (*receive to print request*)
  12.         TRQ = 46H; TIM = 47H; (*time requests*)
  13.         MSG = 44H; NPW = 48H;  (*new password request*)
  14.         TOT = 7FH; (*timeout*)
  15.         MDIR = 4AH; SML = 4BH; RML = 4CH; DML = 4DH;
  16.     VAR W: Texts.Writer;
  17.         handler: Oberon.Task;
  18.         head0, head1: SCC.Header;
  19.         seqno: SHORTINT;
  20.         K, mailuno: INTEGER;
  21.         protected: BOOLEAN;
  22.         MF: Files.File;  (*last mail file accessed*)
  23.         buf: ARRAY 1024 OF CHAR;  (*used by FDIR*)
  24.         dmy: ARRAY 4 OF CHAR;
  25.     PROCEDURE EOL;
  26.     BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  27.     END EOL;
  28.     PROCEDURE SetPartner(VAR name: ARRAY OF CHAR);
  29.     BEGIN head0.dadr := head1.sadr; head0.destLink := head1.srcLink
  30.     END SetPartner;
  31.     PROCEDURE Send(t: SHORTINT; L: INTEGER; VAR data: ARRAY OF CHAR);
  32.     BEGIN head0.typ := t; head0.len := L; SCC.SendPacket(head0, data)
  33.     END Send;
  34.     PROCEDURE ReceiveHead(timeout: LONGINT);
  35.         VAR time: LONGINT;
  36.     BEGIN time := Oberon.Time() + timeout;
  37.         LOOP SCC.ReceiveHead(head1);
  38.             IF head1.valid THEN
  39.                 IF head1.sadr = head0.dadr THEN EXIT
  40.                 ELSE SCC.Skip(head1.len)
  41.                 END
  42.             ELSIF Oberon.Time() >= time THEN head1.typ := TOT; EXIT
  43.             END
  44.         END
  45.     END ReceiveHead;
  46.     PROCEDURE AppendS(VAR s, d: ARRAY OF CHAR; VAR k: INTEGER);
  47.         VAR i: INTEGER; ch: CHAR;
  48.     BEGIN i := 0;
  49.         REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = 0X
  50.     END AppendS;
  51.     PROCEDURE AppendW(s: LONGINT; VAR d: ARRAY OF CHAR; n: INTEGER; VAR k: INTEGER);
  52.         VAR i: INTEGER;
  53.     BEGIN i := 0;
  54.         REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n
  55.     END AppendW;
  56.     PROCEDURE AppendN(x: LONGINT; VAR d: ARRAY OF CHAR; VAR k: INTEGER);
  57.         VAR i: INTEGER; u: ARRAY 8 OF CHAR;
  58.     BEGIN i := 0;
  59.         REPEAT u[i] := CHR(x MOD 10 + 30H); INC(i); x := x DIV 10 UNTIL x = 0;
  60.         REPEAT DEC(i); d[k] := u[i]; INC(k) UNTIL i = 0
  61.     END AppendN;
  62.     PROCEDURE AppendDate(t, d: INTEGER; VAR buf: ARRAY OF CHAR; VAR k: INTEGER);
  63.         PROCEDURE Pair(ch: CHAR; x: LONGINT);
  64.         BEGIN buf[k] := ch; INC(k);
  65.             buf[k] := CHR(x DIV 10 + 30H); INC(k); buf[k] := CHR(x MOD 10 + 30H); INC(k)
  66.         END Pair;
  67.     BEGIN
  68.         Pair(" ", d MOD 20H); Pair(".", d DIV 20H MOD 10H); Pair(".", d DIV 200H MOD 80H);
  69.         Pair(" ", t DIV 800H MOD 20H); Pair(":", t DIV 20H MOD 40H); Pair(":", t MOD 20H * 2)
  70.     END AppendDate;
  71.     PROCEDURE SendBuffer(len: INTEGER; VAR done: BOOLEAN);
  72.     VAR kd, ks: INTEGER;
  73.     BEGIN
  74.         REPEAT Send(seqno, len, buf); ReceiveHead(T1)
  75.         UNTIL head1.typ # seqno + 10H;
  76.         seqno := (seqno+1) MOD 8; kd := 0; ks := PakSize;
  77.         WHILE ks < K DO buf[kd] := buf[ks]; INC(kd); INC(ks) END ;
  78.         K := kd; done := head1.typ = seqno + 10H
  79.     END SendBuffer;
  80.     PROCEDURE AppendDirEntry(name: FileDir.FileName; adr: LONGINT; VAR done: BOOLEAN);
  81.         VAR i: INTEGER; ch: CHAR;
  82.     BEGIN i := 0; ch := name[0];
  83.         WHILE ch > 0X DO buf[K] := ch; INC(i); INC(K); ch := name[i] END ;
  84.         buf[K] := 0DX; INC(K);
  85.         IF K >= PakSize THEN SendBuffer(PakSize, done) END
  86.     END AppendDirEntry;
  87.     PROCEDURE PickS(VAR s: ARRAY OF CHAR);
  88.         VAR i, n: INTEGER; ch: CHAR;
  89.     BEGIN i := 0; n := SHORT(LEN(s))-1; SCC.Receive(ch);
  90.         WHILE ch > 0X DO
  91.             IF i < n THEN s[i] := ch; INC(i) END ;
  92.             SCC.Receive(ch)
  93.         END ;
  94.         s[i] := 0X
  95.     END PickS;
  96.     PROCEDURE PickQ(VAR w: LONGINT);
  97.         VAR c0, c1, c2: CHAR; s: SHORTINT;
  98.     BEGIN SCC.Receive(c0); SCC.Receive(c1); SCC.Receive(c2); SCC.Receive(s);
  99.         w := s; w := ((w * 100H + LONG(c2)) * 100H + LONG(c1)) * 100H + LONG(c0)
  100.     END PickQ;
  101.     PROCEDURE PickW(VAR w: INTEGER);
  102.         VAR c0: CHAR; s: SHORTINT;
  103.     BEGIN SCC.Receive(c0); SCC.Receive(s); w := s; w := w * 100H + ORD(c0)
  104.     END PickW;
  105.     PROCEDURE SendData(F: Files.File);
  106.         VAR k: INTEGER;
  107.             x: CHAR;
  108.             len: LONGINT;
  109.             R: Files.Rider;
  110.     BEGIN Files.Set(R, F, 0); len := 0; seqno := 0;
  111.         LOOP k := 0;
  112.             LOOP Files.Read(R, x);
  113.                 IF R.eof THEN EXIT END ;
  114.                 buf[k] := x; INC(k);
  115.                 IF k = PakSize THEN EXIT END
  116.             END ;
  117.             REPEAT Send(seqno, k, buf); ReceiveHead(T1)
  118.             UNTIL head1.typ # seqno + 10H;
  119.             seqno := (seqno + 1) MOD 8; len := len + k;
  120.             IF head1.typ # seqno + 10H THEN EXIT END ;
  121.             IF k < PakSize THEN EXIT END
  122.         END
  123.     END SendData;
  124.     PROCEDURE ReceiveData(F: Files.File; VAR done: BOOLEAN);
  125.         VAR k, retry: INTEGER;
  126.             x: CHAR;
  127.             len: LONGINT;
  128.             R: Files.Rider;
  129.     BEGIN Files.Set(R, F, 0); seqno := 0; len := 0; retry := 4;
  130.         LOOP
  131.             IF head1.typ = seqno THEN
  132.                 seqno := (seqno + 1) MOD 8; len := len + head1.len;
  133.                 IF len > maxFileLen THEN
  134.                     Send(NAK, 0, dmy); done := FALSE; Files.Close(F); Files.Purge(F); EXIT
  135.                 END ;
  136.                 retry := 4; Send(seqno + 10H, 0, dmy); k := 0;
  137.                 WHILE k < head1.len DO
  138.                     SCC.Receive(x); Files.Write(R, x); INC(k)
  139.                 END ;
  140.                 IF k < PakSize THEN done := TRUE; EXIT END
  141.             ELSE DEC(retry);
  142.                 IF retry = 0 THEN done := FALSE; EXIT END ;
  143.                 Send(seqno + 10H, 0, dmy)
  144.             END ;
  145.             ReceiveHead(T0)
  146.         END
  147.     END ReceiveData;
  148.     PROCEDURE SendMail(VAR R: Files.Rider; len: LONGINT);
  149.         VAR k: INTEGER; x: CHAR;
  150.     BEGIN seqno := 0;
  151.         LOOP k := 0;
  152.             LOOP Files.Read(R, x);
  153.                 IF k = len THEN EXIT END ;
  154.                 buf[k] := SYSTEM.ROT(x, 3); INC(k);
  155.                 IF k = PakSize THEN EXIT END
  156.             END ;
  157.             REPEAT Send(seqno, k, buf); ReceiveHead(T1)
  158.             UNTIL head1.typ # seqno + 10H;
  159.             seqno := (seqno + 1) MOD 8; len := len - k;
  160.             IF head1.typ # seqno + 10H THEN EXIT END ;
  161.             IF k < PakSize THEN EXIT END
  162.         END
  163.     END SendMail;
  164.     PROCEDURE Serve;
  165.         VAR i, j, k0, k1, n, uno: INTEGER;
  166.             ch: CHAR; typ: SHORTINT;
  167.             done: BOOLEAN;
  168.             F: Files.File;
  169.             R: Files.Rider;
  170.             t, d, pw, npw, pos, len: LONGINT;
  171.             Id: Core.ShortName;
  172.             fname: Core.Name;
  173.             mdir: Core.MailDir;
  174.             mrtab: Core.MResTab;
  175.     BEGIN SCC.ReceiveHead(head1);
  176.         IF ~head1.valid THEN RETURN END ;
  177.         typ := head1.typ;
  178.         IF typ = SND THEN
  179.             PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
  180.             IF Core.UserNo(Id, pw) >= 0 THEN
  181.                 F := Files.Old(fname);
  182.                 IF F # NIL THEN SendData(F)
  183.                 ELSE Send(NAK, 0, dmy)
  184.                 END
  185.             ELSE Send(NPR, 0, dmy)
  186.             END
  187.         ELSIF typ = REC THEN
  188.             PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
  189.             IF ~protected & (Core.UserNo(Id, pw) >= 0) THEN
  190.                 F := Files.New(fname);
  191.                 Send(ACK, 0, dmy); ReceiveHead(T0);
  192.                 IF head1.valid THEN
  193.                     ReceiveData(F, done);
  194.                     IF done THEN Files.Register(F) END
  195.                 END
  196.             ELSE Send(NPR, 0, dmy)
  197.             END
  198.         ELSIF typ = PRT THEN
  199.             PickS(Id); PickQ(pw); SetPartner(Id); uno := Core.UserNo(Id, pw);
  200.             IF uno >= 0 THEN
  201.                 F := Files.New("");
  202.                 Send(ACK, 0, dmy); ReceiveHead(T0);
  203.                 IF head1.valid THEN
  204.                     ReceiveData(F, done);
  205.                     IF done THEN Files.Close(F); Core.InsertTask(Core.PrintQueue, F, Id, uno) END
  206.                 END
  207.             ELSE Send(NPR, 0, dmy)
  208.             END
  209.         ELSIF typ = DEL THEN
  210.             PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
  211.             IF ~protected & (Core.UserNo(Id, pw) >= 0) THEN
  212.                 Files.Delete(fname, i);
  213.                 IF i = 0 THEN Send(ACK, 0, dmy) ELSE Send(NAK, 0, dmy) END
  214.             ELSE Send(NPR, 0, dmy)
  215.             END
  216.         ELSIF typ = FDIR THEN
  217.             PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id); uno := Core.UserNo(Id, pw);
  218.             IF uno >= 0 THEN
  219.                 K := 0; seqno := 0; FileDir.Enumerate(fname, AppendDirEntry);
  220.                 SendBuffer(K, done)
  221.             ELSE Send(NPR, 0, dmy)
  222.             END
  223.         ELSIF typ = MDIR THEN
  224.             PickS(Id); PickQ(pw); SetPartner(Id); uno := Core.UserNo(Id, pw);
  225.             IF uno >= 0 THEN
  226.                 IF uno # mailuno THEN
  227.                     Core.GetFileName(uno, fname); MF := Files.Old(fname); mailuno := uno
  228.                 END ;
  229.                 K := 0; seqno := 0;
  230.                 IF MF # NIL THEN
  231.                     Files.Set(R, MF, 32); Files.ReadBytes(R, mdir, SIZE(Core.MailDir));
  232.                     i := mdir[0].next; j := 30; done := TRUE;
  233.                     WHILE (i # 0) & (j > 0) & done DO
  234.                         AppendN(i, buf, K); AppendDate(mdir[i].time, mdir[i].date, buf, K);
  235.                         buf[K] := " "; INC(K); AppendS(mdir[i].originator, buf, K);
  236.                         buf[K-1] := " "; AppendN(mdir[i].len, buf, K); buf[K] := 0DX; INC(K);
  237.                         IF K >= PakSize THEN SendBuffer(PakSize, done) END ;
  238.                         i := mdir[i].next; DEC(j)
  239.                     END
  240.                 END ;
  241.                 SendBuffer(K, done)
  242.             E