DIRECTORY Ascii USING [Lower], GVAnswer, GVMailParse USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse, ParseError, ParseHandle, ParseNameList], IO, Rope; GVAnswerImpl: CEDAR PROGRAM IMPORTS Ascii, GVMailParse, IO, Rope EXPORTS GVAnswer = BEGIN OPEN IO; ROPE: TYPE = Rope.ROPE; CharIndex: TYPE = INT; nullIndex: CharIndex = LAST[CharIndex]; Qualification: TYPE = {unqualified, dotQualified}; DuplicateNameRecord: TYPE = RECORD [name: ROPE, seenOnSecondPass: BOOL]; DuplicateName: TYPE = REF DuplicateNameRecord; MakeHeader: PUBLIC PROC[getChar: PROC [INT] RETURNS [CHAR], getLength: INT, userName, userRegistry: ROPE, cForCopies: BOOL _ FALSE] RETURNS [answerError: BOOL, answer: ROPE, errorIndex: INT] = { outBuffer: IO.STREAM; getCharIndex: CharIndex; pH: GVMailParse.ParseHandle; havePH: BOOL _ FALSE; idIndex: CharIndex _ nullIndex; dateIndex: CharIndex _ nullIndex; subjectIndex: CharIndex _ nullIndex; fromFieldErrorIndex: CharIndex _ nullIndex; startOfHeaderLine: CharIndex _ nullIndex; parseErrorEncountered: BOOL _ FALSE; StuffChar: PROC[char: CHAR] = {IF char # '\n THEN outBuffer.PutChar[char]}; 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, originRegistry: ROPE; originQual: Qualification; originIndex: FieldIndex _ reply; -- anything except sender or from answerTargetBodyCharIndex: CharIndex _ nullIndex; targetEqualsOrigin: BOOL _ TRUE; namesOutput: BOOL _ FALSE; replyerCCed: BOOL _ FALSE; ccCount: CARDINAL _ 0; DuplicateHead: LIST OF DuplicateName; GetNextChar: PROC RETURNS [char: CHAR] = { IF getCharIndex >= getLength THEN RETURN [GVMailParse.endOfInput]; char _ getChar[getCharIndex]; getCharIndex _ getCharIndex + 1; }; InitParse: PROC = {pH _ GVMailParse.InitializeParse[]; havePH _ TRUE}; FinParse: PROC = {GVMailParse.FinalizeParse[pH]; havePH _ FALSE}; ProcessFields: PROC [Inner: PROC [index: FieldIndex] RETURNS[parseError: BOOL] ] RETURNS[errorSeen: BOOL] = { OPEN GVMailParse; fieldName: ROPE; found: BOOL; getCharIndex _ 0; InitParse[]; errorSeen _ FALSE; DO { startOfHeaderLine_ getCharIndex; [fieldName, found]_ GetFieldName[pH, GetNextChar ! GVMailParse.ParseError => GOTO badIndex]; IF ~found THEN EXIT; FOR i: FieldIndex IN FieldIndex DO IF fieldName.Equal[knownField[i], FALSE] THEN { IF Inner[i] THEN errorSeen _ TRUE; EXIT}; REPEAT FINISHED => []_ GetFieldBody[pH, GetNextChar, TRUE]; ENDLOOP; EXITS badIndex => DO SELECT GetNextChar[] FROM '\n, GVMailParse.endOfInput => EXIT; ENDCASE; ENDLOOP; }; ENDLOOP; FinParse[]; }; -- of ProcessFields -- AnalyzeOrigin: PROC [index: FieldIndex] = { fieldBodyStartIndex: CharIndex = getCharIndex; ProcessName: PROC [simpleName, registry: ROPE, isFile, ignored: BOOL] RETURNS [reg: ROPE, write: BOOL] = { IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN { originIndex _ index; originName_ simpleName; originRegistry_ registry; originQual_ IF originRegistry.Length[] > 0 THEN dotQualified ELSE unqualified; [originQual, originRegistry]_ AdjustToReplyerContext[originName, originRegistry, originQual, isFile]; }; IF index < answerTarget OR (index = from AND answerTarget = sender) THEN { answerTarget _ index; answerTargetBodyCharIndex _ fieldBodyStartIndex; }; RETURN[NIL, FALSE] }; -- of ProcessName -- GVMailParse.ParseNameList[pH, GetNextChar, ProcessName ! GVMailParse.ParseError => { IF index = from THEN fromFieldErrorIndex _ fieldBodyStartIndex ELSE errorIndex _ fieldBodyStartIndex; []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]; CONTINUE; }]; }; -- of AnalyzeOrigin -- FirstPass: PROC [index: FieldIndex] RETURNS[parseError: BOOL] = { parseError _ FALSE; SELECT index FROM id => { idIndex _ getCharIndex; []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE] }; IN [reply .. from] => AnalyzeOrigin[index]; IN [to .. bcc] => IF FillNameField[firstPass: TRUE] THEN parseError _ TRUE; date => { dateIndex _ getCharIndex; []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE] }; subject => { subjectIndex _ getCharIndex; []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE] }; ENDCASE => []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]; }; -- of FirstPass -- AdjustToSenderContext: PROC[name, registry: ROPE] RETURNS[qual: Qualification, reg: ROPE] = { reg_ registry; SELECT qual_ IF registry.Length[] > 0 THEN dotQualified ELSE unqualified FROM dotQualified => { senderRegistry: ROPE; SELECT originQual FROM unqualified => senderRegistry _ userRegistry; dotQualified => senderRegistry _ originRegistry; ENDCASE; IF registry.Equal[senderRegistry, FALSE] THEN {reg_ NIL; qual _ unqualified} }; ENDCASE; }; -- of AdjustToSenderContext -- AdjustToReplyerContext: PROC [name, registry: ROPE, qual: Qualification, isFile: BOOL] RETURNS [newQual: Qualification, reg: ROPE] = { reg_ registry; SELECT newQual_ qual FROM unqualified => IF originQual = dotQualified AND ~isFile THEN {newQual_ dotQualified; reg_ originRegistry}; dotQualified => IF registry.Equal[userRegistry, FALSE] THEN {newQual_ unqualified; reg_ NIL}; ENDCASE; }; -- of AdjustToReplyerContext -- FillField: PROC = { field: ROPE_ GVMailParse.GetFieldBody[pH, GetNextChar]; IF field.Length[] > 120 THEN -- magic number to correspond to AnswerImpl { outBuffer.PutRope[field.Substr[0, 120]]; outBuffer.PutRope[" ..."]} ELSE outBuffer.PutRope[field]; }; -- of FillField -- AddedToDuplicateList: PROC [simpleName, registry: ROPE, firstPass: BOOL] RETURNS [added: BOOL] = { s: ROPE_ simpleName; IF registry.Length[] # 0 THEN s_ s.Cat[".", registry]; FOR itemL: LIST OF DuplicateName_ DuplicateHead, itemL.rest UNTIL itemL = NIL DO IF Rope.Equal[itemL.first.name, s, FALSE] THEN { IF firstPass THEN RETURN[FALSE]; added _ ~itemL.first.seenOnSecondPass; itemL.first.seenOnSecondPass _ TRUE; RETURN }; ENDLOOP; DuplicateHead_ CONS[NEW[DuplicateNameRecord_ [name: s, seenOnSecondPass: FALSE]], DuplicateHead]; RETURN[TRUE] }; -- of AddedToDuplicateList -- ProcessAnswerTarget: PROC = { ProcessName: PROC [simpleName, registry: ROPE, isFile, ignored: BOOL] RETURNS [reg: ROPE, write: BOOL] = { qual: Qualification; [qual, reg]_ AdjustToSenderContext[simpleName, registry]; []_ AddedToDuplicateList[simpleName, reg, FALSE]; [ , reg]_ AdjustToReplyerContext[simpleName, reg, qual, isFile]; RETURN[reg, TRUE]; }; -- of ProcessName -- getCharIndex _ answerTargetBodyCharIndex; InitParse[]; GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar ! GVMailParse.ParseError => { [] _ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]; CONTINUE }]; FinParse[]; }; -- of ProcessAnswerTarget -- AnalyzeAnswerTarget: PROC = { ProcessName: PROC [simpleName, registry: ROPE, ignored1, ignored2: BOOL] RETURNS [reg: ROPE, write: BOOL] = { [ , reg] _ AdjustToSenderContext[simpleName, registry]; targetEqualsOrigin_ targetEqualsOrigin AND simpleName.Equal[originName, FALSE] AND (reg.Length[] = 0 OR reg.Equal[originRegistry, FALSE]); IF ~AddedToDuplicateList[simpleName, reg, TRUE] THEN ccCount _ ccCount - 1; RETURN[NIL, FALSE]; }; -- of ProcessName -- IF answerTargetBodyCharIndex = 0 THEN ERROR GVMailParse.ParseError[badFieldName]; getCharIndex _ answerTargetBodyCharIndex; InitParse[]; GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, ! GVMailParse.ParseError => { [] _ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]; answerError _ TRUE; CONTINUE }]; FinParse[]; }; -- of AnalyzeAnswerTarget -- FillNameField: PROC [firstPass: BOOL] RETURNS[parseError: BOOL] = { lineIndex: INT _ getCharIndex; firstOutput: BOOL _ TRUE; ProcessName: PROC [simpleName, registry: ROPE, isFile, nested: BOOL] RETURNS [reg: ROPE, write: BOOL] = { qual: Qualification; new: BOOL; [qual, reg] _ AdjustToSenderContext[simpleName, registry]; new _ AddedToDuplicateList[simpleName, reg, firstPass]; IF ~nested AND ~new THEN RETURN[NIL, FALSE]; [ , reg] _ AdjustToReplyerContext[simpleName, reg, qual, isFile]; IF firstPass THEN { ccCount _ ccCount + 1; IF ~replyerCCed AND simpleName.Equal[userName, FALSE] AND reg.Length[] = 0 THEN replyerCCed _ TRUE; RETURN[NIL, FALSE] }; IF firstOutput THEN { firstOutput _ FALSE; IF namesOutput THEN outBuffer.PutRope[", "]; }; RETURN[reg, namesOutput _ TRUE]; }; -- of ProcessName -- parseError _ FALSE; GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar ! GVMailParse.ParseError => { [] _ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]; parseError _ TRUE; errorIndex _ lineIndex; CONTINUE; }; ]; }; -- of FillNameField -- SecondPass: PROC [index: FieldIndex] RETURNS[parseError: BOOL]= { SELECT index FROM IN [to .. bcc] => [] _ FillNameField[firstPass: FALSE]; ENDCASE => []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]; RETURN[FALSE]; }; -- of SecondPass -- answerError _ FALSE; errorIndex_ nullIndex; outBuffer_ ROS[]; { answerError _ ProcessFields[FirstPass ! GVMailParse.ParseError => GO TO BadMessage]; IF answerTargetBodyCharIndex = nullIndex THEN { IF havePH THEN FinParse[]; RETURN[TRUE, answer, fromFieldErrorIndex]; }; AnalyzeAnswerTarget[ ! GVMailParse.ParseError => GO TO BadMessage]; outBuffer.PutRope["Subject: Re: "]; IF subjectIndex # nullIndex THEN { subject: ROPE; pos: INT_ 0; len: INT; foundRe: BOOL_ FALSE; getCharIndex _ subjectIndex; InitParse[]; subject_ GVMailParse.GetFieldBody[pH, GetNextChar]; FinParse[]; len_ subject.Length[]; DO np: INT_ subject.Find["Re:", pos, FALSE]; IF np < 0 THEN EXIT; foundRe_ TRUE; pos_ np+3; -- skip over Re: ENDLOOP; IF foundRe AND (pos < len) THEN WHILE subject.Fetch[pos] = SP DO pos_ pos + 1; ENDLOOP; outBuffer.PutRope[subject.Substr[pos]]; }; outBuffer.PutRope["\nIn-reply-to: "]; IF idIndex = nullIndex THEN { outBuffer.PutChar['"]; IF (IF answerTarget = reply THEN targetEqualsOrigin ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN outBuffer.PutRope["Your"] ELSE { orLen: INT; outBuffer.PutRope[originName]; IF (orLen_ originRegistry.Length[]) # 0 THEN { outBuffer.PutChar['.]; outBuffer.PutRope[originRegistry]; }; outBuffer.PutChar['']; IF orLen # 0 OR Ascii.Lower[originName.Fetch[originName.Length[] - 1]] # 's THEN outBuffer.PutChar['s]; }; outBuffer.PutRope[" message of "]; InitParse[]; IF dateIndex # nullIndex THEN {getCharIndex _ dateIndex; FillField[]}; outBuffer.PutChar['"]; } ELSE { getCharIndex _ idIndex; InitParse[]; FillField[]; }; FinParse[]; outBuffer.PutRope["\nTo: "]; ProcessAnswerTarget[]; outBuffer.PutRope[IF cForCopies THEN "\nc: " ELSE "\ncc: "]; IF answerTarget = reply THEN outBuffer.PutRope[userName] ELSE [] _ ProcessFields[SecondPass ! GVMailParse.ParseError => GO TO BadMessage]; outBuffer.PutChar['\n]; answer_ RopeFromROS[outBuffer]; EXITS BadMessage => { IF havePH THEN FinParse[]; answerError _ TRUE; errorIndex_ startOfHeaderLine}; }; RETURN[answerError, answer, errorIndex] }; END. LGVAnswerImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Karlton, Friday Feb. 13, 1981 6:10 pm PST Levin, March 4, 1983 2:08 PM Brotz, March 4, 1983 12:02 PM Willie-sue, July 28, 1986 11:11:46 am PDT Doug Wyatt, March 7, 1985 11:12:37 am PST Russ Atkinson (RRA) March 21, 1985 1:35:15 am PST Local Data Structures and Types Exported Procedure main body of AnswerImpl find out who it's from and where the interesting indices are make Subject field make In-reply-to field fill in target (To:) field of answer form fill in cc: field empty line at end of header Κ:˜codešœ™Kšœ Οmœ1™Kšžœ"˜&—Kšœ.žœ˜4Kšž ˜ Kšœ˜——Kšœ‘˜—K˜š  œžœžœ žœ˜AKšœ žœ˜šžœž˜šœ˜Kšœ˜Kšœ.žœ˜3Kšœ˜—Kšžœ)˜+Kš žœžœžœžœžœ˜Kšœ ˜ Kšœ˜Kšœ.žœ˜3Kšœ˜—˜ Kšœ˜Kšœ.žœ˜3Kšœ˜—Kšžœ2žœ˜?—šœ‘˜K˜——K˜š œžœžœ˜1Kšžœžœ˜+K˜š žœžœžœžœ ž˜Mšœ˜Kšœžœ˜šžœ ž˜K˜-K˜0Kšžœ˜—šžœ žœž˜-Kšœžœ˜—Kšœ˜—Kšžœ˜—Kšœ‘˜!—K˜š œžœžœžœ˜VKšžœžœ˜/K˜šžœž˜˜šžœžœ ž˜-K˜-K˜—šžœžœž˜+Kšœžœ˜!Kšžœ˜———Kšœ‘˜"—K˜š  œžœ˜Kšœžœ,˜7šžœžœ‘+˜HK˜EKšžœ˜—Kšœ‘˜—K˜š œžœžœ žœ˜HKšžœ žœ˜Kšœžœ ˜Kšžœžœ˜6š žœžœžœ*žœ žœž˜Pšžœ!žœžœ˜0Kšžœ žœžœžœ˜ K˜&Kšœžœ˜$Kšž˜Kšœ˜—Kšžœ˜—˜Kšžœžœ2žœ˜R—Kšžœžœ˜ Kšœ‘˜ —K˜š œžœ˜š  œžœžœžœ˜EKšžœžœ žœ˜$K˜K˜9Kšœ*žœ˜1K˜@Kšžœžœ˜Kšœ‘˜—K˜K˜)K˜ šœ_˜_Kšœ/žœ˜5Kšžœ˜ —K˜ Kšœ‘˜—K˜š œžœ˜š  œžœžœžœ˜HKšžœžœ žœ˜$K˜7˜&Kšžœžœ˜'šžœžœžœ˜;Kšžœ(žœžœ˜KKšžœžœžœ˜Kšœ‘˜———K˜Kšžœžœžœ&˜QK˜)K˜ šœU˜UKšœ0žœ˜6Kšœžœ˜Kšœžœ˜ —K˜ Kšœ‘˜—K˜š   œžœ žœžœ žœ˜CKšœ žœ˜Kšœ žœžœ˜š  œžœžœžœ˜DKšžœžœ žœ˜$K˜Kšœžœ˜ K˜:K˜7Kš žœ žœžœžœžœžœ˜,K˜Ašžœ ž˜Kšœ˜K˜šžœžœžœ˜5Kšžœžœžœ˜-—Kšžœžœžœ˜šœ˜šžœ ž˜šœ˜Kšœžœ˜Kšžœ žœ˜,—Kšœ˜———Kšžœžœ˜ Kšœ‘˜—Kšœ žœ˜šœC˜Cšœ˜Kšœ/žœ˜5Kšœ žœ˜Kšœ˜Kšžœ˜ K˜K˜——Kšœ‘˜—K˜š  œžœžœ žœ˜?Kšœ˜šžœž˜Kšžœ.žœ˜7Kšžœ2žœ˜?—Kšžœžœ˜Kšœ‘˜—K˜Kšœ™K˜Kšœžœ˜K˜Kšœ žœ˜K˜šœ˜K˜—Kšœ<™