-- File: AnswerImpl.Mesa
-- based on [Juniper]<DMS>Laurel>6T30>IntAnswerCom.mesa
-- edited by Karlton, Friday Feb. 13, 1981 6:10 pm PST
-- edited by Levin, 4-Mar-81 10:23:39
DIRECTORY
Answer USING [Block],
Ascii USING [CR, SP],
Inline USING [LongCOPY],
MailParse USING [
endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse,
maxFieldNameSize, maxRecipientLength, NameInfo, ParseError, ParseHandle,
ParseNameList],
Storage USING [Free, FreeString, Node, String],
String USING [AppendChar, AppendString, EquivalentString, LowerCase];
AnswerImpl: PROGRAM
IMPORTS Inline, MailParse, String, Storage EXPORTS Answer =
BEGIN
-- Local Data Structures and Types
Buffer: TYPE = LONG STRING;
CharIndex: TYPE = CARDINAL;
nullIndex: CharIndex = LAST[CharIndex];
Name: TYPE = POINTER TO NameRecord;
NameRecord: TYPE = RECORD [simpleName, registry, arpaHost: STRING];
Qualification: TYPE = {unqualified, dotQualified, arpaQualified};
DuplicateNameHandle: TYPE = POINTER TO DuplicateName;
DuplicateName: TYPE = RECORD [
next: DuplicateNameHandle, seenOnSecondPass: BOOLEAN, name: STRING];
-- Exported Procedures
MakeHeader: PUBLIC PROCEDURE [
getChar: PROCEDURE [CARDINAL] RETURNS [CHARACTER], getLength: CARDINAL,
putBlock: PROCEDURE [Answer.Block],
getPages: PROCEDURE [CARDINAL] RETURNS [LONG POINTER],
freePages: PROCEDURE [LONG POINTER],
userName, userRegistry: STRING,
arpaGatewayHostNames: DESCRIPTOR FOR ARRAY OF STRING,
cForCopies: BOOLEAN ← FALSE]
RETURNS [answerError: BOOLEAN] =
BEGIN
getCharIndex, reStart: CharIndex;
pH: MailParse.ParseHandle;
havePH: BOOLEAN ← FALSE;
buffer: Buffer ← NIL;
idIndex: CharIndex ← nullIndex;
dateIndex: CharIndex ← nullIndex;
subjectIndex: CharIndex ← nullIndex;
nameSize: CARDINAL = 60;
PutIndex: TYPE = {subject, inreply, to, cc}; -- order is significant!
FieldIndex: TYPE = {
id, reply, sender, from, to, cc, c, bcc, date, subject}; -- order is significant!
knownField: ARRAY FieldIndex OF STRING =
["Message-ID"L, "Reply-to"L, "Sender"L, "From"L, "To"L, "cc"L, "c"L, "bcc"L,
"Date"L, "Subject"L]; -- order corresponds to FieldIndex
answerTarget: FieldIndex ← SUCC[from];
originSN: STRING = [MailParse.maxRecipientLength];
originReg: STRING = [MailParse.maxRecipientLength];
originH: STRING = [MailParse.maxRecipientLength];
originPieces: NameRecord ← [originSN, originReg, originH];
originName: Name = @originPieces;
originQual: Qualification;
originIndex: FieldIndex ← reply; -- anything except sender or from
answerTargetBodyCharIndex: CharIndex ← 0;
defaultRegistry: STRING = "PA"L;
replyerRegIsDefault: BOOLEAN = String.EquivalentString[userRegistry, defaultRegistry];
targetEqualsOrigin: BOOLEAN ← TRUE;
namesOutput: BOOLEAN ← FALSE;
replyerCCed: BOOLEAN ← FALSE;
ccCount: CARDINAL ← 0;
DuplicateHead: DuplicateNameHandle ← NIL;
AppendToBuffer: PROCEDURE [b: POINTER TO Buffer, char: CHARACTER] =
BEGIN
IF b.length >= b.maxlength THEN {
pages: CARDINAL = ((b.maxlength + 4)/512) + 1;
temp: Buffer ← NewBuffer[pages];
Inline.LongCOPY[from: @b.text, to: @temp.text, nwords: b.maxlength/2];
temp.length ← b.length;
freePages[b↑];
b↑ ← temp};
b[b.length] ← char;
b.length ← b.length + 1;
RETURN
END; -- of AppendToBuffer --
AppendStringToBuffer: PROCEDURE [b: POINTER TO Buffer, s: STRING] =
BEGIN
IF s # NIL THEN FOR i: CARDINAL IN [0..s.length) DO
AppendToBuffer[b, s[i]] ENDLOOP;
END; -- of AppendStringToBuffer --
DeleteRangeInBuffer: PROCEDURE [b: Buffer, from, to: CARDINAL] =
BEGIN
dif: CARDINAL = to - from;
b.length ← b.length - dif;
FOR i: CARDINAL IN [from..b.length) DO b[i] ← b[i+dif] ENDLOOP;
END; -- of DeleteRangeInBuffer --
NewBuffer: PROCEDURE [pages: CARDINAL] RETURNS [b: Buffer] =
BEGIN
b ← getPages[pages];
b↑ ← [length: 0, maxlength: pages*512 - 4, text: ];
END; -- of NewBuffer --
GetNextChar: PROCEDURE RETURNS [char: CHARACTER] =
BEGIN
char ←
IF getCharIndex >= getLength THEN MailParse.endOfInput ELSE getChar[getCharIndex];
getCharIndex ← getCharIndex + 1;
END; -- of GetNextChar --
BackupChar: PROCEDURE = {getCharIndex ← getCharIndex - 1};
InitParse: PROCEDURE = {
pH ← MailParse.InitializeParse[GetNextChar, BackupChar]; havePH ← TRUE};
FinParse: PROCEDURE = {MailParse.FinalizeParse[pH]; havePH ← FALSE};
StuffChar: PROCEDURE [char: CHARACTER] =
BEGIN
IF char ~= Ascii.CR THEN [] ← AppendToBuffer[@buffer, char];
END; -- of StuffChar --
ProcessFields: PROCEDURE [Inner: PROC [index: FieldIndex]] =
BEGIN OPEN MailParse;
discardS: STRING = [0];
fieldName: STRING = [maxFieldNameSize];
getCharIndex ← 0;
InitParse[];
DO
IF ~GetFieldName[pH, fieldName] THEN EXIT;
FOR i: FieldIndex IN FieldIndex DO
IF String.EquivalentString[fieldName, knownField[i]] THEN {Inner[i]; EXIT};
REPEAT FINISHED => GetFieldBody[pH, discardS];
ENDLOOP;
ENDLOOP;
FinParse[];
END; -- of ProcessFields --
DetermineQualification: PROCEDURE [name: Name] RETURNS [Qualification] =
BEGIN
RETURN[
SELECT TRUE FROM
name.arpaHost.length > 0 => arpaQualified,
name.registry.length > 0 => dotQualified,
ENDCASE => unqualified]
END; -- of DetermineQualification --
AnalyzeOrigin: PROCEDURE [index: FieldIndex] =
BEGIN
fieldBodyStartIndex: CharIndex = getCharIndex;
ProcessName: PROCEDURE [
simpleName, registry, arpaHost: STRING, ignored: MailParse.NameInfo]
RETURNS [accept: BOOLEAN] =
BEGIN
IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN
BEGIN OPEN String;
originIndex ← index;
originName.simpleName.length ← originName.registry.length ←
originName.arpaHost.length ← 0;
AppendString[originName.simpleName, simpleName];
AppendString[originName.registry, registry];
AppendString[originName.arpaHost, arpaHost];
originQual ← DetermineQualification[originName];
originQual ← AdjustToReplyerContext[originName, originQual];
END;
IF index < answerTarget AND
~(originQual = arpaQualified AND index = sender) THEN
BEGIN
answerTarget ← index;
answerTargetBodyCharIndex ← fieldBodyStartIndex;
END;
RETURN[FALSE]
END; -- of ProcessName --
MailParse.ParseNameList[pH, ProcessName];
END; -- of AnalyzeOrigin --
FirstPass: PROCEDURE [index: FieldIndex] =
BEGIN
discard: STRING ← [0];
SELECT index FROM
id => {idIndex ← getCharIndex; MailParse.GetFieldBody[pH, discard]};
IN [reply..from] => AnalyzeOrigin[index];
IN [to..bcc] => FillNameField[firstPass: TRUE];
date => {dateIndex ← getCharIndex; MailParse.GetFieldBody[pH, discard]};
subject => {subjectIndex ← getCharIndex; MailParse.GetFieldBody[pH, discard]};
ENDCASE => MailParse.GetFieldBody[pH, discard];
RETURN
END; -- of FirstPass --
AppendMessageID: PROCEDURE =
BEGIN
StuffChar[',];
StuffChar[Ascii.SP];
FillField[];
END; -- of AppendMessageID --
LocalArpaSite: PROCEDURE [host: STRING] RETURNS [BOOLEAN] =
BEGIN
FOR i: CARDINAL IN [0..LENGTH[arpaGatewayHostNames]) DO
IF String.EquivalentString[host, arpaGatewayHostNames[i]] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE]
END; -- of LocalArpaSite --
AdjustToSenderContext: PROCEDURE [name: Name] RETURNS [qual: Qualification] =
BEGIN
DO
-- loops only if name has local Arpa qualification and originator is local as well.
SELECT qual ← DetermineQualification[name] FROM
unqualified => EXIT;
dotQualified =>
BEGIN
senderRegistry: STRING;
SELECT originQual FROM
unqualified => senderRegistry ← userRegistry;
dotQualified => senderRegistry ← originName.registry;
arpaQualified => EXIT;
ENDCASE;
IF String.EquivalentString[name.registry, senderRegistry] THEN
BEGIN name.registry.length ← 0; qual ← unqualified; END;
EXIT
END;
arpaQualified =>
BEGIN
nameIsLocalArpa: BOOLEAN = LocalArpaSite[name.arpaHost];
IF nameIsLocalArpa AND name.registry.length = 0 AND
~replyerRegIsDefault THEN
String.AppendString[name.registry, defaultRegistry];
IF originQual ~= arpaQualified THEN
IF nameIsLocalArpa THEN name.arpaHost.length ← 0 -- and LOOP
ELSE EXIT
ELSE
BEGIN
IF String.EquivalentString[name.arpaHost, originName.arpaHost] THEN {
name.arpaHost.length ← 0; qual ← DetermineQualification[name]};
EXIT
END;
END;
ENDCASE;
ENDLOOP;
END; -- of AdjustToSenderContext --
AdjustToReplyerContext: PROCEDURE [name: Name, qual: Qualification]
RETURNS [newQual: Qualification] =
BEGIN
SELECT newQual ← qual FROM
unqualified =>
SELECT newQual ← originQual FROM
dotQualified =>
SELECT name.simpleName[0] FROM
'@, '" => NULL;
ENDCASE => String.AppendString[name.registry, originName.registry];
arpaQualified => GO TO AddOriginHost;
ENDCASE;
dotQualified =>
SELECT originQual FROM
unqualified, dotQualified => GO TO CheckEqualNA;
arpaQualified => BEGIN newQual ← originQual; GO TO AddOriginHost END;
ENDCASE;
arpaQualified =>
IF LocalArpaSite[name.arpaHost] THEN
BEGIN
name.arpaHost.length ← 0;
newQual ← qual ← DetermineQualification[name];
IF qual = dotQualified THEN GO TO CheckEqualNA;
END;
ENDCASE;
EXITS
AddOriginHost => String.AppendString[name.arpaHost, originName.arpaHost];
CheckEqualNA =>
IF String.EquivalentString[name.registry, userRegistry] THEN
BEGIN newQual ← unqualified; name.registry.length ← 0; END;
END; -- of AdjustToReplyerContext --
FillField: PROCEDURE =
BEGIN
field: STRING = [124];
MailParse.GetFieldBody[pH, field];
IF field.length > field.maxlength - 4 THEN
BEGIN
field.length ← field.maxlength - 4;
String.AppendString[field, " ..."L];
END;
AppendStringToBuffer[@buffer, field];
END; -- of FillField --
AddedToDuplicateList: PROCEDURE [name: Name, firstPass: BOOLEAN]
RETURNS [added: BOOLEAN] =
BEGIN
item: DuplicateNameHandle;
size: CARDINAL =
name.simpleName.length +
(IF name.registry.length ~= 0 THEN name.registry.length + 1 ELSE 0) +
(IF name.arpaHost.length ~= 0 THEN name.arpaHost.length + 1 ELSE 0);
s: STRING ← Storage.String[size];
String.AppendString[s, name.simpleName];
IF name.registry.length ~= 0 THEN
{String.AppendChar[s, '.]; String.AppendString[s, name.registry]};
IF name.arpaHost.length ~= 0 THEN
{String.AppendChar[s, '@]; String.AppendString[s, name.arpaHost]};
FOR item ← DuplicateHead, item.next UNTIL item = NIL DO
IF String.EquivalentString[item.name, s] THEN
BEGIN
Storage.FreeString[s];
IF firstPass THEN RETURN[FALSE];
added ← ~item.seenOnSecondPass;
item.seenOnSecondPass ← TRUE;
RETURN
END;
ENDLOOP;
item ← Storage.Node[SIZE[DuplicateName]];
item.name ← s;
item.seenOnSecondPass ← FALSE;
item.next ← DuplicateHead;
DuplicateHead ← item;
RETURN[TRUE]
END; -- of AddedToDuplicateList --
ReleaseDuplicateList: PROCEDURE =
BEGIN
item: DuplicateNameHandle;
UNTIL DuplicateHead = NIL DO
item ← DuplicateHead.next;
Storage.FreeString[DuplicateHead.name];
Storage.Free[DuplicateHead];
DuplicateHead ← item;
ENDLOOP;
END; -- of ReleaseDuplicateList --
ProcessAnswerTarget: PROCEDURE =
BEGIN
ProcessName: PROCEDURE [
simpleName, registry, arpaHost: STRING, ignored: MailParse.NameInfo]
RETURNS [accept: BOOLEAN] =
BEGIN
name: NameRecord ← [simpleName, registry, arpaHost];
qual: Qualification ← AdjustToSenderContext[@name];
[] ← AddedToDuplicateList[@name, FALSE];
[] ← AdjustToReplyerContext[@name, qual];
RETURN[TRUE];
END; -- of ProcessName --
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
MailParse.ParseNameList[pH, ProcessName, StuffChar, TRUE];
FinParse[];
END; -- of ProcessAnswerTarget --
AnalyzeAnswerTarget: PROCEDURE =
BEGIN
ProcessName: PROCEDURE [
simpleName, registry, arpaHost: STRING, ignored: MailParse.NameInfo]
RETURNS [accept: BOOLEAN] =
BEGIN
name: NameRecord ← [simpleName, registry, arpaHost];
qual: Qualification ← AdjustToSenderContext[@name];
targetEqualsOrigin ← targetEqualsOrigin AND
String.EquivalentString[simpleName, originName.simpleName] AND
String.EquivalentString[registry, originName.registry] AND
String.EquivalentString[arpaHost, originName.arpaHost];
IF ~AddedToDuplicateList[@name, TRUE] THEN ccCount ← ccCount - 1;
RETURN[FALSE];
END; -- of ProcessName --
IF answerTargetBodyCharIndex = 0 THEN
ERROR MailParse.ParseError[badFieldName];
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
MailParse.ParseNameList[pH, ProcessName, !
MailParse.ParseError => answerError ← TRUE];
FinParse[];
END; -- of AnalyzeAnswerTarget --
FillNameField: PROCEDURE [firstPass: BOOLEAN] =
BEGIN
firstOutput: BOOLEAN ← TRUE;
ProcessName: PROCEDURE [
simpleName, registry, arpaHost: STRING, nameInfo: MailParse.NameInfo]
RETURNS [accept: BOOLEAN] =
BEGIN
name: NameRecord ← [simpleName, registry, arpaHost];
qual: Qualification ← AdjustToSenderContext[@name];
new: BOOLEAN ← AddedToDuplicateList[@name, firstPass];
IF nameInfo.nesting = none AND ~new THEN RETURN[FALSE];
[] ← AdjustToReplyerContext[@name, qual];
IF firstPass THEN
BEGIN
ccCount ← ccCount + 1;
IF ~replyerCCed AND String.EquivalentString[simpleName, userName] AND
registry.length = 0 AND arpaHost.length = 0 THEN replyerCCed ← TRUE;
RETURN[FALSE]
END;
IF firstOutput THEN
BEGIN
firstOutput ← FALSE;
IF namesOutput THEN {StuffChar[',]; StuffChar[Ascii.SP]}
END;
RETURN[namesOutput ← TRUE]
END; -- of ProcessName --
MailParse.ParseNameList[pH, ProcessName, StuffChar, TRUE];
END; -- of FillNameField --
SecondPass: PROCEDURE [index: FieldIndex] =
BEGIN
discard: STRING = [0];
SELECT index FROM
IN [to..bcc] => FillNameField[firstPass: FALSE];
ENDCASE => MailParse.GetFieldBody[pH, discard];
END; -- of SecondPass --
PutBuffer: PROCEDURE =
BEGIN
AppendToBuffer[@buffer, Ascii.CR];
putBlock[[@buffer.text, buffer.length]];
buffer.length ← 0;
END; -- of PutBuffer --
-- main body of AnswerCommand
answerError ← FALSE;
buffer ← NewBuffer[1];
BEGIN
-- find out who it's from and where the interesting indices are
ProcessFields[FirstPass ! MailParse.ParseError => GO TO BadMessage];
AnalyzeAnswerTarget[ ! MailParse.ParseError => GO TO BadMessage];
-- make Subject field
AppendStringToBuffer[@buffer, "Subject: Re: "L];
IF subjectIndex # nullIndex THEN {
getCharIndex ← subjectIndex; InitParse[]; FillField[]; FinParse[]};
reStart ← 13;
WHILE (buffer.length > reStart + 2) AND
(String.LowerCase[buffer[reStart]] = 'r) AND
(String.LowerCase[buffer[reStart+1]] = 'e) AND
(buffer[reStart+2] = ':) DO
DeleteRangeInBuffer[buffer, reStart, reStart + 3];
WHILE buffer.length > reStart AND buffer[reStart] = Ascii.SP DO
DeleteRangeInBuffer[buffer, reStart, reStart + 1]; ENDLOOP;
ENDLOOP;
PutBuffer[];
-- make In-reply-to field
AppendStringToBuffer[@buffer, "In-reply-to: "L];
IF (IF answerTarget = reply THEN targetEqualsOrigin
ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN
AppendStringToBuffer[@buffer, "Your"L]
ELSE
BEGIN
AppendStringToBuffer[@buffer, originSN];
IF originReg.length ~= 0 THEN
BEGIN
AppendToBuffer[@buffer, '.];
AppendStringToBuffer[@buffer, originReg];
END;
AppendToBuffer[@buffer, ''];
IF originReg.length ~= 0 OR String.LowerCase[originSN[originSN.length - 1]] ~= 's
THEN AppendToBuffer[@buffer, 's];
END;
AppendStringToBuffer[@buffer, " message of "L];
InitParse[];
IF dateIndex # nullIndex THEN {getCharIndex ← dateIndex; FillField[]};
IF idIndex # nullIndex THEN {getCharIndex ← idIndex; AppendMessageID[]};
FinParse[];
PutBuffer[];
-- fill in target (To:) field of answer form
AppendStringToBuffer[@buffer, "To: "L];
ProcessAnswerTarget[];
PutBuffer[];
-- fill in cc: field
AppendStringToBuffer[@buffer, IF cForCopies THEN "c: "L ELSE "cc: "L];
IF answerTarget = reply THEN AppendStringToBuffer[@buffer, userName]
ELSE ProcessFields[SecondPass ! MailParse.ParseError => GO TO BadMessage];
PutBuffer[];
-- empty line at end of header
PutBuffer[];
EXITS BadMessage => {IF havePH THEN FinParse[]; answerError ← TRUE};
END;
freePages[buffer];
ReleaseDuplicateList[];
RETURN[answerError]
END; -- of MakeHeader --
END. -- AnswerImpl --