File: PeanutRetrieveParseImpl.mesa
DIRECTORY
GVMailParse,
List USING [Append, Reverse],
Rope,
PeanutParse,
PeanutRetrieve,
PeanutSendMail;
PeanutRetrieveParseImpl:
CEDAR
PROGRAM
IMPORTS
GVMailParse, List, Rope, PeanutParse, PeanutSendMail
BEGIN OPEN GVMailParse, PeanutParse;
Global variables
ROPE: TYPE = Rope.ROPE;
turn the fullText into records
ParseMsgIntoFields:
PUBLIC
PROC[msg: PeanutRetrieve.MsgRec]
RETURNS[s: PeanutParse.ParseStatus, sPos, mPos: INT] =
BEGIN
mLF: MessageInfo;
msgText: ROPE← msg.fullText;
msgLen: INT;
lastCharPos: INT← msgText.Length[] - 1;
originName: Name = NEW[NameRecord];
originQual: Qualification;
originIndex: MessageFieldIndex← replyToF; -- anything except sender or from
whichRegistry: ROPE← PeanutSendMail.defaultRegistry;
localRegistry: ROPE← PeanutSendMail.defaultRegistry;
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: MessageFieldIndex] =
BEGIN
ProcessName:
PROCEDURE [
simpleName, registry, arpaHost: ROPE, ignored: GVMailParse.NameInfo]
RETURNS [accept: BOOLEAN] =
BEGIN
IF ~(originIndex = senderF
OR index = originIndex
OR index = replyToF)
THEN
BEGIN
originIndex ← index;
originName.simpleName← simpleName;
originName.registry← registry;
originName.arpaHost← arpaHost;
SELECT originQual← DetermineQualification[originName]
FROM
unqualified => {originName.registry← whichRegistry; originQual← dotQualified};
dotQualified => whichRegistry← originName.registry;
arpaQualified =>
IF LocalArpaSite[arpaHost]
THEN
IF registry.Length[] = 0
THEN
{ originName.registry← localRegistry; originName.arpaHost←
NIL;
originQual← dotQualified};
ENDCASE;
END;
RETURN[FALSE]
END; -- of ProcessName --
GVMailParse.ParseNameList[pH, ProcessName ! ParseError => CONTINUE];
END; -- of AnalyzeOrigin --
GetOrigin:
PROCEDURE [index: MessageFieldIndex] =
BEGIN
SELECT index
FROM
senderF => AnalyzeOrigin[index];
fromF =>
IF originIndex # senderF
THEN AnalyzeOrigin[index]
ELSE []← GVMailParse.GetFieldBody[pH];
ENDCASE => []← GVMailParse.GetFieldBody[pH];
RETURN
END; -- of GetOrigin --
AdjustToSenderContext: PROC[name: Name] RETURNS [qual: Qualification] =
BEGIN
SELECT qual ← DetermineQualification[name]
FROM
unqualified =>
SELECT originQual
FROM
dotQualified => {name.registry← originName.registry; qual← dotQualified};
arpaQualified =>
{name.arpaHost← originName.arpaHost; qual← arpaQualified};
ENDCASE;
dotQualified => EXIT;
arpaQualified =>
IF LocalArpaSite[name.arpaHost]
AND name.registry.Length[] = 0
THEN
{name.registry← localRegistry; qual← dotQualified};
ENDCASE;
END; -- of AdjustToSenderContext --
tHeaders: LIST OF ROPE← NIL;
GetNextMsgChar: PROC[] RETURNS [ch: CHAR] =
{
IF mPos > lastCharPos
THEN ch← endOfInput
ELSE ch← Rope.Fetch[msgText, mPos];
mPos← mPos + 1;
};
BackupMsgChar: PROC[] = {mPos← mPos - 1};
SimpleField:
PROC[index: MessageFieldIndex, fieldBody:
ROPE] =
BEGIN
SELECT index
FROM
senderF =>
BEGIN
SELECT originQual
FROM
dotQualified => msg.inMsgSender←
Rope.Cat[originName.simpleName, ".", originName.registry];
arpaQualified =>
{
IF originName.registry.Length[] # 0
THEN fieldBody← Rope.Cat[originName.simpleName, ".", originName.registry];
msg.inMsgSender← Rope.Cat[fieldBody, "@", originName.arpaHost];
};
ENDCASE;
END;
replyToF => msg.replyTo← fieldBody;
fromF => msg.from← fieldBody;
dateF => msg.date← fieldBody;
subjectF => msg.subject← fieldBody;
inReplyToF => msg.inReplyTo← fieldBody;
ENDCASE => ERROR;
END;
RNameListField:
PROC[index: MessageFieldIndex] =
BEGIN
fieldBody: LIST OF ROPE← NIL;
whereWeStarted: INT← mPos;
sawBadNameList:
BOOL←
FALSE;
AnotherRName: PROC[r1, r2, r3: ROPE, n: NameInfo] RETURNS [BOOLEAN] =
BEGIN
name: Name← NEW[NameRecord← [r1, r2, r3]];
qual: Qualification;
SELECT n.type
FROM
normal, publicDL =>
{
IF index = originIndex
THEN {qual← originQual; name← originName}
ELSE qual← AdjustToSenderContext[name];
IF qual = arpaQualified THEN
{
IF name.registry.Length[] # 0
THEN r1← Rope.Cat[r1, ".", name.registry];
r1← Rope.Cat[r1, "@", name.arpaHost]}
ELSE r1← Rope.Cat[r1, ".", name.registry]};
ENDCASE;
fieldBody← CONS[r1, fieldBody];
RETURN[FALSE];
END;
ParseNameList[pH, AnotherRName,
NIL,
TRUE ! ParseError =>
{sawBadNameList← TRUE; CONTINUE}];
IF sawBadNameList
THEN
{ mPos← whereWeStarted; fieldBody← CONS[GetFieldBody[pH], NIL]}
ELSE TRUSTED {fieldBody← LOOPHOLE[List.Reverse[LOOPHOLE[fieldBody]]]};
SELECT index
FROM
toF =>
IF msg.to =
NIL
THEN msg.to← fieldBody
ELSE
IF fieldBody#
NIL
THEN
TRUSTED
{msg.to← LOOPHOLE[List.Append[LOOPHOLE[msg.to], LOOPHOLE[fieldBody]]]};
ccF, cF, bccF =>
IF msg.cc =
NIL
THEN msg.cc← fieldBody
ELSE
IF fieldBody#
NIL
THEN
TRUSTED
{msg.cc← LOOPHOLE[List.Append[LOOPHOLE[msg.cc], LOOPHOLE[fieldBody]]]};
ENDCASE => ERROR;
END;
pH: ParseHandle← InitializeParse[next: GetNextMsgChar, backup: BackupMsgChar];
field: ROPE← NIL;
fieldNotRecognized: BOOL← FALSE;
s← ok; -- good status
mPos← 0; -- where we are in the text
DO
-- analyze from or sender field
sPos← mPos;
[fieldNotRecognized, field]← GetFieldName[pH ! ParseError =>
{ FinalizeParse[pH]; GOTO parseErrorExit}];
IF ~fieldNotRecognized THEN EXIT;
FOR i: MessageFieldIndex
IN MessageFieldIndex
DO
IF Rope.Equal[field, messageParseArray[i].name, FALSE] THEN {GetOrigin[i]; EXIT};
REPEAT FINISHED => []← GetFieldBody[pH];
ENDLOOP;
ENDLOOP;
mPos← 0;
DO
sPos← mPos;
[fieldNotRecognized, field]← GetFieldName[pH]; -- can't get ParseError this time
IF ~fieldNotRecognized
THEN
EXIT;
FOR i: MessageFieldIndex
IN MessageFieldIndex
DO
{ mLF← messageParseArray[i];
IF Rope.Equal[mLF.name, field, FALSE] THEN -- ignore case
{ fieldNotRecognized←
FALSE;
SELECT mLF.fType
FROM
simpleRope => SimpleField[i, GetFieldBody[pH]];
rCatList => msg.categories← CategoriesField[GetFieldBody[pH]];
rNameList => RNameListField[i];
ENDCASE => ERROR;
EXIT
};
};
ENDLOOP;
IF fieldNotRecognized THEN
{ []← GetFieldBody[pH];
-- anything not recognized
tHeaders ← CONS[Rope.Substr[msgText, sPos, mPos-sPos-1], tHeaders]
};
ENDLOOP;
now we are positioned at the beginning of the body of the message
FinalizeParse[pH];
IF tHeaders #
NIL
THEN
TRUSTED {msg.unrecognized← LOOPHOLE[List.Reverse[LOOPHOLE[tHeaders]]]};
IF ((msgLen← msgText.Length[])-mPos) < 0
THEN
msg.bodyText← ""
ELSE msg.bodyText← Rope.Substr[msgText, mPos, msgLen];
EXITS
parseErrorExit => RETURN[syntaxError, sPos, mPos];
END;
CategoriesField:
PROC[fB:
ROPE]
RETURNS [
LIST
OF
ROPE] =
BEGIN
end: INT← fB.Length[];
p: INT← Rope.SkipOver[fB, 0, " \n"];
r: ROPE;
IF p # end THEN r← Rope.Substr[fB, p, end-p+1] ELSE {r← fB; p← 0};
IF (p← Rope.Find[fB, "',", p]) < 0
THEN
RETURN[
CONS[r,
NIL]]
ELSE
RETURN[
CONS[r, CategoriesField[Rope.Substr[r, p+1, end-p]]]];
END;
END.