-- File: GVAnswerImpl.Mesa -- based on [Juniper]Laurel>6T30>IntAnswerCom.mesa -- edited by Karlton, Friday Feb. 13, 1981 6:10 pm PST -- edited by Levin, 29-Mar-82 9:34:23 -- edited by Willie-Sue on: January 21, 1983 10:43 am DIRECTORY Rope, GVAnswer, GVMailParse USING [ endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse, NameInfo, ParseError, ParseHandle, ParseNameList]; GVAnswerImpl: CEDAR PROGRAM IMPORTS GVMailParse, Rope EXPORTS GVAnswer = BEGIN -- Local Data Structures and Types ROPE: TYPE = Rope.ROPE; CharIndex: TYPE = INT; nullIndex: CharIndex = LAST[CharIndex]; Name: TYPE = REF NameRecord; NameRecord: TYPE = RECORD [simpleName, registry, arpaHost: ROPE]; Qualification: TYPE = {unqualified, dotQualified, arpaQualified}; DuplicateNameHandle: TYPE = REF DuplicateName; DuplicateName: TYPE = RECORD [ next: DuplicateNameHandle, seenOnSecondPass: BOOLEAN, name: ROPE]; -- Exported Procedures MakeHeader: PUBLIC PROCEDURE [ getChar: PROCEDURE [INT] RETURNS [CHARACTER], getLength: INT, userName, userRegistry: ROPE, arpaGatewayHostNames: LIST OF ROPE, cForCopies: BOOLEAN _ FALSE] RETURNS [answerError: BOOLEAN, answer: ROPE] = BEGIN getCharIndex, reStart: CharIndex; pH: GVMailParse.ParseHandle; havePH: BOOLEAN _ FALSE; idIndex: CharIndex _ nullIndex; dateIndex: CharIndex _ nullIndex; subjectIndex: CharIndex _ nullIndex; rp: ROPE; rLen: INT; 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 ROPE = ["Message-ID", "Reply-to", "Sender", "From", "To", "cc", "c", "bcc", "Date", "Subject"]; -- order corresponds to FieldIndex answerTarget: FieldIndex _ SUCC[from]; originName: Name = NEW[NameRecord_ [NIL, NIL, NIL]]; originQual: Qualification; originIndex: FieldIndex _ reply; -- anything except sender or from answerTargetBodyCharIndex: CharIndex _ 0; defaultRegistry: ROPE = "pa"; replyerRegIsDefault: BOOLEAN = Rope.Equal[userRegistry, defaultRegistry, FALSE]; targetEqualsOrigin: BOOLEAN _ TRUE; namesOutput: BOOLEAN _ FALSE; replyerCCed: BOOLEAN _ FALSE; ccCount: CARDINAL _ 0; DuplicateHead: DuplicateNameHandle _ NIL; GetNextChar: PROCEDURE RETURNS [char: CHARACTER] = BEGIN char _ IF getCharIndex >= getLength THEN GVMailParse.endOfInput ELSE getChar[getCharIndex]; getCharIndex _ getCharIndex + 1; END; -- of GetNextChar -- BackupChar: PROCEDURE = {getCharIndex _ getCharIndex - 1}; InitParse: PROCEDURE = { pH _ GVMailParse.InitializeParse[GetNextChar, BackupChar]; havePH _ TRUE}; FinParse: PROCEDURE = {GVMailParse.FinalizeParse[pH]; havePH _ FALSE}; ProcessFields: PROCEDURE [Inner: PROC [index: FieldIndex]] = BEGIN OPEN GVMailParse; fieldName: ROPE; found: BOOL; getCharIndex _ 0; InitParse[]; DO [found, fieldName]_ GetFieldName[pH]; IF ~found THEN EXIT; FOR i: FieldIndex IN FieldIndex DO IF Rope.Equal[fieldName, knownField[i], FALSE] THEN {Inner[i]; EXIT}; REPEAT FINISHED => []_ GetFieldBody[pH]; 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: ROPE, ignored: GVMailParse.NameInfo] RETURNS [accept: BOOLEAN] = BEGIN IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN BEGIN originIndex _ index; originName.simpleName_ simpleName; originName.registry_ registry; 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 -- GVMailParse.ParseNameList[pH, ProcessName]; END; -- of AnalyzeOrigin -- GetOrigin: PROCEDURE [index: FieldIndex] = BEGIN SELECT index FROM IN [reply..from] => AnalyzeOrigin[index]; ENDCASE => []_ GVMailParse.GetFieldBody[pH]; RETURN END; -- of GetOrigin -- FirstPass: PROCEDURE [index: FieldIndex] = BEGIN SELECT index FROM id => {idIndex _ getCharIndex; []_ GVMailParse.GetFieldBody[pH]}; IN [to..bcc] => FillNameField[firstPass: TRUE]; date => {dateIndex _ getCharIndex; []_ GVMailParse.GetFieldBody[pH]}; subject => {subjectIndex _ getCharIndex; []_ GVMailParse.GetFieldBody[pH]}; ENDCASE => []_ GVMailParse.GetFieldBody[pH]; RETURN END; -- of FirstPass -- LocalArpaSite: PROCEDURE [host: ROPE] RETURNS [BOOLEAN] = BEGIN FOR l: LIST OF ROPE_ arpaGatewayHostNames, l.rest UNTIL l=NIL DO IF Rope.Equal[host, l.first, FALSE] 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: ROPE; SELECT originQual FROM unqualified => senderRegistry _ userRegistry; dotQualified => senderRegistry _ originName.registry; arpaQualified => EXIT; ENDCASE; IF Rope.Equal[name.registry, senderRegistry, FALSE] THEN BEGIN name.registry_ NIL; qual _ unqualified; END; EXIT END; arpaQualified => BEGIN nameIsLocalArpa: BOOLEAN = LocalArpaSite[name.arpaHost]; IF nameIsLocalArpa AND name.registry.Length[] = 0 AND ~replyerRegIsDefault THEN name.registry_ defaultRegistry; IF originQual ~= arpaQualified THEN IF nameIsLocalArpa THEN name.arpaHost_ NIL -- and LOOP ELSE EXIT ELSE BEGIN IF Rope.Equal[name.arpaHost, originName.arpaHost, FALSE] THEN { name.arpaHost_ NIL; 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.Fetch[0] FROM '@, '" => NULL; ENDCASE => 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_ NIL; newQual _ qual _ DetermineQualification[name]; IF qual = dotQualified THEN GO TO CheckEqualNA; END; ENDCASE; EXITS AddOriginHost => name.arpaHost_ originName.arpaHost; CheckEqualNA => IF Rope.Equal[name.registry, userRegistry, FALSE] THEN BEGIN newQual _ unqualified; name.registry_ NIL; END; END; -- of AdjustToReplyerContext -- FillField: PROC RETURNS[field: ROPE] = BEGIN -- field: STRING = [124]; field_ GVMailParse.GetFieldBody[pH]; IF field.Length[] > 124 - 4 THEN field_ Rope.Concat[Rope.Substr[field, 0, 120], " ..."]; END; -- of FillField -- AddedToDuplicateList: PROCEDURE [name: Name, firstPass: BOOLEAN] RETURNS [added: BOOLEAN] = BEGIN item: DuplicateNameHandle; rp: ROPE_ name.simpleName; IF name.registry.Length[] # 0 THEN rp_ Rope.Cat[rp, ".", name.registry]; IF name.arpaHost.Length[] # 0 THEN rp_ Rope.Cat[rp, "@", name.arpaHost]; FOR item _ DuplicateHead, item.next UNTIL item = NIL DO IF Rope.Equal[item.name, rp, FALSE] THEN BEGIN IF firstPass THEN RETURN[FALSE]; added _ ~item.seenOnSecondPass; item.seenOnSecondPass _ TRUE; RETURN END; ENDLOOP; DuplicateHead_ NEW[DuplicateName_ [name: rp, seenOnSecondPass: FALSE, next: DuplicateHead]]; RETURN[TRUE] END; -- of AddedToDuplicateList -- ProcessAnswerTarget: PROCEDURE = BEGIN ProcessName: PROCEDURE [ simpleName, registry, arpaHost: ROPE, ignored: GVMailParse.NameInfo] RETURNS [accept: BOOLEAN] = BEGIN name: REF NameRecord_ NEW[NameRecord _ [simpleName, registry, arpaHost]]; qual: Qualification _ AdjustToSenderContext[name]; [] _ AddedToDuplicateList[name, FALSE]; [] _ AdjustToReplyerContext[name, qual]; RETURN[TRUE]; END; -- of ProcessName -- rp: ROPE_ ""; AccumulateName: PROC[ch: CHAR] = { IF ch#'\n THEN rp_ Rope.Concat[rp, Rope.FromChar[ch]]}; getCharIndex _ answerTargetBodyCharIndex; InitParse[]; GVMailParse.ParseNameList[pH, ProcessName, AccumulateName, TRUE]; FinParse[]; IF rp.Length[]#0 THEN answer_ Rope.Concat[answer, Rope.Flatten[rp]]; END; -- of ProcessAnswerTarget -- AnalyzeAnswerTarget: PROCEDURE = BEGIN ProcessName: PROCEDURE [ simpleName, registry, arpaHost: ROPE, ignored: GVMailParse.NameInfo] RETURNS [accept: BOOLEAN] = BEGIN name: REF NameRecord_ NEW[NameRecord_ [simpleName, registry, arpaHost]]; qual: Qualification _ AdjustToSenderContext[name]; targetEqualsOrigin _ targetEqualsOrigin AND Rope.Equal[simpleName, originName.simpleName, FALSE] AND Rope.Equal[registry, originName.registry, FALSE] AND Rope.Equal[arpaHost, originName.arpaHost, FALSE]; IF ~AddedToDuplicateList[name, TRUE] THEN ccCount _ ccCount - 1; RETURN[FALSE]; END; -- of ProcessName -- IF answerTargetBodyCharIndex = 0 THEN ERROR GVMailParse.ParseError[badFieldName]; getCharIndex _ answerTargetBodyCharIndex; InitParse[]; GVMailParse.ParseNameList[pH, ProcessName, ! GVMailParse.ParseError => answerError _ TRUE]; FinParse[]; END; -- of AnalyzeAnswerTarget -- FillNameField: PROCEDURE [firstPass: BOOLEAN] = BEGIN firstOutput: BOOLEAN _ TRUE; rp: ROPE_ ""; ProcessName: PROCEDURE [ simpleName, registry, arpaHost: ROPE, nameInfo: GVMailParse.NameInfo] RETURNS [accept: BOOLEAN] = BEGIN name: REF NameRecord _ NEW[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 Rope.Equal[simpleName, userName, FALSE] AND registry.Length[] = 0 AND arpaHost.Length[] = 0 THEN replyerCCed _ TRUE; RETURN[FALSE] END; IF firstOutput THEN BEGIN firstOutput _ FALSE; IF namesOutput THEN rp_ Rope.Concat[rp, ", "]; END; RETURN[namesOutput _ TRUE] END; -- of ProcessName -- AccumulateChars: PROC[ch: CHAR] = { IF ch#'\n THEN rp_ Rope.Concat[rp, Rope.FromChar[ch]]}; GVMailParse.ParseNameList[pH, ProcessName, AccumulateChars, TRUE]; IF rp.Length[]#0 THEN answer_ Rope.Concat[answer, Rope.Flatten[rp]]; END; -- of FillNameField -- SecondPass: PROCEDURE [index: FieldIndex] = BEGIN SELECT index FROM IN [to..bcc] => FillNameField[firstPass: FALSE]; ENDCASE => []_ GVMailParse.GetFieldBody[pH]; END; -- of SecondPass -- -- main body of AnswerCommand answerError _ FALSE; -- answer: ROPE; BEGIN -- find out who it's from and where the interesting indices are ProcessFields[GetOrigin ! GVMailParse.ParseError => GO TO BadMessage]; ProcessFields[FirstPass ! GVMailParse.ParseError => GO TO BadMessage]; AnalyzeAnswerTarget[ ! GVMailParse.ParseError => GO TO BadMessage]; -- make Subject field answer_ "Subject: Re: "; IF subjectIndex # nullIndex THEN { getCharIndex _ subjectIndex; InitParse[]; rp_ FillField[]; FinParse[]}; reStart _ 0; rLen_ rp.Length[]; WHILE (rLen > reStart + 2) AND (Rope.Lower[rp.Fetch[reStart]] = 'r) AND (Rope.Lower[rp.Fetch[reStart+1]] = 'e) AND (rp.Fetch[reStart+2] = ':) DO reStart_ reStart + 3; WHILE rLen > reStart AND rp.Fetch[reStart] = ' DO reStart_ reStart + 1; ENDLOOP; ENDLOOP; answer_ Rope.Concat[answer, Rope.Substr[rp, reStart, rLen-reStart]]; -- make In-reply-to field answer_ Rope.Concat[answer, "\nIn-reply-to: "]; IF (IF answerTarget = reply THEN targetEqualsOrigin ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN answer_ Rope.Concat[answer, "Your"] ELSE BEGIN answer_ Rope.Concat[answer, originName.simpleName]; IF originName.registry.Length # 0 THEN answer_ Rope.Cat[answer, ".", originName.registry]; answer_ Rope.Concat[answer, "'"]; IF originName.registry.Length # 0 OR Rope.Lower[originName.simpleName.Fetch[originName.simpleName.Length[]-1]] # 's THEN answer_ Rope.Concat[answer, "s"]; END; answer_ Rope.Concat[answer, " message of "]; InitParse[]; IF dateIndex # nullIndex THEN {getCharIndex _ dateIndex; answer_ Rope.Concat[answer, FillField[]]}; IF idIndex # nullIndex THEN {getCharIndex _ idIndex; answer_ Rope.Cat[answer, ", ", FillField[]]}; FinParse[]; -- fill in target (To:) field of answer form answer_ Rope.Concat[answer, "\nTo: "]; ProcessAnswerTarget[]; -- fill in cc: field answer_ Rope.Concat[answer, IF cForCopies THEN "\nc: " ELSE "\ncc: "]; IF answerTarget = reply THEN answer_ Rope.Concat[answer, userName] ELSE ProcessFields[SecondPass ! GVMailParse.ParseError => GO TO BadMessage]; -- empty line at end of header answer_ Rope.Concat[answer, "\n"]; EXITS BadMessage => {IF havePH THEN FinParse[]; answerError _ TRUE}; END; RETURN[answerError, answer] END; -- of MakeHeader -- END. -- GVAnswerImpl -- Edit Log. WSH on November 22, 1982; get rid of dependency on IO