-- MailStampFormat
-- Edited by Horning, January 18, 1978  10:00 AM.
-- Edited by Schroeder, February 24, 1981  5:14 PM.
-- Edited by Levin, February 25, 1981  9:55 AM.
-- Edited by Brotz, September 1, 1980  11:26 AM.

DIRECTORY
  Ascii,
  intCommon: FROM "IntCommon",
  MailParse,
  mfD: FROM "MailFormatDefs",
  opD: FROM "OperationsDefs",
  ovD: FROM "OverviewDefs",
  Storage,
  StringDefs,
  vmD: FROM "VirtualMgrDefs";

MailStampFormat: PROGRAM
  IMPORTS intC: intCommon, MailParse, Storage, StringDefs
  EXPORTS mfD =

BEGIN

OPEN StringDefs;


BogusNumber: ERROR = CODE;

ParseStamp: PUBLIC PROCEDURE [NextChar: PROC RETURNS [CHARACTER],
  tp: vmD.TOCFixedPartPtr] RETURNS [ovD.ErrorCode] =
BEGIN
startOfStamp: STRING = "*start*
"L;
i, j: CARDINAL;

ReadFive: PROCEDURE RETURNS [k: CARDINAL] =
  BEGIN
  char: CHARACTER;
  k _ 0;
  THROUGH [0 .. 5) DO
    IF (char _ NextChar[]) ~IN ['0..'9] THEN ERROR BogusNumber;
    k _ k * 10 + (char - '0);
    ENDLOOP;
  END;  -- of ReadFive --

FOR i IN [0 .. 8) DO IF startOfStamp[i]#NextChar[] THEN GOTO notAStamp; ENDLOOP;

i _ ReadFive[ ! BogusNumber => GOTO notAStamp];
IF NextChar[] # Ascii.SP THEN GOTO notAStamp;
j _ ReadFive[ ! BogusNumber => GOTO notAStamp];
IF NextChar[] # Ascii.SP THEN GOTO notAStamp;

SELECT NextChar[] FROM
  'D => tp.deleted _ TRUE;
  'U => tp.deleted _ FALSE;
  ENDCASE => GOTO notAStamp;

SELECT NextChar[] FROM
  'S => tp.seen _ TRUE;
  'U => tp.seen _ FALSE;
  ENDCASE => GOTO notAStamp;

tp.offsetToHeader _ j;
IF i < j THEN GOTO notAStamp;
tp.textLength _ i - j;
tp.mark _ NextChar[];
IF tp.mark = Ascii.NUL OR NextChar[] # Ascii.CR THEN GOTO notAStamp;
RETURN[ovD.ok];

EXITS
notAStamp => RETURN[ovD.notAStamp];
END; -- of ParseStamp --


CreateStamp: PUBLIC PROC [tp: vmD.TOCFixedPartPtr, PutChar: PROC [CHARACTER]] =
-- This procedure may be used to update an existing stamp. The code discriminates new/old
--   by the value of offsetToHeader in tp. This should accordingly be set to 0 when a
--   wholly new stamp is wanted. The practical effects concern only the offsetToHeader
--   afterwards, which has its old value in the update case and a standard value in the
--   genuine create case.
BEGIN

BinDec: PROCEDURE [i: CARDINAL] =
  BEGIN
  n: CARDINAL _ 10000;
  j, k: CARDINAL;
  FOR k IN [0 .. 3] DO
    j _ 0;
    WHILE i >= n DO
      j _ j + 1;
      i _ i - n;
      ENDLOOP;
    PutChar['0 + j];
    n _ n / 10;
    ENDLOOP;
  PutChar['0 + i];
  END;  -- of BinDec --

fixedStamp: STRING = "*start*
"L;
stampLength: CARDINAL = 24; --REMEMBER TO UPDATE THIS IF FORMAT CHANGED!
i, j: CARDINAL;

FOR i IN [0 .. fixedStamp.length) DO
  PutChar[fixedStamp[i]];
  ENDLOOP;
IF tp.offsetToHeader = 0 THEN tp.offsetToHeader _ stampLength;
  --fixed length part of stamp; whole of a new one
j _ tp.offsetToHeader + tp.textLength;
BinDec[j]; PutChar[Ascii.SP]; --put out total text length
BinDec[tp.offsetToHeader]; PutChar[Ascii.SP]; --offset to header
PutChar[IF tp.deleted THEN 'D ELSE 'U];
PutChar[IF tp.seen THEN 'S ELSE 'U]; --but we may for seen ones
PutChar[tp.mark];
PutChar[Ascii.CR]; --fixed end
END;  -- of CreateStamp --


Handle: TYPE = POINTER TO ParseHeaderObject;
ParseHeaderObject: PUBLIC TYPE = RECORD [
  pH: MailParse.ParseHandle,
  fromS, toS, dateS, subjS: STRING];

InitializeParseHeader: PUBLIC PROCEDURE [next: PROC RETURNS [CHARACTER], backup: PROC]
  RETURNS [h: Handle] =
  BEGIN
  h _ Storage.Node[SIZE[ParseHeaderObject]];
  h^ _ [pH: MailParse.InitializeParse[next, backup],
    fromS: Storage.String[MailParse.maxRecipientLength],
    toS: Storage.String[MailParse.maxRecipientLength],
    dateS: Storage.String[25],
    subjS: Storage.String[120]];
  END;

FinalizeParseHeader: PUBLIC PROCEDURE [h: Handle] =
  BEGIN
  MailParse.FinalizeParse[h.pH];
  Storage.FreeString[h.fromS];
  Storage.FreeString[h.toS];
  Storage.FreeString[h.dateS];
  Storage.FreeString[h.subjS];
  Storage.Free[h];
  END;

ParseHeaderForTOC: PUBLIC PROC [s: STRING, h: Handle] =
-- Produces in 's' the TOC string that goes with the message whose characters 'next' is
--   prepared to deliver.
BEGIN
OPEN mfD, h;

discardS: STRING _ [0];
multipleSenders: BOOLEAN _ FALSE;
which: STRING;

StandardizeDate: PROCEDURE [s: STRING] =
  BEGIN
  AtomType: TYPE = {none, number, alpha};
  ix: CARDINAL _ 0;
  i: [1 .. 12];
  numbers: ARRAY [0 .. 1] OF [0 .. 31];
  numbersSeen: CARDINAL _ 0;
  atom: STRING = [3];
  month: CARDINAL _ 0;
  got: CARDINAL _ 0;
  months: ARRAY [1 .. 12] OF STRING = 
    ["Jan"L, "Feb"L, "Mar"L, "Apr"L, "May"L, "Jun"L,
     "Jul"L, "Aug"L, "Sep"L, "Oct"L, "Nov"L, "Dec"L];

  GetChar: PROCEDURE RETURNS [char: CHARACTER] = INLINE
    BEGIN
    IF ix >= s.length THEN RETURN[0C];
    char _ s[ix];
    ix _ ix + 1;
    END;  -- of GetChar --

  CollectAtom: PROCEDURE [out: STRING] RETURNS [type: AtomType] = INLINE
    BEGIN
    char: CHARACTER;

    Append: PROCEDURE =
      BEGIN
      IF out.length < out.maxlength THEN AppendChar[out, char];
      END;  -- of Append --

    out.length _ 0;
    type _ none;
    DO
      char _ GetChar[];
      SELECT char FROM
        0C => RETURN;
        IN ['0..'9] => IF type = alpha THEN EXIT ELSE {type _ number; Append[]};
        IN ['a .. 'z], IN ['A .. 'Z] =>
          IF type = number THEN EXIT ELSE {type _ alpha; Append[]};
        ENDCASE => IF type ~= none THEN RETURN;
      ENDLOOP;
    ix _ ix - 1;
    END; -- of CollectAtom --

  UNTIL got = 3 DO
    SELECT CollectAtom[atom] FROM
      alpha =>
        IF month = 0 THEN
          FOR i IN [1 .. 12] DO
            IF EquivalentString[months[i], atom] THEN
              {month _ i; got _ got + 1; EXIT};
            ENDLOOP;
      number =>
        IF numbersSeen < 2
          AND (numbers[numbersSeen] _ StringToNumber[atom, 10]) <= 31
          THEN {numbersSeen _ numbersSeen + 1; got _ got + 1};
      ENDCASE => EXIT;
    ENDLOOP;
  s.length _ 0;
  IF numbersSeen = 0 THEN GO TO GarbageDate;
  IF month = 0 THEN
    {IF numbersSeen < 2 OR (month _ numbers[0]) ~IN [1 .. 12]
      OR (i _ numbers[1]) ~IN [1 .. 31]
      THEN GO TO GarbageDate}
  ELSE IF (i _ numbers[0]) ~IN [1 .. 31] THEN GO TO GarbageDate;
  AppendString[s, months[month]]; IF month ~= 5 THEN AppendChar[s, '.];
  AppendChar[s, ' ];
  AppendDecimal[s, i];

  EXITS
  GarbageDate => AppendString[s, "bad date"L];
    END;  -- of StandardizeDate --

AppendToOrFrom: PROCEDURE = INLINE
  -- If mail is from self (stripping off possible host name and/or registry), append
  --   "To: <recipient>".
  BEGIN
  IF EquivalentString[fromS, intC.user.name] AND toS.length > 0 THEN
    {AppendString[s, "To: "L]; AppendString[s, toS]}
  ELSE
    BEGIN
    AppendString[s, IF fromS.length > 0 THEN fromS ELSE "????"L];
    IF multipleSenders THEN AppendString[s, ", ..."L];
    END;
  END;  -- of AppendToOrFrom --

ProcessFrom: PROCEDURE[name, reg, host: STRING, ignored: MailParse.NameInfo]
  RETURNS [BOOLEAN] =
  BEGIN
  i: CARDINAL;
  IF fromS.length = 0 THEN
    BEGIN
    IF host.length ~= 0 THEN
      FOR i IN [0 .. LENGTH[intC.arpaGatewayHostNames]) DO
        IF EquivalentString[host, intC.arpaGatewayHostNames[i]] THEN
          {host.length _ 0; EXIT};
        REPEAT
        FINISHED => GO TO BuildName;
        ENDLOOP;
    IF EquivalentString[reg, intC.user.registry] THEN reg.length _ 0;
    GO TO BuildName;
    EXITS
    BuildName =>
      BEGIN
      AppendString[fromS, name];
      IF reg.length ~= 0 THEN {AppendChar[fromS, '.]; AppendString[fromS, reg]};
      IF host.length ~= 0 THEN {AppendChar[fromS, '@]; AppendString[fromS, host]};
      END;
    END
  ELSE multipleSenders _ TRUE;
  RETURN[FALSE]
  END; -- of ProcessFrom --

dateS.length _ fromS.length _ toS.length _ subjS.length _ s.length _ 0;
DO
  OPEN MailParse;
  IF ~GetFieldName[pH, s ! ParseError => EXIT] THEN EXIT;
  SELECT TRUE FROM
    EquivalentString[s, "From"L] =>
      {ParseNameList[pH, ProcessFrom ! ParseError => CONTINUE]; LOOP};
    EquivalentString[s, "To"L] => which _ toS;
    EquivalentString[s, "Date"L] => which _ dateS;
    EquivalentString[s, "Subject"L] => which _ subjS;
    ENDCASE => which _ discardS;
  GetFieldBody[pH, which, TRUE ! ParseError => CONTINUE];
  ENDLOOP;
s.length _ 0;
StandardizeDate[dateS];
AppendString[s, dateS];
AppendChar[s, opD.substringSeparator];
AppendToOrFrom[];
AppendChar[s, opD.substringSeparator];
IF s.length + subjS.length > s.maxlength THEN subjS.length _ s.maxlength - s.length;
AppendString[s, subjS];
END;  -- of ParseHeaderForTOC --


END. -- of MailStampFormat --
z19932(635)\f1
z19932\f1