<<>>
    <<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).>>
    <<>>
    DIRECTORY
        Ascii,
        AuthenticationP14V2,
        Basics,
        CHEntriesP0V0,
        IO,
        MailFormatP1516V3,
        MailTransportP17V5,
        MailAnswer,
        MailBasics,
        MailBasicsItemTypes,
        MailParse,
        MailSend,
        MailSendSidedoor,
        MSBasics,
        MailUtils,
        MSSend,
        MSUtils,
        Rope,
        RuntimeError USING [BoundsFault],
        SerializedFiling,
        <<SimpleFeedback,>>
        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;
<<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];
            }; -- 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;
                    <<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];
        };

    Init[];

    END.