
DIRECTORY
Ascii,
AuthenticationP14V2,
Basics,
CHEntriesP0V0,
IO,
MailFormatP1516V3,
MailTransportP17V5,
MailAnswer,
MailBasics,
MailBasicsItemTypes,
MailParse,
MailSend,
MailSendSidedoor,
MSBasics,
MailUtils,
MSSend,
MSUtils,
Rope,
RuntimeError USING [BoundsFault],
SerializedFiling,
XNSAuth,
XNSCH,
XNSCHName,
XNSCredentials,
XNSWKS;

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;
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;
};
};

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;
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];
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] = {
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 = {
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]] ];
ropeName Ź IO.RopeFromROS[temp];

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 = {
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;
};
[] Ź 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];
}; -- of FirstPass --


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;
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 --


answerError Ź FALSE;
errorIndex Ź nullIndex;
outBuffer Ź IO.ROS[];

{

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];

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]];
};

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[];

outBuffer.PutRope["\rTo: "];
ProcessAnswerTarget[];

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];

outBuffer.PutChar['\r];
answer Ź IO.RopeFromROS[outBuffer];

EXITS
BadMessage => {
IF havePH THEN FinParse[];
answerError Ź TRUE;
IF errorIndex = nullIndex THEN {
errorIndex Ź startOfHeaderLine;
};
};
};

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];
};

Init[];

END.


  V  
MSMailSendImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.
Doug Terry, November 11, 1988 12:23:03 pm PST
Wes Irish, January 26, 1989 6:31:17 pm PST
Willie-Sue, July 9, 1990 2:56:02 pm PDT
Willie-Sue Orr,  July 9, 1990 2:58:24 pm PDT -0100 -0100
Willie-s, December 10, 1991 7:56 pm PST
Buffers MailSend calls building a message until Send is called.  Once Send is called the message now residing in the handle is sent using the appropriate transport (as explicitly specified by the user or determined by this module if not explicitly specified by the user).

SimpleFeedback,
Registered procedures

create the encoded header
look at user data, which is their file service (dl's won't have this)
don't use distinquished name - it might be in a different domain/org from the login name
MUST used distinguished name so retrieving works!!!

at least get the format correct
PROC[uninterpreted: ROPE] RETURNS [recognized: BOOL, rName: RName]
remove trailing white space
we do this for checking only - don't want the default domain & org
name _ XNSCHName.NameFromRope[ropeName !
XNSCHName.FieldTooLong => { ok _ FALSE; CONTINUE} ];
IF NOT ok THEN RETURN;
AnswerProc: TYPE ~ PROC[getChar: PROC [INT] RETURNS [CHAR], inputLength: INT,
userRName: RName, cForCopies: BOOL _ FALSE ]
RETURNS [answerError: BOOL, answer: ROPE, errorIndex: INT];

SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex _ fieldBodyStartIndex (%g)\n", [integer[errorIndex]] ];
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex _ lineIndex (%g)\n", [integer[errorIndex]] ];
main body of AnswerImpl
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex _ nullIndex (%g)\n", [integer[errorIndex]] ];
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
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex _ startOfHeaderLine (%g)\n", [integer[errorIndex]] ];
SimpleFeedback.PutF[$xnsmail, $oneLiner, $debug, "errorIndex: (%g)\n", [integer[errorIndex]] ];
Ę1  (cedarcode) styleNewlineDelimiter
 codeĎbK
ĎeCNK*Ďk-K**K'K8K'K KK 		KKKKKKKKKKK
K	KK	K
KKKK!KKKKK

KKK ŃblnKąK KĎn	KĄ
ĄAK KKK'KK'K#?K+K K$K	.K8Ďc
BK K"headĐbn
1KĄ%GKc}KK ŁD,K6fKK))K$$KK*5KKĄKKKK K2K$YK4)MK$K9KKKHK9KK4K
6KU^K,4KlKKK :BK3KK%$LK1IK4KK˘0EK+K=K-K&KKK:YK3KK%$LK	$K
	01ŚK4KK˘0EK+K=	KAKVK?KUKKK-K&KKKK KK-K$$KK##K&&XKXlKKGKGK>KK
:VKK K4KKStartOfExpansionf[handle: GVSend.Handle, senderPwd: ROPE, sender: ROPE, returnTo: ROPE _ NIL, validate: BOOL]áK"'K
2K8K<K4K:	QKDK%%KK K3K!K>K**KK7K''KK K3K˘˘CK((GK˘3KK	K D1KI\KKIKKK ĄOKKK
KK	4KK ĄKK51KKKESoK!K	K	K˘4K	˘DK	˘>KKKK Ą#9KKAK
#K-K
#K[name: CHNameP2V0.Name]=HKK Ą	UKKK>K
˘AXK33K	"0K	˘AK$K+1KK Ą 3K>K
(K3-~KK Ą-KKEOKKK Ą!5KSK%KK Ł+/uK#7KK&>KK[name: CHNameP2V0.Name]'K
&#4KKKKKK Ą`KK)7K<MKK %%K Ą#dK?KK˘\K˘*K˘'EKK Ą,KBKKKKKKKK K
K
	(K$KKKK
	(K#-KK/KKK)KKK)KKKKK

;KBK KJ]KK KKK K'K K"JK. K Ą
%
 zK
;K KKKKKK!K$K+K)K$KĄ	4K K:˘R&KDK˘"6K&K KK!˘1K!˘"C1K  K KKK	K%K Ą*KBKK KK KĄ	0FK KĄ+AK ĄĄ~KKKKK!K7FK" /K
"KK'<KK"'KKKKKK˘K Ą+K.
ĄEIKKKP[K8BKJKK0KK˘K 55*>K!KttKK-3K		KK˘K Ą	AKKK-2KK)+K
K		KK-2KKK-2KK1>˘K K Ą	K+6˘+HKEKK˘K 
Ą	TK+	Q'6K K&K$KKKK8hKK˘ K ĄKĄ?KdK K!(K,KKK˘K K)K\\K-3KKK˘K Ą
ĄEKdK()[KAK˘K K$OK)KRRK.4KKKK˘K 
ĄCKK
ĄEK
KdK-K
KK
"TKKK K(K,KKK˘K KBBK-3KKKjjK	KKK˘K 
Ą
JK.7K1>K˘K KK KKKjjKK K K<<K@R'/KK

%fKK/AK KK# K	K	KKKK2KKK*KK	˘EK
KK˘K	K
;K'KK KK%K3K9KK KKKK*=KKK"KK)FKKKKKKKK K))KKK KK
=nK9OK KKK	#K KK KKrrKKKK K__K!'KK Ą*KKŁKK B+.KKŁ"KK K..KFFK22K00KKK K KK K K      V   y  