MSMailSendImpl:
CEDAR
MONITOR
IMPORTS Ascii, IO, MailAnswer, MailParse, MailSend, MailSendSidedoor, MailUtils, MSSend, MSUtils, Rope, RuntimeError, SerializedFiling, XNSAuth, XNSCH, XNSCredentials, XNSCHName
~
BEGIN
OPEN
CHEntries: CHEntriesP0V0,
MailFormat: MailFormatP1516V3, MailTransport: MailTransportP17V5;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Handle: TYPE ~ MailSend.MailSendHandle;
RName: TYPE ~ MailBasics.RName;
RNameList: TYPE ~ MailBasics.RNameList;
SendingCredentialsList: TYPE ~ MailSend.SendingCredentialsList;
BodyPartInfo: TYPE ~ MailSend.BodyPartInfo;
maxForMultinationalNote: INT ¬ 8100;
maxForAttribute: INT ¬ LONG[LAST[CARD16] - 1];
vanillaNSTextFile: SerializedFiling.AttributeType ~ 17; -- magic??
useHeadingAttributes: BOOL ¬ TRUE;
Registered procedures
SendViaXNS:
PROC [msH: Handle, validate, sendEvenIfInvalidNames:
BOOL]
RETURNS [sent:
BOOL, failureReason:
ROPE, invalidNames: RNameList] ~ {
DummyAbortSendProc: MailSendSidedoor.AbortSendProc ~ { RETURN[FALSE] };
[sent, failureReason, invalidNames, ] ¬ SendViaXNSWithAbort[msH, validate, sendEvenIfInvalidNames, TRUE, DummyAbortSendProc];
};
SendViaXNSWithAbort:
ENTRY
PROC [msH: Handle, validate, sendEvenIfInvalidNames, allowDLRecipients:
BOOL, abortSend: MailSendSidedoor.AbortSendProc]
RETURNS [sent: BOOL ¬ FALSE, failureReason: ROPE, invalidNames, dlsNotAllowed, fakeDls: RNameList] ~ {
ENABLE UNWIND => NULL;
credentials: MailSend.SendingCredentials;
startSendInfo: MSSend.StartSendInfo;
xnsH: MSSend.Handle;
multinationalNote, plainText, formatting: ROPE ¬ NIL;
nsTextFileText: ROPE ¬ NIL;
header, headerText: ROPE ¬ NIL;
DoAbort:
PROC = {
sent ¬ FALSE;
failureReason ¬ "User Abort";
};
credentials ¬ GetCredentials[msH.credentialsList];
IF credentials = NIL THEN RETURN[FALSE, "No cleariinghouse credentials.", NIL, NIL, NIL];
IF abortSend[msH, FALSE] THEN { DoAbort[]; RETURN };
FOR item:
LIST
OF BodyPartInfo ¬ msH.bodyParts, item.rest
WHILE item #
NIL
DO
thisItem: BodyPartInfo ¬ item.first;
SELECT thisItem.type
FROM
MailBasicsItemTypes.header => headerText ¬ thisItem.data;
MailBasicsItemTypes.multinationalNote => multinationalNote ¬ thisItem.data;
MailBasicsItemTypes.plainTextForFormatting => plainText ¬ thisItem.data;
MailBasicsItemTypes.tioga1 => formatting ¬ thisItem.data;
ENDCASE;
IF abortSend[msH, FALSE] THEN { DoAbort[]; RETURN };
ENDLOOP;
BEGIN
IF ( plainText #
NIL )
AND ( formatting #
NIL )
THEN {
msg: ROPE = "%g for formatted message (%g bytes) is longer than the max allowed (%g bytes)\n";
sum: INT ¬ plainText.Length[] + formatting.Length[];
IF sum > maxForAttribute
THEN
RETURN[FALSE, IO.PutFR[msg, [rope["Plain Text + Formatting"]], [integer[plainText.Length[]]], [integer[maxForAttribute]] ], NIL, NIL, NIL];
};
END;
IF useHeadingAttributes
THEN {
IF ( multinationalNote.Length[] > maxForMultinationalNote )
THEN {
sf: SerializedFiling.SerializedFile ¬ [version: 2];
strm: STREAM ¬ IO.ROS[];
segment: SerializedFiling.Segment ¬ NEW[SerializedFiling.SegmentObject[2]];
sf.file.attributes ¬ NEW[SerializedFiling.AttributeSequenceObject [1] ] ;
sf.file.attributes.body[0].type ¬ vanillaNSTextFile;
segment.body[0] ¬ 0;
segment.body[1] ¬ 2; -- magic, from looking at other serialized files
sf.file.attributes.body[0].value ¬ segment;
sf ¬ SerializedFiling.SetRopeContents[sf, multinationalNote];
SerializedFiling.PutSerializedFile[strm, sf];
nsTextFileText ¬ IO.RopeFromROS[strm];
multinationalNote ¬ NIL;
};
}
ELSE {
IF ( multinationalNote.Length[] > maxForMultinationalNote )
OR ( plainText #
NIL )
THEN {
sf: SerializedFiling.SerializedFile ¬ [version: 2];
strm: STREAM ¬ IO.ROS[];
segment: SerializedFiling.Segment ¬ NEW[SerializedFiling.SegmentObject[2]];
isTioga: BOOL ¬ ( plainText # NIL );
IF isTioga THEN sf.file.attributes ¬ NEW[SerializedFiling.AttributeSequenceObject [3] ] ELSE sf.file.attributes ¬ NEW[SerializedFiling.AttributeSequenceObject [1] ] ;
sf.file.attributes.body[0].type ¬ vanillaNSTextFile;
segment.body[0] ¬ 0;
segment.body[1] ¬ 2; -- magic, from looking at other serialized files
sf.file.attributes.body[0].value ¬ segment;
sf ¬ SerializedFiling.SetRopeContents[sf, multinationalNote];
IF isTioga
THEN {
sf.file.attributes.body[1].type ¬ MailFormat.lastInterlispType-1;
sf ¬ SerializedFiling.SetRopeAttribute[sf, MailFormat.lastInterlispType-1, plainText];
sf.file.attributes.body[2].type ¬ MailFormat.lastInterlispType;
sf ¬ SerializedFiling.SetRopeAttribute[sf, MailFormat.lastInterlispType, formatting];
plainText ¬ formatting ¬ NIL;
};
SerializedFiling.PutSerializedFile[strm, sf];
nsTextFileText ¬ IO.RopeFromROS[strm];
multinationalNote ¬ NIL;
};
};
create the encoded header
BEGIN
ENABLE RuntimeError.BoundsFault => GOTO cant;
errorCode: MailParse.ParseErrorCode;
index: INT;
included: MSUtils.NameBodyPairList;
notIncluded: MSUtils.NameBodyPairList;
IF useHeadingAttributes
THEN [header, errorCode, index, included, notIncluded] ¬
MSUtils.HeaderFromText[headerText,
TRUE, plainText, formatting]
ELSE [header, errorCode, index, included, notIncluded] ¬
MSUtils.HeaderFromText[headerText, TRUE, NIL, NIL];
SELECT errorCode
FROM
none => NULL;
badFieldName => RETURN[FALSE, "badFieldName in header", NIL, NIL, NIL];
badFieldBody => RETURN[FALSE, "badFieldBody in header", NIL, NIL, NIL];
truncated => RETURN[FALSE, "header truncated", NIL, NIL, NIL];
ENDCASE => ERROR;
EXITS cant =>
RETURN[FALSE, "Message + heading info is too long to send formatted", NIL, NIL, NIL];
END;
IF abortSend[msH, FALSE] THEN { DoAbort[]; RETURN };
xnsH ¬ MSSend.Create[];
startSendInfo ¬ MSSend.StartSend[handle: xnsH, senderPwd: credentials.credentials.password, sender: MSUtils.XNSRNameFromRope[credentials.credentials.rName.name], returnTo: MSUtils.XNSRNameFromRope[credentials.returnTo.name]];
SELECT startSendInfo
FROM
ok => credentials.authenticated ¬ TRUE;
badPwd => RETURN[FALSE, "badPwd.", NIL, NIL, NIL];
badSender => RETURN[FALSE, "badSender.", NIL, NIL, NIL];
badReturnTo => RETURN[FALSE, "badReturnTo", NIL, NIL, NIL];
allDown => RETURN[FALSE, "allDown.", NIL, NIL, NIL];
ENDCASE => ERROR;
FOR recip: MailBasics.RNameList ¬ msH.recipients, recip.rest
WHILE recip #
NIL
DO
thisRecip: MSBasics.RName ¬ MSRNameFromMailBasicsRName[recip.first];
MSSend.AddRecipient[xnsH, thisRecip];
ENDLOOP;
MSSend.StartItem[xnsH, MailBasicsItemTypes.header];
MSSend.AddToItem[xnsH, header];
IF multinationalNote #
NIL
THEN {
MSSend.StartItem[xnsH, MailBasicsItemTypes.multinationalNote];
MSSend.AddToItem[xnsH, multinationalNote];
};
IF nsTextFileText #
NIL
THEN {
MSSend.StartItem[xnsH, MailBasicsItemTypes.nsTextFile];
MSSend.AddToItem[xnsH, nsTextFileText];
};
IF abortSend[msH, TRUE] THEN { DoAbort[]; RETURN };
sent ¬ TRUE; -- It's success unless MSSend.SendFailed is raised...
BEGIN
xnsInvalidNames: MSSend.InvalidNameList;
[sent, xnsInvalidNames] ¬ MSSend.Send[xnsH, validate, allowDLRecipients
! MSSend.SendFailed => {
sent ¬ NOT notDelivered; -- why not just FALSE ???
failureReason ¬ why;
CONTINUE;
};];
IF ( xnsInvalidNames #
NIL )
AND ( xnsInvalidNames.length > 0 )
THEN
FOR i:
CARDINAL
IN [0..xnsInvalidNames.length)
DO
invalidNames ¬ CONS[GetIthRecipient[msH.recipients, xnsInvalidNames[i].id-1], invalidNames];
ENDLOOP;
IF
NOT allowDLRecipients
THEN
[invalidNames, dlsNotAllowed, fakeDls] ¬ WhatKindOfInvalid[invalidNames];
END;
};
GetIthRecipient:
PROC[rL: RNameList, i:
CARDINAL]
RETURNS[MailBasics.RName] = {
UNTIL i = 0
DO
IF rL = NIL THEN EXIT;
rL ¬ rL.rest;
i ¬ i - 1;
ENDLOOP;
RETURN[IF rL = NIL THEN [$none, NIL] ELSE rL.first];
};
WhatKindOfInvalid:
PROC[nL: RNameList]
RETURNS[iL, dL, fake: RNameList] = {
c: XNSCH.Conversation ¬ XNSCH.InitiateConversation[];
FOR rL: RNameList ¬ nL, rL.rest
UNTIL rL =
NIL
DO
item: XNSCH.Item;
noSuch: BOOL ¬ FALSE;
look at user data, which is their file service (dl's won't have this)
item ¬
XNSCH.LookupItemProperty[c, XNSCHName.NameFromRope[rL.first.name], CHEntries.userData !
XNSCH.Error => {
noSuch ¬ ( code = noSuchObject );
CONTINUE;
} ].item;
SELECT
TRUE
FROM
noSuch => iL ¬ CONS[rL.first, iL]; -- no such object
( item # NIL ) => fake ¬ CONS[rL.first, fake]; -- has a file service
ENDCASE => dL ¬ CONS[rL.first, dL]; -- no file service => dl??
ENDLOOP;
XNSCH.TerminateConversation[c];
};
XNSUserCredentialsProc: MailUtils.UserCredentialsProc = {
password, nameAsRope: ROPE;
identity: XNSCredentials.Identity ¬ XNSCredentials.GetIdentity[];
IF identity = NIL THEN RETURN[NIL];
[nameAsRope, password] ¬ GetCHName[identity];
IF password = NIL THEN RETURN[NIL];
creds ¬ NEW[MailUtils.CredentialsRec ¬ [[$xns, nameAsRope], password] ];
};
GetCHName:
PROC[chidentity: XNSAuth.Identity]
RETURNS[nameAsRope, password:
ROPE] = {
chname: XNSCHName.Name;
chconv: XNSCH.Conversation;
[chname, password, ] ¬ XNSAuth.GetIdentityDetails[chidentity];
don't use distinquished name - it might be in a different domain/org from the login name
MUST used distinguished name so retrieving works!!!
chconv ¬ XNSCH.InitiateConversation[chidentity];
chname ¬ XNSCH.Lookup[chconv, chname]; -- get distinquished name
XNSCH.TerminateConversation[chconv];
RETURN[XNSCHName.RopeFromName[chname], password];
};
XNSLoggedInUserProc: MailUtils.LoggedInUserProc = {
simpleCreds: MailUtils.Credentials ¬ XNSUserCredentialsProc[];
IF simpleCreds = NIL THEN RETURN[FALSE];
RETURN[ ( simpleCreds.rName.name.Equal[creds.rName.name, FALSE] ) AND
( simpleCreds.password.Equal[creds.password, FALSE] ) ];
};
XNSLocalNameProc: MailUtils.LocalNameProc = {
name: XNSCHName.Name;
name ¬ XNSCHName.NameFromRope[rName.name ! XNSCHName.FieldTooLong => CONTINUE];
RETURN[ name.object ];
};
XNSWhoIsLoggedInProc: MailUtils.WhoIsLoggedInProc = {
name: XNSAuth.Name ~ XNSAuth.GetIdentityDetails[XNSCredentials.GetIdentity[]].name;
RETURN[XNSCHName.RopeFromName[name]];
};
GetCredentials:
PROC [credentialsList: SendingCredentialsList]
RETURNS [credentials: MailSend.SendingCredentials] ~ {
simpleCreds: MailUtils.Credentials;
FOR cl: SendingCredentialsList ¬ credentialsList, cl.rest
WHILE cl #
NIL
DO
IF cl.first.credentials.rName.ns = $xns THEN RETURN[cl.first];
ENDLOOP;
simpleCreds ¬ XNSUserCredentialsProc[];
IF simpleCreds = NIL THEN RETURN[NIL];
credentials ¬
NEW[MailSend.SendingCredentialsRec ¬ [
credentials: simpleCreds,
authenticated: TRUE,
returnTo: simpleCreds.rName] ];
RETURN[credentials];
};
MSRNameFromMailBasicsRName:
PROC[mbRName: MailBasics.RName]
RETURNS[msRName: MSBasics.RName] = {
at least get the format correct
SELECT mbRName.ns
FROM
$xns => RETURN[MSUtils.XNSRNameFromRope[mbRName.name]];
ENDCASE => RETURN[MSUtils.XNSRNameFromRope[Rope.Concat[mbRName.name, "::"]]];
};
highXNS: MSBasics.BodyPartType = 499;
MSItemFromMailBasicsItem:
PROC[type: MailBasics.ItemType]
RETURNS[msType: MSBasics.BodyPartType] = {
SELECT type
FROM
MailBasicsItemTypes.lastItem => msType ¬ MSBasics.lastBodyPart;
MailBasicsItemTypes.tioga1 => msType ¬ MailBasicsItemTypes.fullFormatting; --special mapping
< highXNS => msType ¬ type; -- direct map
ENDCASE => msType ¬ highXNS; -- hopefully won't see these for awhile
};
MSParseNameProc: MailParse.ParseNameProc = {
PROC[uninterpreted: ROPE] RETURNS [recognized: BOOL, rName: RName]
remove trailing white space
temp: STREAM;
name: XNSCHName.Name;
ok: BOOL ¬ TRUE;
pvtDL: BOOL ¬ FALSE;
char: CHAR;
lookForSemiNext: BOOL ¬ FALSE;
i: INT ¬ uninterpreted.Length[];
ropeName: ROPE;
IF i = 0 THEN RETURN[TRUE, [$xns, NIL]];
recognized ¬ FALSE;
UNTIL i = 0
DO
SELECT uninterpreted.Fetch[i-1]
FROM
' , '\t => i ¬ i - 1;
ENDCASE => EXIT;
ENDLOOP;
IF i = 0 THEN RETURN[TRUE, [$xns, NIL]];
temp ¬ IO.ROS[];
FOR j:
INT
IN [0..i)
DO
SELECT ( char ¬ uninterpreted.Fetch[j] )
FROM
': => lookForSemiNext ¬ TRUE;
'; => {
IF lookForSemiNext THEN { pvtDL ¬ TRUE; EXIT };
temp.PutChar[char];
};
'@ => {
IF lookForSemiNext THEN temp.PutChar[':];
temp.PutChar['%];
};
ENDCASE => {
IF lookForSemiNext THEN temp.PutChar[':];
lookForSemiNext ¬ FALSE;
temp.PutChar[char];
};
ENDLOOP;
IF pvtDL THEN RETURN[TRUE, [$file, IO.RopeFromROS[temp]] ];
we do this for checking only - don't want the default domain & org
ropeName ¬ IO.RopeFromROS[temp];
name ← XNSCHName.NameFromRope[ropeName !
XNSCHName.FieldTooLong => { ok ← FALSE; CONTINUE} ];
IF NOT ok THEN RETURN;
RETURN[TRUE, [$xns, ropeName]];
};
CharIndex: TYPE = INT;
nullIndex: CharIndex =
LAST[CharIndex];
DuplicateNameRecord: TYPE = RECORD [rName: RName, seenOnSecondPass: BOOL];
DuplicateName: TYPE = REF DuplicateNameRecord;
MakeHeader: MailAnswer.AnswerProc = {
AnswerProc: TYPE ~ PROC[getChar: PROC [INT] RETURNS [CHAR], inputLength: INT,
userRName: RName, cForCopies: BOOL ← FALSE ]
RETURNS [answerError: BOOL, answer: ROPE, errorIndex: INT];
outBuffer: STREAM;
getCharIndex: CharIndex;
pH: MailParse.ParseHandle;
havePH: BOOL ¬ FALSE;
idIndex: CharIndex ¬ nullIndex;
dateIndex: CharIndex ¬ nullIndex;
subjectIndex: CharIndex ¬ nullIndex;
fromFieldErrorIndex: CharIndex ¬ nullIndex;
startOfHeaderLine: CharIndex ¬ nullIndex;
parseErrorEncountered: BOOL ¬ FALSE;
StuffRope: PROC[r: ROPE] = { outBuffer.PutRope[r] };
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: RName;
originXNSCHName: XNSCHName.Name; -- ThreePartName
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 >= inputLength THEN RETURN [MailParse.endOfInput];
char ¬ getChar[getCharIndex];
getCharIndex ¬ getCharIndex + 1;
};
InitParse: PROC = { pH ¬ MailParse.InitializeParse[]; havePH ¬ TRUE };
FinParse: PROC = { MailParse.FinalizeParse[pH]; havePH ¬ FALSE };
ProcessFields:
PROC [
Inner:
PROC [index: FieldIndex]
RETURNS[parseError:
BOOL] ]
RETURNS[errorSeen:
BOOL] = {
OPEN MailParse;
fieldName: ROPE;
getCharIndex ¬ 0;
InitParse[];
errorSeen ¬ FALSE;
DO {
startOfHeaderLine ¬ getCharIndex;
fieldName ¬
GetFieldName[pH, GetNextChar ! MailParse.ParseError => GOTO badIndex];
IF fieldName = NIL 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
'\r, '\l, MailParse.endOfInput => EXIT;
ENDCASE;
ENDLOOP;
};
ENDLOOP;
FinParse[];
}; -- of ProcessFields --
AnalyzeOrigin:
PROC [index: FieldIndex] = {
fieldBodyStartIndex: CharIndex = getCharIndex;
ProcessName:
PROC [rName: RName]
RETURNS[nameToWrite:
ROPE ¬
NIL] = {
IF ~(originIndex = sender
OR index = originIndex
OR index = reply)
THEN {
originIndex ¬ index;
originName ¬ rName;
originXNSCHName ¬ XNSCHName.NameFromRope[rName.name ! XNSCHName.FieldTooLong => CONTINUE ];
originName.name ¬ MSUtils.StrippedName[originName.name, NIL, NIL];
};
IF index < answerTarget
OR (index = from
AND answerTarget = sender)
THEN {
answerTarget ¬ index;
answerTargetBodyCharIndex ¬ fieldBodyStartIndex;
};
}; -- of ProcessName --
MailParse.NameList[pH, $xns, GetNextChar, ProcessName
! MailParse.ParseError => {
IF index = from
THEN fromFieldErrorIndex ¬ fieldBodyStartIndex
ELSE {
errorIndex ¬ fieldBodyStartIndex;
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex ← fieldBodyStartIndex (%g)\n", [integer[errorIndex]] ];
};
[] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE];
CONTINUE;
}];
}; -- of AnalyzeOrigin --
FirstPass:
PROC [index: FieldIndex]
RETURNS[parseError:
BOOL] = {
parseError ¬ FALSE;
SELECT index
FROM
id => {
idIndex ¬ getCharIndex;
[] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
IN [reply .. from] => AnalyzeOrigin[index];
IN [to .. bcc] => IF FillNameField[firstPass: TRUE] THEN parseError ¬ TRUE;
date => {
dateIndex ¬ getCharIndex;
[] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
subject => {
subjectIndex ¬ getCharIndex;
[] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
ENDCASE => [] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE];
FillField:
PROC = {
field: ROPE ¬ MailParse.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 [rName: RName, firstPass:
BOOL]
RETURNS [added:
BOOL] = {
s: ROPE ¬ rName.name;
FOR itemL:
LIST
OF DuplicateName ¬ duplicateHead, itemL.rest
UNTIL itemL =
NIL
DO
IF Rope.Equal[itemL.first.rName.name, s,
FALSE]
THEN {
IF firstPass THEN RETURN[FALSE];
added ¬ ~itemL.first.seenOnSecondPass;
itemL.first.seenOnSecondPass ¬ TRUE;
RETURN
};
ENDLOOP;
duplicateHead ¬ CONS[NEW[DuplicateNameRecord ¬
[rName: rName, seenOnSecondPass: FALSE]], duplicateHead];
RETURN[TRUE]
}; -- of AddedToDuplicateList --
ProcessAnswerTarget:
PROC = {
namesOutput: BOOL ¬ FALSE;
ProcessName:
PROC [rName: RName]
RETURNS[nameToWrite:
ROPE] = {
rName.name ¬ MSUtils.StrippedName[rName.name, originXNSCHName.domain, originXNSCHName.organization];
IF rName.name = NIL THEN RETURN;
[] ¬ AddedToDuplicateList[rName, FALSE];
IF namesOutput THEN outBuffer.PutRope[", "];
namesOutput ¬ TRUE;
RETURN[rName.name];
}; -- of ProcessName --
getCharIndex ¬ answerTargetBodyCharIndex;
InitParse[];
MailParse.NameList[pH, $xns, GetNextChar, ProcessName, StuffRope ! MailParse.ParseError => {
[] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE];
CONTINUE }];
FinParse[];
}; -- of ProcessAnswerTarget --
AnalyzeAnswerTarget:
PROC = {
ProcessName:
PROC [rName: RName]
RETURNS[nameToWrite:
ROPE ¬
NIL] = {
rName.name ¬ MSUtils.StrippedName[rName.name, originXNSCHName.domain, originXNSCHName.organization];
targetEqualsOrigin ¬ targetEqualsOrigin
AND Rope.Equal[rName.name, originName.name, FALSE];
IF ~AddedToDuplicateList[rName, TRUE] THEN ccCount ¬ ccCount - 1;
}; -- of ProcessName --
IF answerTargetBodyCharIndex = 0 THEN ERROR MailParse.ParseError[badFieldName];
getCharIndex ¬ answerTargetBodyCharIndex;
InitParse[];
MailParse.NameList[pH, $xns, GetNextChar, ProcessName, ! MailParse.ParseError => {
[] ¬ MailParse.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 [rName: RName]
RETURNS[nameToWrite:
ROPE ¬
NIL] = {
new: BOOL;
rName.name ¬ MSUtils.StrippedName[rName.name, originXNSCHName.domain, originXNSCHName.organization];
new ¬ AddedToDuplicateList[rName, firstPass];
IF NOT new THEN RETURN[NIL];
IF firstPass
THEN {
ccCount ¬ ccCount + 1;
IF ~replyerCCed AND rName.name.Equal[userRName.name, FALSE]
THEN replyerCCed ¬ TRUE;
RETURN[NIL]
};
IF rName.name = NIL THEN RETURN;
IF firstOutput THEN firstOutput ¬ FALSE;
IF namesOutput THEN outBuffer.PutRope[", "];
namesOutput ¬ TRUE;
RETURN[rName.name];
}; -- of ProcessName --
parseError ¬ FALSE;
MailParse.NameList[pH, $xns, GetNextChar, ProcessName, StuffRope !
MailParse.ParseError => {
[] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE];
parseError ¬ TRUE;
errorIndex ¬ lineIndex;
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex ← lineIndex (%g)\n", [integer[errorIndex]] ];
CONTINUE;
};
];
}; -- of FillNameField --
SecondPass:
PROC [index: FieldIndex]
RETURNS[parseError:
BOOL ¬
FALSE] = {
SELECT index
FROM
IN [to .. bcc] => [] ¬ FillNameField[firstPass: FALSE];
ENDCASE => [] ¬ MailParse.GetFieldBody[pH, GetNextChar, TRUE];
}; -- of SecondPass --
main body of AnswerImpl
answerError ¬ FALSE;
errorIndex ¬ nullIndex;
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex ← nullIndex (%g)\n", [integer[errorIndex]] ];
outBuffer ¬ IO.ROS[];
find out who it's from and where the interesting indices are
answerError ¬ ProcessFields[FirstPass ! MailParse.ParseError => GO TO BadMessage];
IF answerTargetBodyCharIndex = nullIndex
THEN {
IF havePH THEN FinParse[];
RETURN[TRUE, answer, IF ( fromFieldErrorIndex # nullIndex ) THEN fromFieldErrorIndex ELSE errorIndex];
};
AnalyzeAnswerTarget[ ! MailParse.ParseError => GO TO BadMessage];
make Subject field
outBuffer.PutRope["Subject: Re: "];
IF subjectIndex # nullIndex
THEN
{ subject:
ROPE; pos:
INT ¬ 0;
len: INT;
foundRe: BOOL ¬ FALSE;
prevRe: INT ¬ 0;
getCharIndex ¬ subjectIndex;
InitParse[];
subject ¬ MailParse.GetFieldBody[pH, GetNextChar];
FinParse[];
len ¬ subject.Length[];
DO
np: INT ¬ subject.Find["Re:", pos, FALSE];
IF np < 0 THEN EXIT;
IF ~(np = prevRe OR np = prevRe + 1) THEN EXIT; -- not at beginning
foundRe ¬ TRUE;
prevRe ¬ np;
pos ¬ np+3; -- skip over Re:
ENDLOOP;
IF foundRe
AND (pos < len)
THEN
WHILE subject.Fetch[pos] = IO.SP DO pos ¬ pos + 1; ENDLOOP;
outBuffer.PutRope[subject.Substr[pos]];
};
make In-reply-to field
outBuffer.PutRope["\rIn-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 {
orName: ROPE ¬ originName.name;
orLen: INT ¬ orName.Length[];
outBuffer.PutRope[orName];
outBuffer.PutChar[''];
IF ( orLen # 0 )
OR Ascii.Lower[orName.Fetch[orLen - 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[];
fill in target (To:) field of answer form
outBuffer.PutRope["\rTo: "];
ProcessAnswerTarget[];
fill in cc: field
outBuffer.PutRope[IF cForCopies THEN "\rc: " ELSE "\rcc: "];
IF answerTarget = reply
THEN outBuffer.PutRope[MSUtils.StrippedName[userRName.name, originXNSCHName.domain, originXNSCHName.organization]]
ELSE [] ¬ ProcessFields[SecondPass ! MailParse.ParseError => GO TO BadMessage];
empty line at end of header
outBuffer.PutChar['\r];
answer ¬ IO.RopeFromROS[outBuffer];
EXITS
BadMessage => {
IF havePH THEN FinParse[];
answerError ¬ TRUE;
IF errorIndex = nullIndex
THEN {
errorIndex ¬ startOfHeaderLine;
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex ← startOfHeaderLine (%g)\n", [integer[errorIndex]] ];
};
};
};
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex: (%g)\n", [integer[errorIndex]] ];
RETURN[answerError, answer, errorIndex]
};
Init:
PROC = {
mailSendProcs: MailSend.MailSendProcsRef ¬
NEW[MailSend.MailSendProcs ¬ [
which: $xns,
Send: SendViaXNS
]];
mailSendSidedoorProcs: MailSendSidedoor.MailSendSidedoorProcsRef ¬
NEW[MailSendSidedoor.MailSendSidedoorProcs ¬ [
which: $xns,
SendWithAbort: SendViaXNSWithAbort
]];
MailSend.RegisterMailSendProcs[mailSendProcs];
MailSendSidedoor.RegisterMailSendSidedoorProcs[mailSendSidedoorProcs];
MailParse.RegisterNameProc[$xns, MSParseNameProc];
MailAnswer.RegisterAnswerProc[$xns, MakeHeader];
MailUtils.RegisterUserCredentialsProc[$xns,
XNSUserCredentialsProc, XNSLoggedInUserProc, XNSLocalNameProc, XNSWhoIsLoggedInProc];
};