<<>>
    <<MSSendImpl.mesa>>
        <<Copyright Ó 1988, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Doug Terry, November 11, 1988 12:23:03 pm PST>>
        <<Wes Irish, December 21, 1988 4:08:55 pm PST>>
        <<Willie-Sue, February 6, 1990 3:15:23 pm PST>>
        <<Willie-s, December 11, 1991 7:37 pm PST>>

    <<Operations for sending electronic mail messages to XNS mail servers.>>
    <<>>
    DIRECTORY
        Atom,
        AuthenticationP14V2,
        Basics,
        BasicTime,
        CHEntriesP0V0,
        CHOpsP2V3,
        Commander,
        CommanderOps,
        Convert,
        CrRPC,
        EnvelopeFormatP1517V1,
        IO,
        Process,
        MailFormatP1516V3,
        MailTransportP17V5,
        MSBasics,
        MSSend,
        MSUtils,
        RefTab,
        Rope,
        UserProfile,
        XNS,
        XNSAuth,
        XNSCH,
        XNSCHName,
        XNSCredentials,
        XNSRouter,
        XNSServerLocation,
        XNSWKS;

    MSSendImpl: CEDAR MONITOR
        IMPORTS Atom, BasicTime, Commander, CommanderOps, Convert, CrRPC, IO, Process, MailTransportP17V5, MSUtils, RefTab, Rope, 
        UserProfile, XNSAuth, XNSCHName, XNSCredentials, XNSRouter, XNSServerLocation
        EXPORTS MSSend ~ BEGIN

        OPEN 
            Authentication: AuthenticationP14V2,
            CHEntries: CHEntriesP0V0,
            EnvelopeFormat: EnvelopeFormatP1517V1,
            MailFormat: MailFormatP1516V3,
            MailTransport: MailTransportP17V5;

    STREAM: TYPE ~ IO.STREAM;
    ROPE: TYPE ~ Rope.ROPE;
    LORA: TYPE ~ LIST OF REF ANY;
    Name: TYPE ~ XNSCH.Name;
    Address: TYPE ~ XNS.Address;

    BodyPartInfo: TYPE = REF BodyPartInfoObject;
    BodyPartInfoObject: TYPE = RECORD [
        type: MSBasics.BodyPartType,
        data: ROPE Ź NIL
        ];


    mailPgmNum: CARD32 ~ 17;
    mailVersionNum: CARD16 ~ 5;

<<Handles>>
    <<MSHandles are not tied directly to sessions with a MS server since MSHandles are potentially long-lived (hours or days) whereas 
    sessions should be fairly short to avoid tying up resources on the server.  Sessions are automatically established when needed 
    and automatically released when not. >>

    Handle: TYPE ~ MSSend.Handle;  -- should always be of type MSHandle

    MSHandle: TYPE ~ REF MSHandleObject;
    MSHandleObject: TYPE ~ RECORD [
        sender: MSBasics.RName,
        password: ROPE Ź NIL,
        identity: XNSAuth.Identity Ź NIL,
        returnTo: MSBasics.RName,
        recipients: LIST OF MSBasics.RName,
        lastRecipient: LIST OF MSBasics.RName,
        bodyParts: LIST OF BodyPartInfo,
        lastBodyPart: LIST OF BodyPartInfo,
        nBodyParts: CARDINAL Ź 0,
        size: CARD Ź 0,
        posting: BOOL Ź FALSE,
        specificServer: CachedServer,
        server: CachedServer,
        sessionEstablished: BOOLEAN Ź FALSE,
        credentials: XNSAuth.Credentials,
        verifier: XNSAuth.Verifier,
        conv: XNSAuth.Conversation,
        rpcH: CrRPC.Handle,
        session: MailTransport.Session     
        ];

<<Sessions>>
    <<>>
    GetSession: PROC [msH: MSHandle, server: CachedServer] RETURNS [] ~ {
        ENABLE {
            CrRPC.Error => {
                MarkServerDown[server];
                ReportRPCError[errorReason, text];
                };
            XNSAuth.AuthenticationError => {
                ReportAuthenticationError[problem];
                };
            XNSAuth.CallError => {
                ReportAuthCallError[problem];
                };
            };
        IF msH.sessionEstablished AND msH.server = server THEN {
            msH.verifier Ź XNSAuth.GetNextVerifier[msH.conv];
            RETURN;
            };
        IF server.name = [NIL, NIL, NIL] THEN {
            UpdateWillingness[server];  -- we need the server name
            IF server.name = [NIL, NIL, NIL] THEN {
                MarkServerDown[server];
                ReportMiscError["NIL server name"];
                };
            };
        msH.rpcH Ź CrRPC.CreateClientHandle[$CMUX, server.address];
        msH.conv Ź XNSAuth.Initiate[msH.identity, server.name];
        XNSAuth.SetRecipientHostNumber[msH.conv, server.address.host];
        msH.credentials Ź XNSAuth.GetCredentials[msH.conv];
        msH.verifier Ź XNSAuth.GetNextVerifier[msH.conv];
        msH.server Ź server;
        msH.sessionEstablished Ź TRUE;
        };

    ReleaseSession: PROC [msH: MSHandle] RETURNS [] ~ {
        ENABLE CrRPC.Error => CONTINUE;
        IF NOT msH.sessionEstablished THEN RETURN;
        XNSAuth.Terminate[msH.conv];
        CrRPC.DestroyClientHandle[msH.rpcH];
        msH.sessionEstablished Ź FALSE;
        };


<<ERRORs and Reporting procedures>>
    SendFailed: PUBLIC ERROR [why: Rope.ROPE, notDelivered: BOOL] = CODE;

    Failed: PROC [reason: ATOM, text: ROPE] = {
        ERROR SendFailed[Rope.Cat[Atom.GetPName[reason], ": ", text], TRUE];
        };

    ReportRPCError: PROC [errorReason: CrRPC.ErrorReason, text: ROPE] = {
        Failed[$RPC, text];
        };

    ReportMiscError: PROC [text: ROPE] = {
        Failed[$Misc, text];
        };

    ReportAuthCallError: PROC [problem: Authentication.CallProblem] = {
        SELECT problem FROM
            tooBusy => Failed[$Authentication, "server is too busy to service this request"];
            accessRightsInsufficient => Failed[$Authentication, "operation prevented by access controls"];
            keysUnavailable => Failed[$Authentication, "the server that holds the required keys was inaccessible"];
            strongKeyDoesNotExist => Failed[$Authentication, "a strong key critical to this operation has not been registered"];
            simpleKeyDoesNotExist => Failed[$Authentication, "a simple key critical to this operation has not been registered"];
            strongKeyAlreadyRegistered => Failed[$Authentication, "cannot create a strong key for an entity which already has one"];
            simpleKeyAlreadyRegistered => Failed[$Authentication, "cannot create a simple key for an entity which already has one"];
            domainForNewKeyUnavailable => Failed[$Authentication, "cannot create a new key because the domain to hold it is inaccessible"];
            domainForNewKeyUnknown => Failed[$Authentication, "cannot create a new key because the domain to hold it is unknown"];
            badKey => Failed[$Authentication, "bad key passed to CreateStrongKey or ChangeStrongKey"];
            badName => Failed[$Authentication, "bad name passed to CreateStrongKey or ChangeStrongKey"];
            databaseFull => Failed[$Authentication, "no more data can be added to the Authentication database"];
            other => Failed[$Authentication, "some unknown Authentication call problem"];
            ENDCASE => Failed[$Authentication, IO.PutFR1["UnknownError (%g)", [integer[ORD[problem]]] ] ];
        };

    ReportAuthenticationError: PROC [problem: Authentication.Problem] = {
        SELECT problem FROM
            credentialsInvalid => Failed[$Authentication, "credentialsInvalid"];
            verifierInvalid => Failed[$Authentication, "verifierInvalid"];
            verifierExpired => Failed[$Authentication, "verifierExpired"];
            verifierReused => Failed[$Authentication, "verifierReused"];
            credentialsExpired => Failed[$Authentication, "credentialsExpired"];
            inappropriateCredentials => Failed[$Authentication, "inappropriateCredentials"];
            ENDCASE => Failed[$Authentication, IO.PutFR1["UnknownError (%g)", [integer[ORD[problem]]] ] ];
        };

    ReportInvalidRecipients: PROC [nameList: MailTransport.InvalidNameList] = {
        Failed[$InvalidRecipients, "...recipients..."];
        };

    ReportOtherError: PROC [problem: MailTransport.OtherProblem] = {
        SELECT problem FROM
            cantExpedite => Failed[$OtherError, "cantExpedite"];
            malformedMessage => Failed[$OtherError, "malformedMessage"];
            incorrectContentsSize => Failed[$OtherError, "incorrectContentsSize"];
            ENDCASE =>
            Failed[$OtherError, IO.PutFR1["UnknownError (%g)", [integer[ORD[problem]]] ] ];
        };

    ReportServiceError: PROC [problem: MailTransport.ServiceProblem] = {
        SELECT problem FROM
            cannotAuthenticate => Failed[$ServiceProblem, "cannotAuthenticate"];
            serviceFull => Failed[$ServiceProblem, "serviceFull"];
            serviceUnavailable => Failed[$ServiceProblem, "serviceUnavailable"];
            mediumFull => Failed[$ServiceProblem, "mediumFull"];
            ENDCASE => Failed[$ServiceProblem, IO.PutFR1["UnknownError (%g)", [integer[ORD[problem]]] ] ];
        };

    ReportSessionError: PROC [problem: MailTransport.SessionProblem] = {
        SELECT problem FROM
            invalidHandle => Failed[$SessionProblem, "invalidHandle"];
            wrongState => Failed[$SessionProblem, "wrongState"];
            ENDCASE => Failed[$SessionProblem, IO.PutFR1["UnknownError (%g)", [integer[ORD[problem]]] ] ];
        };

    ReportTransferError: PROC [problem: MailTransport.TransferProblem] = {
        SELECT problem FROM
            aborted => Failed[$TransferProblem, "aborted"];
            ENDCASE => Failed[$TransferProblem, IO.PutFR1["UnknownError (%g)", [integer[ORD[problem]]] ] ];
        };

<<Support procedures>>
    CountRNames: PROC [list: LIST OF MSBasics.RName] RETURNS [i: CARDINAL Ź 0] ~ {
        WHILE list # NIL DO
            i Ź i.SUCC;
            list Ź list.rest;
            ENDLOOP;
        };

    GetPostingServer: PROC [h: Handle, msgSize: CARD] RETURNS [server: CachedServer, allDown: BOOL] ~ {
        msH: MSHandle Ź NARROW[h];
        IF msH.specificServer # NIL THEN RETURN[msH.specificServer, NOT ServerIsUsableInternal[msH.specificServer]];
        server Ź GetBestServer[msgSize].bestServer;
        RETURN[server, server = NIL];
        };
<<Willingness Stuff>>
    willingnessTimeout: INT Ź 10*60;

    WillingnessMaxLength: CARDINAL = 12;
    unwilling: CARDINAL = 1;
    veryWilling: CARDINAL = 10;

    IndexForMsgSize: PROC [msgSize: CARD] RETURNS [index: CARDINAL Ź 0] ~ {
        sizeBound: CARD Ź 8;
        WHILE msgSize >= sizeBound AND index < (WillingnessMaxLength-1) DO
            index Ź index + 1;
            sizeBound Ź sizeBound * 8;
            ENDLOOP;
        };

    GetWillingnessForMsgSize: PROC [willingness: MailTransport.Willingness, msgSize: CARD] RETURNS [CARD16] ~ {
        RETURN[GetWillingnessFromIndex[willingness, IndexForMsgSize[msgSize]]];
        };

    GetWillingnessFromIndex: PROC [willingness: MailTransport.Willingness, index: CARDINAL] RETURNS [CARD16] ~ {
        length: CARDINAL;
        IF willingness = NIL THEN RETURN[1];
        length Ź willingness.length;
        IF length = 0 THEN RETURN[1];
        IF index < length
            THEN RETURN[willingness[index]]
            ELSE RETURN[willingness[length-1]];
        };

    WillingnessNeedsUpdating: PROC [server: CachedServer] RETURNS [BOOL] ~ {
        RETURN[BasicTime.Period[from: server.willingnessLastUpdated, to: BasicTime.Now[]] > willingnessTimeout];
        };

    UpdateWillingness: ENTRY PROC [server: CachedServer, onlyIfNeeded: BOOL Ź TRUE] ~ {
        UpdateWillingnessInternal[server, onlyIfNeeded];
        };

    UpdateWillingnessInternal: PROC [server: CachedServer, onlyIfNeeded: BOOL Ź TRUE] ~ {
        willingness: MailTransport.Willingness;
        addressList: CHOpsP2V3.NetworkAddressList;
        serverName: XNSCH.Name;
        rpcH: CrRPC.Handle;
        {
            ENABLE {
                CrRPC.Error => {
                    server.inactiveUntil Ź BasicTime.Update[BasicTime.Now[], secondsDown];
                    GOTO Done;
                    };
                MailTransport.ServiceError => {
                    SELECT problem FROM
                        cannotAuthenticate, serviceFull, mediumFull =>
                        server.inactiveUntil Ź BasicTime.Update[BasicTime.Now[], secondsBusy];
                        ENDCASE =>
                        server.inactiveUntil Ź BasicTime.Update[BasicTime.Now[], secondsDown];
                    GOTO Done;
                    };
                };
            IF onlyIfNeeded AND NOT WillingnessNeedsUpdating[server] THEN RETURN;
            rpcH Ź CrRPC.CreateClientHandle[$CMUX, NEW[XNS.Address Ź server.address­]];
            [willingness, addressList, serverName] Ź MailTransport.ServerPoll[rpcH];
            CrRPC.DestroyClientHandle[rpcH];
            server.name Ź serverName;
            server.willingness Ź willingness;
            server.willingnessLastUpdated Ź BasicTime.Now[];
            server.inactiveUntil Ź BasicTime.earliestGMT;
            EXITS
                Done => CrRPC.DestroyClientHandle[rpcH];
            };
        };

    hopsFactor: CARDINAL Ź 3;  -- weighs hops as hopsFactor times more important than willingness metric (1 is unity).

    FirstIsBetter: PROC [firstHops: CARDINAL, firstWillingness: CARDINAL, secondHops: CARDINAL, secondWillingness: CARDINAL] RETURNS 
    [BOOL] ~ {
        minHops: CARDINAL Ź MIN[firstHops, secondHops];
        firstNormalized: CARDINAL Ź MAX[unwilling, (firstWillingness - MIN[firstWillingness, (hopsFactor * (firstHops - minHops))])];
        secondNormalized: CARDINAL Ź MAX[unwilling, (secondWillingness - MIN[secondWillingness, (hopsFactor * (secondHops - minHops))])];
        RETURN[firstNormalized >= secondNormalized];
        };

<<Server Objects>>
    CachedServer: TYPE ~ REF CachedServerObject;
    CachedServerObject: TYPE ~ RECORD [
        address: REF XNS.Address,
        name: XNSCH.Name,
        inactiveUntil: BasicTime.GMT Ź BasicTime.earliestGMT,
        willingness: MailTransport.Willingness,
        willingnessLastUpdated: BasicTime.GMT Ź BasicTime.earliestGMT
        ];

    numHeaders: CARDINAL ~ 17;
    serversByAddress: RefTab.Ref ~ RefTab.Create[
    mod~numHeaders, equal~EqualAddressesIgnoringSocket, hash~HashAddress];

    HashAddress: RefTab.HashProc ~ {
        host: XNS.Host Ź NARROW[key, REF XNS.Address].host;
        acc: CARDINAL Ź ((((host.a*5+host.b)*5+host.c)*5+host.d)*5+host.e)*5+host.f;
        RETURN [acc] };

    EqualAddressesIgnoringSocket: RefTab.EqualProc ~ {
        ra1: REF XNS.Address Ź NARROW[key1];
        ra2: REF XNS.Address Ź NARROW[key2];
        RETURN [(ra1.net = ra2.net) AND (ra1.host = ra2.host)] };

    GetServerByAddress: PROC [ra: REF XNS.Address, makeActive: BOOL]
    RETURNS [s: CachedServer] ~ {
        <<Net and host are significant, socket is set to XNS.unknownSocket>>
        ENABLE UNWIND => NULL;
        val: RefTab.Val;
        found: BOOL;
        [found, val] Ź RefTab.Fetch[x~serversByAddress, key~ra];
        IF NOT found THEN {
            val Ź NEW[CachedServerObject Ź [address~ra]];
            [] Ź RefTab.Insert[x~serversByAddress, key~ra, val~val] };
        s Ź NARROW[val];
        IF makeActive THEN MarkServerUsable[s];
        };

    secondsBusy: INT Ź 10;
    secondsDown: INT Ź 600;
    secondsDead: INT Ź 900;

    ServerIsUsableInternal: PROC [s: CachedServer] RETURNS [usable: BOOL] ~ {
        usable Ź (BasicTime.Period[from: s.inactiveUntil, to: BasicTime.Now[]] >= 0) };
    MarkServerUsable: ENTRY PROC [s: CachedServer] ~ {
        ENABLE UNWIND => NULL;
        s.inactiveUntil Ź BasicTime.earliestGMT };
    MarkServerBusy: ENTRY PROC [s: CachedServer] ~ {
        ENABLE UNWIND => NULL;
        s.inactiveUntil Ź BasicTime.Update[BasicTime.Now[], secondsBusy] };
    MarkServerDown: ENTRY PROC [s: CachedServer] ~ {
        ENABLE UNWIND => NULL;
        s.inactiveUntil Ź BasicTime.Update[BasicTime.Now[], secondsDown]};
    MarkServerDead: ENTRY PROC [s: CachedServer] ~ {
        ENABLE UNWIND => NULL;
        s.inactiveUntil Ź BasicTime.Update[BasicTime.Now[], secondsDead]};
<<Lists of Servers>>
    CachedServerListHead: TYPE ~ REF CachedServerList;
    CachedServerList: TYPE ~ REF CachedServerListElement;
    CachedServerListElement: TYPE ~ RECORD [
        next: CachedServerList,
        server: CachedServer
        ];

    AddServerToList: ENTRY PROC [listHead: CachedServerListHead,
    server: CachedServer] RETURNS [new: BOOL] ~ {
        ENABLE UNWIND => NULL;
        new Ź AddServerToListInternal[listHead, server] };

    AddServerToListInternal: INTERNAL PROC [listHead: CachedServerListHead,
    server: CachedServer] RETURNS [new: BOOL] ~ { 
        FOR p: CachedServerList Ź listHead­, p.next WHILE p # NIL DO
            IF p.server = server THEN RETURN [FALSE];
            ENDLOOP;
        listHead­ Ź NEW[CachedServerListElement Ź [next~listHead­, server~server]];
        RETURN [TRUE] };

    DeleteServerFromListInternal: INTERNAL PROC [listHead: CachedServerListHead,
    server: CachedServer] ~ {
        p, prev: CachedServerList Ź NIL;
        IF listHead = NIL THEN RETURN;
        p Ź listHead­;
        WHILE (p # NIL) AND (p.server # server) DO prev Ź p; p Ź p.next ENDLOOP;
        IF p = NIL THEN RETURN;
        IF prev = NIL THEN listHead­ Ź p ELSE prev.next Ź p;
        };

    DeleteServerNameFromListInternal: INTERNAL PROC [listHead: CachedServerListHead,
    server: ROPE] ~ {
        p, prev: CachedServerList Ź NIL;
        IF listHead = NIL THEN RETURN;
        p Ź listHead­;
        WHILE (p # NIL) AND NOT server.Equal[p.server.name.object, FALSE] DO prev Ź p; p Ź p.next ENDLOOP;
        IF p = NIL THEN RETURN;
        IF prev = NIL THEN listHead­ Ź p.next ELSE prev.next Ź p.next;
        };

    ServerFilterProc: TYPE ~ PROC [CachedServer] RETURNS [ok: BOOL];

    GetBestServerFromList: ENTRY PROC [listHead: CachedServerListHead,
    msgSize: CARD]
    RETURNS [bestServer: CachedServer Ź NIL] ~ {
        ENABLE UNWIND => NULL;
        RETURN[GetBestServerFromListInternal[listHead, msgSize, FALSE]];
        };

    GetBestServerFromListInternal: PROC [listHead: CachedServerListHead,
    msgSize: CARD, updateWillingness: BOOL]
    RETURNS [bestServer: CachedServer Ź NIL] ~ {
        ENABLE UNWIND => NULL;
        tolerableHops: CARDINAL Ź 1;
        tolerableWillingness: CARDINAL Ź 9;
        willingness: CARDINAL;
        bestWillingness: CARDINAL Ź unwilling;
        bestHops: CARDINAL Ź LAST[CARDINAL];
        index: CARDINAL Ź IndexForMsgSize[msgSize];
        IF listHead = NIL THEN RETURN [NIL];
        FOR p: CachedServerList Ź listHead­, p.next WHILE p # NIL DO
            server: CachedServer ~ p.server;
            hops: CARDINAL;
            IF NOT ServerIsUsableInternal[server] THEN LOOP;
            IF WillingnessNeedsUpdating[server] AND NOT updateWillingness THEN LOOP;
            hops Ź XNSRouter.GetHops[server.address.net];
            IF hops >= XNSRouter.unreachable THEN LOOP;
            IF updateWillingness THEN UpdateWillingnessInternal[server];
            willingness Ź GetWillingnessFromIndex[server.willingness, index];
            IF FirstIsBetter[bestHops, bestWillingness, hops, willingness] THEN LOOP;
            bestServer Ź server;
            bestHops Ź hops;
            bestWillingness Ź willingness;
            ENDLOOP;
        IF bestServer # NIL AND bestHops <= tolerableHops AND bestWillingness >= tolerableWillingness THEN RETURN[bestServer];
        IF NOT updateWillingness THEN RETURN[GetBestServerFromListInternal[listHead, msgSize, TRUE]];
        };

<<Server location / selection>>
    <<Lifted from XNSCHPrivateImpl...>>
    <<>>
    nearbyServers: CachedServerListHead Ź NEW[CachedServerList Ź NIL];

    defaultMaxHops: CARDINAL Ź 3;
    desperationContactMaxHops: CARDINAL Ź 5;
    desperationBroadcastMaxHops: CARDINAL Ź 4;
    desperationBroadcastTryLimit: CARDINAL Ź 2;

    desperationBroadcastPauseLimit: CARDINAL Ź 2;
    desperationBroadcastPauseMsec: CARD Ź 8000;
        <<These are necessary for machines with only 3Mb Ethernets, because it can take so long for the routing and translation caches to 
        fill.  They should go away after improvements are made in the underlying transport.>>

    BroadcastForNearbyServers: PROC [
    maxHops: CARDINAL, nWanted: CARDINAL, tryLimit: CARDINAL] ~ {
        nGot: CARDINAL Ź 0;
        EachAddress: XNSServerLocation.EachAddressProc -- [addr: XNS.Address] -- ~ {
            server: CachedServer;
            ra: REF XNS.Address Ź NEW[XNS.Address Ź [net~addr.net, host~addr.host, socket~XNS.unknownSocket]];
            server Ź GetServerByAddress[ra~ra, makeActive~TRUE];
            IF AddServerToList[nearbyServers, server].new THEN nGot Ź nGot.SUCC;
            IF nGot = nWanted THEN ERROR XNSServerLocation.StopBroadcast[];
            };
        FOR i: CARDINAL Ź 0, i+1 DO
            XNSServerLocation.LocateServers[socket~XNSWKS.mailLast, remotePgm~mailPgmNum, remotePgmVersion~mailVersionNum, 
            eachAddress~EachAddress, maxHops~maxHops, tryLimit~tryLimit];
            IF (nGot > 0) OR (i >= desperationBroadcastPauseLimit) THEN EXIT;
            Process.PauseMsec[desperationBroadcastPauseMsec];
            ENDLOOP;
        };

    NoticeKnownNearbyServers: PROC[
    maxHops: CARDINAL, nWanted: CARDINAL Ź CARDINAL.LAST] ~ {
        nGot: CARDINAL Ź 0;
        EachServer: RefTab.EachPairAction
        <<[key: Key, val: Val] RETURNS [quit: BOOL]>>
            ~ {
            s: CachedServer Ź NARROW[val];
            IF XNSRouter.GetHops[s.address.net] > maxHops THEN RETURN [quit~FALSE];
            IF AddServerToList[nearbyServers, s].new THEN nGot Ź nGot.SUCC;
            RETURN [quit~(nGot=nWanted)] };
        [] Ź RefTab.Pairs[x~serversByAddress, action~EachServer];
        };

    GetBestKnownServer: PROC [maxHops: CARDINAL, msgSize: CARD]
    RETURNS [bestServer: CachedServer Ź NIL] ~ {
        EachServer: RefTab.EachPairAction
        <<[key: Key, val: Val] RETURNS [quit: BOOL]>>
            ~ {
            s: CachedServer Ź NARROW[val];
            willingness: CARDINAL;
            hops: CARDINAL;
            IF BasicTime.Period[from: BasicTime.Now[], to: s.inactiveUntil] > 0 THEN RETURN;
            hops Ź XNSRouter.GetHops[s.address.net];
            UpdateWillingness[s];
            willingness Ź GetWillingnessFromIndex[s.willingness, index];
            IF FirstIsBetter[maxHops, currentWillingness, hops, willingness] THEN RETURN;
            currentWillingness Ź willingness;
            maxHops Ź hops;
            bestServer Ź s;
            };
        index: CARDINAL Ź IndexForMsgSize[msgSize];
        currentWillingness: CARDINAL Ź unwilling;
        [] Ź RefTab.Pairs[x~serversByAddress, action~EachServer];
        };

    GetBestServer: PROC [msgSize: CARD, okToBroadcast: BOOL Ź TRUE]
    RETURNS [bestServer: CachedServer, didBroadcast: BOOL Ź FALSE] ~ {
        bestServer Ź GetBestServerFromList[nearbyServers, msgSize];
        IF bestServer = NIL THEN {
            NoticeKnownNearbyServers[maxHops~defaultMaxHops];
            bestServer Ź GetBestServerFromList[nearbyServers, msgSize] };
        IF bestServer = NIL THEN {
            bestServer Ź GetBestKnownServer[desperationContactMaxHops, msgSize] };
        IF (bestServer = NIL) AND okToBroadcast THEN {
            BroadcastForNearbyServers[maxHops~desperationBroadcastMaxHops, nWanted~3, tryLimit~desperationBroadcastTryLimit];
            didBroadcast Ź TRUE;
            bestServer Ź GetBestServerFromList[nearbyServers, msgSize] };
        };
    

<<Exported procedures>>
    defaultSpecificServer: CachedServer Ź NIL;

    Create: PUBLIC PROC RETURNS [Handle] ~ {
        msH: MSHandle Ź NEW[MSHandleObject];
        msH.sessionEstablished Ź FALSE;
        msH.specificServer Ź defaultSpecificServer;
        RETURN[msH];
        };
        <<>>
    SetPostingServer: PUBLIC PROC [handle: Handle, server: Address Ź XNS.unknownAddress] ~ {
        msH: MSHandle Ź NARROW[handle];
        server.socket Ź XNS.unknownSocket;
        IF server = XNS.unknownAddress THEN {
            msH.specificServer Ź NIL;
            RETURN;
            };
        msH.specificServer Ź GetServerByAddress[NEW[Address Ź server], TRUE];
        };

    StartSend: PUBLIC PROC [handle: Handle, senderPwd: ROPE, sender: MSBasics.RName, returnTo: MSBasics.RName Ź NIL] RETURNS [info: 
    MSSend.StartSendInfo Ź ok] ~ {
        IsLoggedInUser: PROC [sender: Name, password: ROPE] RETURNS [BOOL] ~ {
            loggedInName: Name;
            loggedInPassword: ROPE;
            [loggedInName, loggedInPassword, ] Ź XNSAuth.GetIdentityDetails[XNSCredentials.GetIdentity[]];
            RETURN[
                Rope.Equal[s1: password, s2: loggedInPassword, case: FALSE]
                AND Rope.Equal[s1: sender.object, s2: loggedInName.object, case: FALSE]
                AND Rope.Equal[s1: sender.domain, s2: loggedInName.domain, case: FALSE]
                AND Rope.Equal[s1: sender.organization, s2: loggedInName.organization, case: FALSE]
                ];
            };
        msH: MSHandle Ź NARROW[handle];
        name: Name;
        credentialsType: XNSAuth.CredentialsType Ź simple;
        allowSenderDefaulting: BOOL Ź credentialsType = strong;
        ReleaseSession[msH];  -- make sure any previous session is clossed...
        IF allowSenderDefaulting AND (sender = NIL OR IsLoggedInUser[NARROW[sender, MSBasics.CHRName].xns, senderPwd])
            THEN msH.identity Ź XNSCredentials.GetIdentity[]
            ELSE {
                IF sender = NIL
                    THEN [name, senderPwd, ] Ź XNSAuth.GetIdentityDetails[XNSCredentials.GetIdentity[]]
                    ELSE name Ź NARROW[sender, MSBasics.CHRName].xns;
                msH.identity Ź XNSAuth.MakeIdentity[name, senderPwd, credentialsType, TRUE
                    ! XNSAuth.AuthenticationError => {
                        SELECT problem FROM
                            credentialsInvalid => info Ź badPwd;
                            ENDCASE => info Ź allDown;
                        CONTINUE;
                        };
                    XNSAuth.CallError => {
                        SELECT problem FROM
                            badKey => info Ź badPwd;
                            badName => info Ź badSender;
                            ENDCASE => info Ź allDown;
                        CONTINUE;
                        };
                    ];
                };
        [name: name, password: msH.password] Ź XNSAuth.GetIdentityDetails[msH.identity];
        IF sender # NIL
            THEN msH.sender Ź sender
            ELSE msH.sender Ź MSUtils.XNSRNameFromRope[XNSCHName.RopeFromName[name]];
        msH.returnTo Ź IF returnTo # NIL THEN returnTo ELSE msH.sender;
        msH.recipients Ź NIL;
        msH.lastRecipient Ź NIL;
        msH.bodyParts Ź NIL;
        msH.lastBodyPart Ź NIL;
        msH.nBodyParts Ź 0;
        msH.size Ź 0;
        msH.posting Ź FALSE;
        IF info = ok THEN IF GetPostingServer[msH, 10].allDown THEN info Ź allDown;
        };

    AddRecipient: PUBLIC PROC [handle: Handle, recipient: MSBasics.RName] ~ {
        msH: MSHandle Ź NARROW[handle];
        IF msH.recipients = NIL
            THEN msH.lastRecipient Ź msH.recipients Ź LIST[recipient]
            ELSE msH.lastRecipient Ź msH.lastRecipient.rest Ź LIST[recipient];
        };

    StartItem: PUBLIC PROC [handle: Handle, type: MSBasics.BodyPartType] ~ {
        msH: MSHandle Ź NARROW[handle];
        bodyPartInfo: BodyPartInfo Ź NEW[BodyPartInfoObject Ź [type, NIL]];
        IF msH.bodyParts = NIL
            THEN msH.lastBodyPart Ź msH.bodyParts Ź LIST[bodyPartInfo]
            ELSE msH.lastBodyPart Ź msH.lastBodyPart.rest Ź LIST[bodyPartInfo];
        msH.nBodyParts Ź msH.nBodyParts.SUCC;
        };

    AddToItem: PUBLIC PROC [handle: Handle, buffer: ROPE] ~ {
        msH: MSHandle Ź NARROW[handle];
        msH.lastBodyPart.first.data Ź Rope.Concat[msH.lastBodyPart.first.data, buffer];
        msH.size Ź msH.size + Rope.Length[buffer];
        };

    Send: PUBLIC PROC [handle: Handle, validate, allowDLRecipients: BOOL]
    RETURNS [sent: BOOL Ź FALSE, invalidNames: MailTransport.InvalidNameList] ~ {
        server: CachedServer;
        msH: MSHandle Ź NARROW[handle];
        allDown: BOOL;
        returnOfContents: BOOL ~ UserProfile.Boolean["XNSMail.ReturnOfContents", FALSE];
        postingData: MailTransport.PostingData;
        optionalEnvelopeData: MailTransport.OptionalEnvItemSeq Ź NEW[MailTransport.OptionalEnvItemSeqObject[1]];
        thisOption: MailTransport.EnvelopeItem ~ MakeTransEnvItem[returnOfContents, FALSE];

        nRecipients: CARDINAL Ź CountRNames[msH.recipients];
        list: LIST OF MSBasics.RName;
        thisBodyPart: LIST OF BodyPartInfo;
        msgID: MailTransport.MessageID;
        {
            ENABLE {
                CrRPC.Error => {
                    ReleaseSession[msH];
                    MarkServerDown[server];
                    ReportRPCError[errorReason, text];
                    };
                MailTransport.AuthenticationError => {
                    ReleaseSession[msH];
                    ReportAuthenticationError[problem];
                    };
                MailTransport.InvalidRecipients => {
                    ReleaseSession[msH];
                    invalidNames Ź nameList;
                    GOTO Done;
                    };
                MailTransport.OtherError => {
                    ReleaseSession[msH];
                    ReportOtherError[problem];
                    };
                MailTransport.ServiceError => {
                    ReleaseSession[msH];
                    SELECT problem FROM
                        cannotAuthenticate => MarkServerBusy[server];
                        serviceFull => MarkServerBusy[server];
                        serviceUnavailable => MarkServerDown[server];
                        mediumFull => MarkServerBusy[server];
                        ENDCASE => MarkServerDown[server];
                    ReportServiceError[problem];
                    };
                MailTransport.SessionError => {
                    ReleaseSession[msH];
                    ReportSessionError[problem];
                    };
                MailTransport.TransferError => {
                    ReleaseSession[msH];
                    MarkServerBusy[server];
                    ReportTransferError[problem];
                    };
                };
            [server, allDown] Ź GetPostingServer[msH, msH.size];
            IF allDown THEN ERROR SendFailed[why: "allDown", notDelivered: TRUE];
            optionalEnvelopeData[0] Ź thisOption;
            postingData Ź [
                recipients: NEW[MailTransport.RecipientListObject[nRecipients]],
                contentsType: MSBasics.ctStandardMessage,
                contentsSize: msH.size,
                bodyPartTypesSequence: NEW[MailTransport.BPSeqObject[msH.nBodyParts]]
                ];
            list Ź msH.recipients;
            FOR i: CARDINAL IN [0..nRecipients) WHILE list # NIL DO
                thisRecipient: MailTransport.Recipient Ź [
                    name: list.first,
                    recipientID: i+1,
                    report: nonDeliveryOnly
                    ];
                postingData.recipients[i] Ź thisRecipient;
                list Ź list.rest;
                ENDLOOP;
            thisBodyPart Ź msH.bodyParts;
            FOR i: CARDINAL IN [0..msH.nBodyParts) WHILE thisBodyPart # NIL DO
                postingData.bodyPartTypesSequence[i] Ź thisBodyPart.first.type;
                thisBodyPart Ź thisBodyPart.rest;
                ENDLOOP;
            GetSession[msH, server];
            [msH.session, invalidNames] Ź MailTransport.BeginPost[
                h: msH.rpcH,
                envelopeData: postingData,
                postIfInvalidNames: NOT validate,
                allowDLRecipients: allowDLRecipients,
                optionalEnvelopeData: optionalEnvelopeData,
                credentials: msH.credentials,
                verifier: msH.verifier];
            msH.posting Ź TRUE;
            thisBodyPart Ź msH.bodyParts;
            FOR i: CARDINAL IN [0..msH.nBodyParts) WHILE thisBodyPart # NIL DO
                ProvideTheData: CrRPC.BulkDataSource ~ {
                    IO.PutRope[s, thisBodyPart.first.data];
                    RETURN[FALSE];
                    };
                GetSession[msH, server];
                MailTransport.PostOneBodyPart[msH.rpcH, msH.session, thisBodyPart.first.type, ProvideTheData];
                thisBodyPart Ź thisBodyPart.rest;
                ENDLOOP;
            GetSession[msH, server];
            msgID Ź MailTransport.EndPost[msH.rpcH, msH.session, FALSE];
            sent Ź TRUE;
            msH.posting Ź FALSE;
            ReleaseSession[msH];
            EXITS Done => RETURN;
            };
        };

    Abort: PUBLIC PROC [handle: Handle] ~ {
        ENABLE {
            MailTransport.AuthenticationError => ReportAuthenticationError[problem];
            MailTransport.InvalidRecipients => ReportInvalidRecipients[nameList];
            MailTransport.OtherError => ReportOtherError[problem];
            MailTransport.ServiceError => ReportServiceError[problem];
            MailTransport.TransferError => ReportTransferError[problem];
            };
        msH: MSHandle Ź NARROW[handle];
        IF msH.sessionEstablished AND msH.posting THEN [] Ź MailTransport.EndPost[msH.rpcH, msH.session, TRUE];
        msH.posting Ź FALSE;
        ReleaseSession[msH];
        };
<<Debugging Code>>

    NearByServers: Commander.CommandProc ~ {
        nearBy: CachedServerList Ź nearbyServers­;
        DO
            IF nearBy = NIL THEN RETURN;
            PrintOneServer[cmd.out, nearBy.server];
            nearBy Ź nearBy.next;
            ENDLOOP;
        };

    FindBestServer: Commander.CommandProc ~ {
        BestServer[cmd, TRUE];
        };

    CmdBestServer: Commander.CommandProc ~ {
        BestServer[cmd, FALSE];
        };

    FlushServerCache: ENTRY Commander.CommandProc ~ {
        nearbyServers Ź NEW[CachedServerList Ź NIL];
        };

    BestServer: PROC[cmd: Commander.Handle, okToBroadcast: BOOL] ~ {
        msgSize: INT Ź 2000;
        rp: ROPE Ź CommanderOps.NextArgument[cmd];
        IF rp # NIL THEN msgSize Ź Convert.IntFromRope[rp ! Convert.Error => CONTINUE];
        PrintOneServer[cmd.out, GetBestServer[msgSize, okToBroadcast].bestServer];
        };

    DeleteServer: ENTRY Commander.CommandProc ~ {
        server: ROPE Ź CommanderOps.NextArgument[cmd];
        IF server = NIL THEN RETURN;
        DeleteServerNameFromListInternal[nearbyServers, server];
        };

    PrintOneServer: PROC[out: STREAM, server: CachedServer] ~ {
        IF server.name.object.Length[] = 0 THEN RETURN;    -- no name
        out.PutF1["name: %g", [rope[XNSCHName.RopeFromName[server.name]]] ];
        IF server.inactiveUntil # BasicTime.earliestGMT THEN
        out.PutF1[", inactiveUntil: %g", [time[server.inactiveUntil]] ];
        out.PutF1[", willingnessLastUpdated: %g\n", [time[server.willingnessLastUpdated]] ];
        };
<<Utils>>

    MakeTransEnvItem: PROC[returnOfContents, allowAltRecipients: BOOL]
    RETURNS[envItem: MailTransport.EnvelopeItem] ~ {
        opq: MailTransport.Opaque Ź NEW[MailTransport.OpaqueObject[2]];
        opq[0] Ź IF returnOfContents THEN 1 ELSE 0;
        opq[1] Ź IF allowAltRecipients THEN 1 ELSE 0;
        envItem.type Ź EnvelopeFormat.transportOptions;
        envItem.value Ź opq;
        };
<<Mainline Code>>
    nNearbyServersToStart: CARDINAL Ź 3;


    TRUSTED { Process.Detach[FORK BroadcastForNearbyServers[maxHops~defaultMaxHops, nWanted~nNearbyServersToStart, tryLimit~0]] };

    <<Debugging>>
    Commander.Register["XNSMailNearByServers", NearByServers, "List the known nearby servers for sending xns mail"];
    Commander.Register["XNSMailFindBestServer", FindBestServer, "Usage: FindBestServer {msgSize (defaults to 2000)} - List the known 
    best server for sending xns mail"];
    Commander.Register["XNSMailBestServer", CmdBestServer, "Usage: BestServer {msgSize (defaults to 2000)} - Will broadcast if 
    necessary to find the best server for sending xns mail"];
    Commander.Register["XNSMailFlushServerCache", FlushServerCache, "Flush the list of known servers for sending xns mail"];
    Commander.Register["XNSMailDeleteServer", DeleteServer, "Usage: DeleteServer name"];


    END.