home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon / projectoberonsrc / netserver.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-10-18  |  11.8 KB  |  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.             ELSE Send(NPR, 0, dmy)
  243.             END
  244.         ELSIF typ = SML THEN (*send mail*)
  245.             PickS(Id); PickQ(pw); PickW(n); SetPartner(Id); uno := Core.UserNo(Id, pw);
  246.             IF uno >= 0 THEN
  247.                 IF uno # mailuno THEN
  248.                     Core.GetFileName(uno, fname); MF := Files.Old(fname); mailuno := uno
  249.                 END ;
  250.                 IF (MF # NIL) & (n > 0) & (n < 31) THEN
  251.                     Files.Set(R, MF, (n+1)*32);
  252.                     Files.ReadInt(R, i); Files.ReadInt(R, j); pos := LONG(i) * 100H;
  253.                     Files.ReadLInt(R, len);
  254.                     IF len > 0 THEN Files.Set(R, MF, pos); SendMail(R, len)
  255.                     ELSE Send(NAK, 0, dmy)
  256.                     END
  257.                 ELSE Send(NAK, 0, dmy)
  258.                 END
  259.             ELSE Send(NPR, 0, dmy)
  260.             END
  261.         ELSIF typ = RML THEN (*receive mail*)
  262.             PickS(Id); PickQ(pw); SetPartner(Id); uno := Core.UserNo(Id, pw);
  263.             IF uno >= 0 THEN
  264.                 F := Files.New("");
  265.                 Send(ACK, 0, dmy); ReceiveHead(T0);
  266.                 IF head1.valid THEN
  267.                     ReceiveData(F, done);
  268.                     IF done THEN Files.Close(F); Core.InsertTask(Core.MailQueue, F, Id, uno) END
  269.                 END
  270.             ELSE Send(NPR, 0, dmy)
  271.             END
  272.         ELSIF typ = DML THEN (*delete mail*)
  273.             PickS(Id); PickQ(pw); PickW(n); SetPartner(Id); uno := Core.UserNo(Id, pw);
  274.             IF uno >= 0 THEN
  275.                 IF uno # mailuno THEN
  276.                     Core.GetFileName(uno, fname); MF := Files.Old(fname); mailuno := uno
  277.                 END ;
  278.                 IF (MF # NIL) & (n > 0) & (n < 31) THEN
  279.                     Files.Set(R, MF, 0);
  280.                     Files.ReadBytes(R, mrtab, 32); Files.ReadBytes(R, mdir, SIZE(Core.MailDir));
  281.                     i := 0; k1 := 30;
  282.                     LOOP k0 := mdir[i].next; DEC(k1);
  283.                         IF (k0 = 0) OR (k1 = 0) THEN Send(NAK, 0, buf); EXIT END ;
  284.                         IF k0 = n THEN
  285.                             j := mdir[n].pos;
  286.                             k0 := SHORT((mdir[n].len + 255) DIV 256) + j;
  287.                             REPEAT INCL(mrtab[j DIV 32], j MOD 32); INC(j) UNTIL j = k0;
  288.                             mdir[n].len := 0; mdir[i].next := mdir[n].next;
  289.                             Files.Set(R, MF, 0); Files.WriteBytes(R, mrtab, 32);
  290.                             Files.WriteBytes(R, mdir, SIZE(Core.MailDir)); Files.Close(MF);
  291.                             Send(ACK, 0, dmy); EXIT
  292.                         END ;
  293.                         i := k0
  294.                     END
  295.                 ELSE Send(NAK, 0, dmy)
  296.                 END
  297.             ELSE Send(NPR, 0, dmy)
  298.             END
  299.         ELSIF typ = TRQ THEN
  300.             Oberon.GetClock(t, d); SetPartner(Id); i := 0;
  301.             AppendW(t, fname, 4, i); AppendW(d, fname, 4, i); Send(TIM, 8, fname)
  302.         ELSIF typ = NRQ THEN i := 0;
  303.             LOOP SCC.Receive(ch); Id[i] := ch; INC(i);
  304.                 IF ch = 0X THEN EXIT END ;
  305.                 IF i = 7 THEN Id[7] := 0X; EXIT END
  306.             END ;
  307.             WHILE i < head1.len DO SCC.Receive(ch); INC(i) END ;
  308.             IF Id = Oberon.User THEN
  309.                 head1.dadr := head1.sadr; head1.typ := NRS; head1.len := 0;
  310.                 SCC.SendPacket(head1, dmy)
  311.             END
  312.         ELSIF typ = MSG THEN i := 0;
  313.             WHILE i < head1.len DO SCC.Receive(ch); Texts.Write(W, ch); INC(i) END ;
  314.             SetPartner(Id); Send(ACK, 0, dmy); EOL
  315.         ELSIF typ = NPW THEN
  316.             PickS(Id); PickQ(pw); uno := Core.UserNo(Id, pw);
  317.             IF uno >= 0 THEN
  318.                 SetPartner(Id); Send(ACK, 0, dmy); ReceiveHead(T0);
  319.                 IF head1.typ = 0 THEN
  320.                     PickQ(npw); Core.SetPassword(uno, npw); Send(ACK, 0, dmy)
  321.                 ELSE Send(NAK, 0, dmy)
  322.                 END
  323.             ELSE Send(NPR, 0, dmy)
  324.             END
  325.         ELSE SCC.Skip(head1.len)
  326.         END ;
  327.         Core.Collect
  328.     END Serve;
  329.     (*----------------------- Commands -------------------*)
  330.     PROCEDURE Start*;
  331.     BEGIN Oberon.Remove(handler); Oberon.Install(handler);
  332.         MF := NIL; mailuno := -2;
  333.         Texts.WriteString(W, "Net started  (NW 15.9.93)"); EOL
  334.     END Start;
  335.     PROCEDURE State*;
  336.         VAR RR0, RR1: SHORTINT;
  337.     BEGIN SYSTEM.GET(0FFFD88H, RR0); SYSTEM.PUT(0FFFD88H, 1); SYSTEM.GET(0FFFD88H, RR1);
  338.         Texts.WriteString(W, "Net state"); Texts.WriteHex(W, RR0); Texts.WriteHex(W, RR1); EOL
  339.     END State;
  340.     PROCEDURE Reset*;
  341.     BEGIN SCC.Start(TRUE)
  342.     END Reset;
  343.     PROCEDURE Stop*;
  344.     BEGIN Oberon.Remove(handler); Texts.WriteString(W, "Net stopped"); EOL
  345.     END Stop;
  346.     PROCEDURE Protect*;
  347.     BEGIN protected := TRUE
  348.     END Protect;
  349.     PROCEDURE Unprotect*;
  350.     BEGIN protected := FALSE
  351.     END Unprotect;
  352. BEGIN Texts.OpenWriter(W); NEW(handler); handler.handle := Serve
  353. END NetServer.
  354.