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.