home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / mailserver.mod (.txt) < prev    next >
Oberon Text  |  1994-10-18  |  13KB  |  362 lines
  1. Syntax10.Scn.Fnt
  2. MODULE MailServer;  (*NW 17.4.89 / 10.2.94*)
  3.     IMPORT SYSTEM, Core, Files, Texts, Oberon;
  4.     VAR W: Texts.Writer;
  5.         handler: Oberon.Task;
  6.         myadr: ARRAY 16 OF CHAR;
  7.     PROCEDURE Dispatch(F: Files.File; rno, sno, hdlen: INTEGER; bdypos: LONGINT;
  8.             VAR orig, head: ARRAY OF CHAR);
  9.     (*insert external message (from msg) in recipient rno's mail file*)
  10.         VAR i, j, k, h: INTEGER;
  11.             ch: CHAR; ok: BOOLEAN;
  12.             pos, L, bdylen, tm, dt: LONGINT;
  13.             fname: Core.Name;
  14.             MF: Files.File; (*destination*)
  15.             R, Q: Files.Rider;
  16.             mrtab: Core.MResTab;
  17.             mdir: Core.MailDir;
  18.     BEGIN Core.GetFileName(rno, fname); MF := Files.Old(fname);
  19.         IF MF # NIL THEN
  20.             Files.Set(Q, MF, 0); Files.ReadBytes(Q, mrtab, 32);
  21.             Files.ReadBytes(Q, mdir, SIZE(Core.MailDir))
  22.         ELSE (*create new mailbox file*)
  23.             MF := Files.New(fname); Files.Set(Q, MF, 0);  Files.Register(MF);
  24.             mdir[0].next := 0; mrtab[0] := {4 .. 31}; i := 1;
  25.             REPEAT mrtab[i] := {0 .. 31}; INC(i) UNTIL i = 7;
  26.             mrtab[7] := {0 .. 29}; i := 0;
  27.             REPEAT mdir[i].len := 0; INC(i) UNTIL i = 31
  28.         END ;
  29.         Files.Set(R, F, bdypos);
  30.         IF bdypos > 0 THEN  (*find length of body*)
  31.             Files.ReadInt(R, k); Files.ReadLInt(R, bdylen)
  32.         ELSE bdylen := Files.Length(F)
  33.         END ;
  34.         ok := FALSE; i := 0;
  35.         REPEAT INC(i) UNTIL (i = 31) OR (mdir[i].len = 0);
  36.         IF i < 31 THEN  (*free slot found, now find free blocks in file*)
  37.             j := -1;
  38.             REPEAT INC(j);
  39.                 IF j MOD 32 IN mrtab[j DIV 32] THEN
  40.                     h := j; k := SHORT((bdylen + hdlen + 255) DIV 256) + j;
  41.                     LOOP INC(h);
  42.                         IF h = k THEN ok := TRUE; EXIT END ;
  43.                         IF (h = 256) OR ~(h MOD 32 IN mrtab[h DIV 32]) THEN j := h; EXIT END
  44.                     END
  45.                 END
  46.             UNTIL ok OR (j >= 255)
  47.         END ;
  48.         IF ok THEN (*insert msg in blocks j .. k-1*)
  49.             pos := LONG(j) * 256; mdir[i].pos := j;
  50.             REPEAT EXCL(mrtab[j DIV 32], j MOD 32); INC(j) UNTIL j = k;
  51.             mdir[i].len := bdylen + hdlen;
  52.             Oberon.GetClock(tm, dt);
  53.             mdir[i].time := SHORT(tm DIV 2); mdir[i].date := SHORT(dt);
  54.             j := 0;
  55.             WHILE (j < 19) & (orig[j] > " ") DO mdir[i].originator[j] := orig[j]; INC(j) END ;
  56.             mdir[i].originator[j] := 0X;
  57.             mdir[i].next := mdir[0].next; mdir[0].next := i;
  58.             Files.Set(Q, MF, 0); Files.WriteBytes(Q, mrtab, 32);
  59.             Files.WriteBytes(Q, mdir, SIZE(Core.MailDir)); Files.Set(Q, MF, pos);
  60.             j := 0;
  61.             WHILE j < hdlen DO Files.Write(Q, SYSTEM.ROT(head[j], 5)); INC(j) END ;
  62.             L := bdylen;
  63.             WHILE L > 0 DO Files.Read(R, ch); Files.Write(Q, SYSTEM.ROT(ch, 5)); DEC(L) END ;
  64.             L := (-Files.Pos(Q)) MOD 256;
  65.             WHILE L > 0 DO Files.Write(Q, 0); DEC(L) END ;
  66.             Files.Close(MF)
  67.         ELSIF (rno # sno) & (sno > 0) & (rno > 0) THEN (*return to sender*)
  68.             Dispatch(F, sno, sno, hdlen, bdypos, orig, head)
  69.         ELSIF (rno # 0) & (sno # 0) THEN (*send to postmaster*)
  70.             Dispatch(F, 0, sno, hdlen, bdypos, orig, head)
  71.         END
  72.     END Dispatch;
  73.     PROCEDURE Encode(F0: Files.File; textpos: LONGINT;
  74.             VAR orig: Core.LongName; VAR recip, subj: ARRAY OF CHAR);
  75.     (*CX-400 encode message F0 and insert it in export queue*)
  76.         VAR ch: CHAR;
  77.             i, j: INTEGER;
  78.             tm, dt, p0, p1: LONGINT;
  79.             R, Q: Files.Rider; F1: Files.File;
  80.         PROCEDURE WC(n: LONGINT);
  81.         BEGIN Files.Write(Q, CHR(n))
  82.         END WC;
  83.         PROCEDURE WI(n: INTEGER);
  84.         BEGIN Files.WriteBytes(Q, n, 2)
  85.         END WI;
  86.         PROCEDURE WL(n: LONGINT);
  87.         BEGIN Files.WriteBytes(Q, n, 4)
  88.         END WL;
  89.     BEGIN F1 := Files.New(""); Files.Set(Q, F1, 0);
  90.         WI(4000H); WL(0);    (*MSG*)
  91.         WI(5000H); WL(0);    (*ENV*)
  92.         WI(1010H); WI(6);   (*MSGID*)
  93.         Oberon.GetClock(tm, dt); p0 := tm*dt; i := 0;
  94.         REPEAT WC(p0 MOD 10H + 41H); p0 := p0 DIV 10H; INC(i) UNTIL i = 6;
  95.         i := 0;
  96.         WHILE orig[i] > 0X DO INC(i) END ;
  97.         WI(1020H); WI(i+27);   (*ORIG*)
  98.         WI(2011H); WI(2020H); WI(2030H); WI(2041H); WI(3030H); WI(i+15);
  99.         j := 0;
  100.         WHILE j < i DO Files.Write(Q, orig[j]); INC(j) END ;
  101.         j := 0;
  102.         REPEAT Files.Write(Q, myadr[j]); INC(j) UNTIL j = 15;
  103.         i := 0;
  104.         LOOP (*recipients*) j := i;
  105.             WHILE recip[j] > 1X DO INC(j) END ;
  106.             IF i = j THEN EXIT END ;
  107.             WI(1031H); WI(j-i+12);   (*RECIP*)
  108.             WI(ORD(recip[j])+2010H); WI(2020H); WI(2030H); WI(2041H); WI(3030H); WI(j-i);
  109.             WHILE i < j DO Files.Write(Q, recip[i]); INC(i) END ;
  110.             INC(i)
  111.         END ;
  112.         i := 0; j := 0;
  113.         WHILE subj[j] > 0X DO INC(j) END ;
  114.         WI(1060H); WI(j);   (*SUBJ*)
  115.         WHILE i < j DO Files.Write(Q, subj[i]); INC(i) END ;
  116.         WI(1090H); WI(6);   (*SUBM*)
  117.         WC(dt DIV 200H); WC(dt DIV 20H MOD 10H); WC(dt MOD 20H);
  118.         WC(tm DIV 1000H); WC(tm DIV 40H MOD 40H); WC(tm MOD 40H);
  119.         p0 := Files.Pos(Q);
  120.         WI(6020H); WL(Files.Length(F0) - textpos);   (*TEXT*)
  121.         Files.Set(R, F0, textpos); Files.Read(R, ch);
  122.         WHILE ~R.eof DO
  123.             IF ch >= 7FX THEN
  124.                 IF ch = "
  125. " THEN ch := "a"
  126.                 ELSIF ch = "
  127. " THEN ch := "o"
  128.                 ELSIF ch = "
  129. " THEN ch := "u"
  130.                 ELSIF ch = "
  131. " THEN ch := "A"
  132.                 ELSIF ch = "
  133. " THEN ch := "O"
  134.                 ELSIF ch = "
  135. " THEN ch := "U"
  136.                 ELSE ch := "?"
  137.                 END
  138.             END ;
  139.             Files.Write(Q, ch); Files.Read(R, ch)
  140.         END ;
  141.         p1 := Files.Pos(Q); Files.Set(Q, F1, 2);
  142.         WL(p1-6); WI(5000H); WL(p0-12);   (*fixup*)
  143.         Files.Close(F1);
  144.         Core.InsertTask(Core.LineQueue, F1, Oberon.User, -1);
  145.         Texts.Append(Oberon.Log, W.buf)
  146.     END Encode;
  147.     PROCEDURE Decode(F: Files.File; pos: LONGINT);
  148.     (*CX-400 decode message from mail rider MR and dispatch*)
  149.         CONST bufsize = 96; msgsize = 2048;
  150.         VAR i, x, len, mx, rx, rno: INTEGER;
  151.             list, broadcast: BOOLEAN; ch, mo, yr: CHAR;
  152.             length: LONGINT;
  153.             R: Files.Rider;
  154.             rtab: ARRAY 32 OF INTEGER;  (*table of recipients*)
  155.             buf, orig: ARRAY bufsize OF CHAR;
  156.             msg: ARRAY msgsize OF CHAR;  (*message header*)
  157.         PROCEDURE put(ch: CHAR);
  158.         BEGIN
  159.             IF mx < msgsize THEN msg[mx] := ch; INC(mx) END
  160.         END put;
  161.         PROCEDURE PutString(s: ARRAY OF CHAR);
  162.             VAR i: INTEGER; ch: CHAR;
  163.         BEGIN i := 0;
  164.             REPEAT ch := s[i]; INC(i); put(ch)
  165.             UNTIL ch <= " "
  166.         END PutString;
  167.         PROCEDURE PutInt(n: INTEGER);
  168.         BEGIN put(CHR(n DIV 10 + 30H)); put(CHR(n MOD 10 + 30H))
  169.         END PutInt;
  170.         PROCEDURE ReadORName(len: INTEGER; VAR buf: ARRAY OF CHAR; title: ARRAY OF CHAR);
  171.             VAR x, i, L: INTEGER; ch: CHAR;
  172.         BEGIN Files.ReadInt(R, x); list := x = 2011H;
  173.             Files.ReadInt(R, x); Files.ReadInt(R, x);
  174.             Files.ReadInt(R, x); Files.ReadInt(R, L);
  175.             Files.ReadInt(R, L); i := 0;
  176.             IF x = 2041H THEN
  177.                 PutString(title);
  178.                 WHILE i < L DO
  179.                     Files.Read(R, ch);
  180.                     IF i < bufsize THEN buf[i] := ch END ;
  181.                     INC(i); put(ch)
  182.                 END ;
  183.                 put(0DX)
  184.             ELSE
  185.                 WHILE i < L DO
  186.                     Files.Read(R, ch);
  187.                     IF i < bufsize THEN buf[i] := ch END ;
  188.                     INC(i)
  189.                 END ;
  190.             END ;
  191.             IF i >= bufsize THEN i := bufsize-1 END ;
  192.             buf[i] := 0X; DEC(len, L+12);
  193.             WHILE len > 0 DO Files.Read(R, ch); DEC(len) END
  194.         END ReadORName;
  195.     BEGIN Files.Set(R, F, pos); Files.ReadInt(R, x);
  196.         Files.ReadLInt(R, length); INC(pos, length+6);
  197.         IF x = 5000H THEN   (*ENV*)
  198.             mx := 0; rx := 0; broadcast := FALSE;
  199.             IF length > 40000 THEN length := 40000 END ;
  200.             LOOP
  201.                 IF Files.Pos(R) >= pos THEN EXIT END ;
  202.                 Files.ReadInt(R, x); Files.ReadInt(R, len);
  203.                 IF x = 1020H THEN  (*ORIG*)
  204.                     ReadORName(len, orig, "From: ")
  205.                 ELSIF x DIV 10H = 103H THEN  (*RECIP*)
  206.                     ReadORName(len, buf, "To: ");
  207.                     IF buf = "all@cs.inf.ethz.ch" THEN broadcast := TRUE
  208.                     ELSIF list THEN
  209.                         rno := Core.UserNum(buf);
  210.                         IF rno >= 0 THEN rtab[rx] := rno; INC(rx) END
  211.                     END
  212.                 ELSIF x DIV 10H = 106H THEN  (*SUBJ, TITLE*)
  213.                     PutString("Re: "); i := 0;
  214.                     WHILE i < len DO Files.Read(R, ch); put(ch); INC(i) END ;
  215.                     put(0DX)
  216.                 ELSIF x = 1090H THEN  (*SUBMI*)
  217.                     PutString("Submission: ");
  218.                     Files.Read(R, yr); Files.Read(R, mo); Files.Read(R, ch);
  219.                     PutInt(ORD(ch)); put("."); PutInt(ORD(mo)); put(".");
  220.                     PutInt(ORD(yr)); put(" ");
  221.                     Files.Read(R, ch); PutInt(ORD(ch)); put(":");
  222.                     Files.Read(R, ch); PutInt(ORD(ch)); put(":");
  223.                     Files.Read(R, ch); PutInt(ORD(ch)); put(0DX)
  224.                 ELSE Files.Set(R, F, Files.Pos(R) + len)  (*skip*)
  225.                 END
  226.             END ;
  227.             IF broadcast THEN (*broadcast*)
  228.                 i := 1; rno := Core.NofUsers();
  229.                 WHILE i < rno DO Dispatch(F, i, 0, mx, pos, orig, msg); INC(i) END
  230.             ELSIF rx = 0 THEN (*no valid recipient*) Dispatch(F, 0, -1, mx, pos, orig, msg)
  231.             ELSE i := 0;
  232.                 REPEAT x := rtab[i]; INC(i); Dispatch(F, x, -1, mx, pos, orig, msg) UNTIL i = rx
  233.             END
  234.         END
  235.     END Decode