-- 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 --