ArpaMTTreeOpsImpl.mesa
Hal Murray September 18, 1985 0:42:03 am PDT
John Larson, March 13, 1988 6:08:16 pm PST
DIRECTORY
ArpaConfig USING [bitnetGateway, uucpGateway, csnetGateway, specialDomains, validDomains, ourLocalName, resolv],
ArpaMTMiscOps USING [Lookup, Table],
ArpaMTTreeOps,
ArpaMTP1 --P1-- USING [AddrSpecNode, DomainNode, DotWordsNode, InternalNode, MailboxNode, RouteAddrNode, RouteNode, TerminalNode],
ArpaName USING [AliasToName],
Ascii USING [Digit, Letter],
Rope USING [Cat, Concat, Equal, Fetch, Find, FindBackward, FromChar, IsEmpty, Length, ROPE, SkipTo, Substr, Translate];
ArpaMTTreeOpsImpl: CEDAR PROGRAM
IMPORTS ArpaConfig, ArpaMTMiscOps, ArpaName, Ascii, Rope
EXPORTS ArpaMTTreeOps =
BEGIN OPEN P1: ArpaMTP1, ArpaMTTreeOps;
ROPE: TYPE = Rope.ROPE;
The various ROPE constants used by this program.
arpaRegistries: ArpaMTMiscOps.Table ← LIST["ARPA", "AG", "ArpaGateway", "NotArpa"];
arpaAliases: ArpaMTMiscOps.Table ← LIST["AG", "ArpaGateway"];
arpaTopDomain: Rope.ROPE ← "ARPA";
localDomain: Rope.ROPE ← "COM";
oldLocalHostName: Rope.ROPE ← "Xerox.ARPA";
localRegistry: Rope.ROPE ← "PA";
localHostNames: ArpaMTMiscOps.Table ← LIST["Xerox", "PARC.XEROX", "PARC-MAXC"]; -- Names for the local domain. The first is the preferred one and the others are aliases.
TreeToRope: PUBLIC PROC [tree: REF ANY, squeezeWhiteSpace: BOOLFALSE, insertDiscretionaryBlanks: BOOLFALSE] RETURNS [r: Rope.ROPE] = {
Convert the name list tree into a rope to put back into the mail header. If squeezeWhiteSpace is TRUE, then ignore the whiteSpace in the tree and insert the appropriate amount (i.e. no blanks except after top-level commas and between words. If insertDiscretionaryBlanks is TRUE, put discretionaryBlank chars whereever a line break is legal.
When squeezing white space, the WhiteSpaceOptions for the preceding token and for this token are compared to determine whether to insert a space. This is only done in the TerminalNode arm of InternalTTR since everyone else just recurses. The spaceAfterCommas parameter can be used to force spaces after commas. It is only TRUE when pasting together the pieces of an InternalNode, which may have a list in it. The domains in a route-addr don't get spaces after their commas.
WhiteSpaceOption: TYPE ~ {none, ifMatch, required};
Splice: PROC [leadingWhiteSpace: WhiteSpaceOption, tree: LIST OF REF ANY, spaceAfterCommas: BOOLFALSE] RETURNS [r: Rope.ROPE, trailingWhiteSpace: WhiteSpaceOption] = {
Take a list of sub-trees and recursively call InternalTTR on them, keeping track of the WhiteSpaceOptions. Also implement the spaceAfterCommas option.
r2: Rope.ROPE;
r ← NIL;
WHILE tree # NIL DO
[r2, leadingWhiteSpace] ← InternalTTR[tree.first, leadingWhiteSpace];
r ← r.Cat[r2];
IF spaceAfterCommas THEN
WITH tree.first SELECT FROM
tn: REF P1.TerminalNode =>
IF tn.text.Equal[","] THEN {
leadingWhiteSpace ← required;
IF insertDiscretionaryBlanks THEN
r ← r.Cat[Rope.FromChar[discretionaryBlank]]; }
ENDCASE => NULL;
tree ← tree.rest;
ENDLOOP;
trailingWhiteSpace ← leadingWhiteSpace; };
InternalTTR: PROC [tree: REF ANY, leadingWhiteSpace: WhiteSpaceOption] RETURNS [r: Rope.ROPE, trailingWhiteSpace: WhiteSpaceOption] = {
Recursive tree walk to piece together the rope.
IF tree = NIL THEN RETURN[NIL, leadingWhiteSpace];
WITH tree SELECT FROM
asn: REF P1.AddrSpecNode =>
RETURN Splice[leadingWhiteSpace, LIST[asn.localPart, asn.atSign, asn.domain]];
dn: REF P1.DomainNode =>
RETURN Splice[leadingWhiteSpace, LIST[dn.domain, dn.dot, dn.subDomain]];
dwn: REF P1.DotWordsNode =>
RETURN Splice[leadingWhiteSpace, LIST[dwn.dotWords, dwn.dot, dwn.word]];
in: P1.InternalNode =>
RETURN Splice[leadingWhiteSpace, in, TRUE];
mbn: REF P1.MailboxNode =>
RETURN Splice[leadingWhiteSpace, LIST[mbn.phrase, mbn.address]];
ran: REF P1.RouteAddrNode =>
RETURN Splice[leadingWhiteSpace, LIST[ran.lBrack, ran.route, ran.colon, ran.addrSpec, ran.rBrack]];
rn: REF P1.RouteNode =>
RETURN Splice[leadingWhiteSpace, LIST[rn.route, rn.comma, rn.atSign, rn.domain]];
tn: REF P1.TerminalNode => {
needSpace: BOOL;
trailingWhiteSpace ← IF tn.text.IsEmpty[] THEN none ELSE IF Ascii.Letter[tn.text.Fetch[]] OR Ascii.Digit[tn.text.Fetch[]] THEN ifMatch ELSE none;
needSpace ← leadingWhiteSpace = required OR trailingWhiteSpace = required OR (leadingWhiteSpace = trailingWhiteSpace AND leadingWhiteSpace = ifMatch);
r ← Rope.Cat[IF squeezeWhiteSpace THEN (IF needSpace THEN " " ELSE NIL) ELSE tn.whiteSpace, tn.text]; };
ENDCASE => ERROR; };
r ← InternalTTR[tree, none].r; };
TreeToSimpleRope: PUBLIC PROC [tree: REF ANY] RETURNS [rope: Rope.ROPE] = {
Convert the name list tree into a rope skipping all comments.
Splice: PROC [tree: LIST OF REF ANY] RETURNS [rope: Rope.ROPE ← NIL] = {
UNTIL tree = NIL DO
rope ← Rope.Cat[rope, InternalTTR[tree.first]];
tree ← tree.rest;
ENDLOOP; };
InternalTTR: PROC [tree: REF ANY] RETURNS [rope: Rope.ROPE] = {
Recursive tree walk to piece together the rope.
IF tree = NIL THEN RETURN[NIL];
WITH tree SELECT FROM
asn: REF P1.AddrSpecNode => RETURN Splice[LIST[asn.localPart, asn.atSign, asn.domain]];
dn: REF P1.DomainNode => RETURN Splice[LIST[dn.domain, dn.dot, dn.subDomain]];
dwn: REF P1.DotWordsNode => RETURN Splice[LIST[dwn.dotWords, dwn.dot, dwn.word]];
in: P1.InternalNode => RETURN Splice[in];
mbn: REF P1.MailboxNode => RETURN Splice[LIST[mbn.phrase, mbn.address]];
ran: REF P1.RouteAddrNode =>
RETURN Splice[LIST[ran.lBrack, ran.route, ran.colon, ran.addrSpec, ran.rBrack]];
rn: REF P1.RouteNode =>
RETURN Splice[LIST[rn.route, rn.comma, rn.atSign, rn.domain]];
tn: REF P1.TerminalNode => rope ← tn.text;
ENDCASE => ERROR; };
rope ← InternalTTR[tree]; };
IsLocalDomain: PROC [domain: REF P1.DomainNode, stripOldName: BOOLFALSE] RETURNS [BOOL] = {
Temporary! Also, this is the wrong home for this.
domainRope: Rope.ROPENIL;
hostRope: Rope.ROPENIL;
IF domain.domain = NIL THEN domainRope ← TreeToRope[domain.subDomain, TRUE]
ELSE {
domainRope ← TreeToRope[domain.domain, TRUE];
hostRope ← TreeToRope[domain, TRUE]; };
IF ~stripOldName AND Rope.Equal[hostRope, oldLocalHostName, FALSE] THEN RETURN[FALSE];
RETURN [ArpaMTMiscOps.Lookup[domainRope, localHostNames]]};
XeroxDomain: PUBLIC PROC RETURNS [domain: REF ANY --P1.DomainNode-- ] = {
subDomain: REF P1.TerminalNode ← NEW[P1.TerminalNode ←[text: ArpaConfig.ourLocalName]];
domain ← NEW[P1.DomainNode ← [subDomain: subDomain]]; };
DefaultDomain: PUBLIC PROC [tree: REF ANY] RETURNS [domainType: DomainType, domain: REF ANY] = {
Given a name list tree, find the domain that should be used to default unqualified names in the header. The client is responsible for passing the name tree from the right header (From or Sender). The default domain is the domain (registry or Arpanet host) of the first qualified name in the tree. If domainType = arpaDomain, then domain points to an P1.DomainNode. If domainType = registry, then domain points to an P1.TerminalNode.
DANGER! This routine had a lot of bugs during debugging. There are probably still a few.
InternalDD: PROC [tree: REF ANY, mailboxNodeSeen: BOOL] RETURNS [domainType: DomainType, domain: REF ANY] = {
We do a recursive tree walk to find the domain. However, if we haven't encountered a MailboxNode during the descent, we only push on if we might find one further down. This prevents us from trying to extract domain information from group names and other potential garbage.
IF tree = NIL OR (~mailboxNodeSeen AND ~(ISTYPE[tree, P1.InternalNode] OR ISTYPE[tree, REF P1.MailboxNode])) THEN
RETURN[unknown, NIL];
WITH tree SELECT FROM
asn: REF P1.AddrSpecNode =>
If an Arpanet host name is present is non-local, use it. Else try to find a GV registry.
IF asn.domain # NIL AND IsLocalDomain[asn.domain] THEN {
If "@Xerox.COM" was present, then we'll force the default domain to be a GV registry, even if we have to make one up.
[domainType, domain] ← InternalDD[asn.localPart, mailboxNodeSeen];
IF domain = NIL THEN {
domainType ← registry;
domain ← NEW[P1.TerminalNode ← [text~localRegistry]]; }; }
ELSE RETURN InternalDD[IF asn.domain = NIL THEN asn.localPart ELSE asn.domain, mailboxNodeSeen];
dn: REF P1.DomainNode => RETURN[arpaDomain, dn];
dwn: REF P1.DotWordsNode =>
Only return the word part if the dotwords part is there (i.e. if this is more than just a simple word).
RETURN[registry, IF dwn.dotWords # NIL THEN dwn.word ELSE NIL];
in: P1.InternalNode =>
Use first one we find on the list.
WHILE in # NIL DO
[domainType, domain] ← InternalDD[in.first, mailboxNodeSeen];
IF domain # NIL THEN RETURN;
in ← in.rest;
ENDLOOP;
mbn: REF P1.MailboxNode => RETURN InternalDD[mbn.address, TRUE];
ran: REF P1.RouteAddrNode => {
Try for a non-local host name on the route, but if it's not there, then look in the addr-spec.
IF ran.route = NIL THEN domain ← NIL
ELSE [domainType, domain] ← InternalDD[ran.route, mailboxNodeSeen];
IF domain = NIL THEN
[domainType, domain] ← InternalDD[ran.addrSpec, mailboxNodeSeen]; };
rn: REF P1.RouteNode => {
Use first non-local name on route. If all the names are local, return NIL.
IF rn.route = NIL THEN domain ← NIL
ELSE
[domainType, domain] ← InternalDD[rn.route, mailboxNodeSeen];
IF domain = NIL AND ~IsLocalDomain[rn.domain] THEN {
domainType ← arpaDomain;
domain ← rn.domain; }; };
tn: REF P1.TerminalNode => domain ← NIL; -- "From: at Foo" (it actually happened!)
ENDCASE => ERROR; };
[domainType, domain] ← InternalDD[tree, FALSE];
IF domain = NIL THEN domainType ← unknown; };
Quote: PROC [text: Rope.ROPE] RETURNS [quotedText: Rope.ROPE] = {
Transform a string into its quoted equivalent: add quotation marks and put a backslash in front of existing quotation marks and backslashes.
length: INT ← Rope.Length[text];
i: INT ← 0;
j: INT;
quotedText ← "\"";
WHILE i < length DO
j ← text.SkipTo[pos: i, skip: "\\\""];
quotedText ← quotedText.Cat[text.Substr[i, j-i]];
IF j < length THEN {
quotedText ← quotedText.Cat[Rope.FromChar['\\], Rope.FromChar[text.Fetch[j]]];
j ← j+1; };
i ← j;
ENDLOOP;
quotedText ← quotedText.Cat["\""]; };
AddArpa: PROC [domain: REF P1.DomainNode] RETURNS [newDomain: REF P1.DomainNode] = {
Remove ".AG" or ".ArpaGateway" and add ".ARPA" to domain if not present. Destructive.
in, temp, out: Rope.ROPE;
IF ArpaMTMiscOps.Lookup[domain.subDomain.text, arpaAliases] THEN
domain.subDomain.text ← arpaTopDomain; -- xxx.ArpaGateway => xxx.Arpa
IF domain# NIL AND domain.dot # NIL AND Rope.Equal[domain.dot.text, "@"] THEN {
Redirection left us a bogus tree
RETURN[domain]; };
IF domain # NIL AND domain.domain # NIL AND domain.domain.dot # NIL AND Rope.Equal[domain.domain.dot.text, "@"] THEN {
Redirection left us a bogus tree
RETURN[domain.domain]; };
SELECT TRUE FROM
domain.subDomain.text = ArpaConfig.ourLocalName => newDomain ← domain;
ArpaMTMiscOps.Lookup[domain.subDomain.text, ArpaConfig.validDomains] =>
newDomain ← domain;
ENDCASE => -- Default to ARPA
newDomain ← NEW[P1.DomainNode ← [domain: domain, dot: NEW[P1.TerminalNode ← [text: "."]], subDomain: NEW[P1.TerminalNode ← [text: arpaTopDomain]]]];
In the old days, things were finished now.
in ← TreeToRope[newDomain];
temp ← FixupTail[in, ".ARPA.ARPA"];
IF Rope.Equal[temp, oldLocalHostName, FALSE] THEN RETURN;
out ← NormalizeName[temp];
IF Rope.Equal[in, out, FALSE] OR out = NIL THEN RETURN;
Ugh, fixup nicname. Note this builds a bogus tree because I'm too lazy to do it right. hgm
newDomain ← NEW[ P1.DomainNode ← [domain: NIL, dot: NIL, subDomain: NEW[P1.TerminalNode ← [text: out]]]]; };
NormalizeName: PROC [raw: ROPE] RETURNS [host: ROPE] =
BEGIN
IF Rope.IsEmpty[raw] THEN RETURN[NIL];
raw ← StripTail[raw, ".ARPA"]; -- fix foo.EDU.ARPA case
IF raw.Fetch[0] = '[ THEN
IF ~DotTailed[raw, "ARPA"] THEN RETURN[Rope.Cat[raw, ".ARPA"]];
IF Rope.Find[raw, ".",, FALSE] = -1 THEN raw ← Rope.Cat[raw, ".ARPA"];
IF SpecialDomain[raw] THEN RETURN[raw];
host ← ArpaName.AliasToName[raw, ArpaConfig.resolv^].name;
IF host # NIL THEN RETURN;
RETURN[raw];
END;
GetTail: PROC [rope: Rope.ROPE] RETURNS [tail: Rope.ROPE] = {
pos: INT ← Rope.FindBackward[rope, "."];
tail ← Rope.Substr[rope, pos+1, Rope.Length[rope]];
};
FixupTail: PROC [old, tail: Rope.ROPE] RETURNS [new: Rope.ROPE] = {
new ← old;
IF Tailed[old, tail] THEN {
new ← StripTail[old, tail];
new ← Rope.Concat[new, ".ARPA"]; }; };
DotTailed: PROC [body, tail: ROPE] RETURNS [match: BOOL] = {
IF ~Tailed[body, tail] THEN RETURN[FALSE];
IF Rope.Fetch[body, Rope.Length[body]-Rope.Length[tail]-1] # '. THEN RETURN[FALSE];
RETURN[TRUE]; };
SpecialDomain: PROC [raw: ROPE] RETURNS [BOOLEAN] = {
FOR list: LIST OF Rope.ROPE ← ArpaConfig.specialDomains, list.rest UNTIL list = NIL DO
domain: Rope.ROPE ← list.first;
IF DotTailed[raw, domain] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];};
Tailed: PROC [body, tail: Rope.ROPE] RETURNS [match: BOOL] = {
bodyLength: INT = body.Length[];
tailLength: INT = tail.Length[];
back: Rope.ROPE;
IF bodyLength <= tailLength THEN RETURN[FALSE];
back ← Rope.Substr[body, bodyLength-tailLength, tailLength];
IF Rope.Equal[back, tail, FALSE] THEN RETURN[TRUE];
RETURN[FALSE]; };
StripTail: PROC [body, tail: Rope.ROPE] RETURNS [new: Rope.ROPE] = {
bodyLength: INT = body.Length[];
tailLength: INT = tail.Length[];
IF ~Tailed[body, tail] THEN RETURN[body];
RETURN[Rope.Substr[body, 0, bodyLength - tailLength]]};
Redirect: PROC [asn: REF P1.AddrSpecNode, domain, relayHost: Rope.ROPE] = {
IF asn.domain = NIL THEN RETURN;
IF asn.domain.subDomain = NIL THEN RETURN;
IF asn.domain.domain = NIL THEN RETURN; -- xxx@domain
IF asn.domain.domain.subDomain = NIL THEN RETURN;
IF Rope.Equal[asn.domain.subDomain.text, domain, FALSE] THEN {
User@Host.Domain => User%Host.Domain@RelayHost
host: Rope.ROPE ← asn.domain.domain.subDomain.text;
asn.atSign.text ← "%";
asn.domain.domain.subDomain.text ← Rope.Cat[host, ".", domain];
asn.domain.dot.text ← "@";
asn.domain.subDomain.text ← relayHost;
RETURN; };
IF asn.domain.domain.domain = NIL THEN RETURN;
IF asn.domain.domain.domain.subDomain = NIL THEN RETURN;
IF ArpaMTMiscOps.Lookup[asn.domain.subDomain.text, arpaRegistries]
AND Rope.Equal[asn.domain.domain.subDomain.text, domain, FALSE] THEN {
User@Host.Domain.ARPA => User%Host.Domain@RelayHost
host: Rope.ROPE ← asn.domain.domain.domain.subDomain.text;
asn.atSign.text ← "%";
asn.domain.domain.domain.subDomain.text ← Rope.Cat[host, ".", domain];
asn.domain.domain.dot.text ← "@";
asn.domain.domain.subDomain.text ← relayHost;
RETURN; };
RETURN; };
UnRedirect: PROC [asn: REF P1.AddrSpecNode, domain, relayHost: Rope.ROPE] = {
thisHost: Rope.ROPE;
IF asn = NIL THEN RETURN;
IF asn.domain = NIL THEN RETURN;
IF asn.domain.subDomain = NIL THEN RETURN;
IF asn.domain.domain = NIL THEN RETURN;
IF asn.domain.domain.subDomain = NIL THEN RETURN;
thisHost ← TreeToRope[asn.domain];
IF ~Rope.Equal[thisHost, relayHost, FALSE] THEN RETURN;
So far, we know it's somethingOrOther@relayHost
IF asn.localPart = NIL THEN RETURN;
WITH asn.localPart SELECT FROM
lp: REF P1.AddrSpecNode => {
IF lp.localPart = NIL THEN RETURN;
WITH lp.localPart SELECT FROM
dwn: REF P1.DotWordsNode => {
perCent, pos, length: INT;
userAndHost, user, host: Rope.ROPE;
IF dwn.word = NIL THEN RETURN;
IF ~Rope.Equal[dwn.word.text, domain, FALSE] THEN RETURN;
IF dwn.dotWords = NIL THEN RETURN;
IF dwn.dotWords.word = NIL THEN RETURN;
userAndHost ← dwn.dotWords.word.text;
perCent ← Rope.Find[userAndHost, "%"];
IF perCent # -1 THEN {
Now, we know it's user%foo@relayHost, check for multiple %'s
DO
pos ← Rope.Find[userAndHost, "%", perCent+1];
IF pos = -1 THEN EXIT;
perCent ← pos;
ENDLOOP;
length ← Rope.Length[userAndHost];
host ← Rope.Substr[userAndHost, perCent+1, length-perCent-1];
user ← Rope.Substr[userAndHost, 0, perCent];
asn.domain.subDomain.text ← domain;
asn.domain.domain.subDomain.text ← host;
asn.domain.domain.dot ← NIL;
IF asn.domain.domain # NIL THEN asn.domain.domain.domain ← NIL;
dwn.dotWords.word.text ← user;
asn.localPart ← dwn.dotWords; }; };
ENDCASE => RETURN; };
ENDCASE => RETURN;
RETURN; };
AddDefaultRegistry: PROC [dotWords: REF P1.DotWordsNode, defaultDomain: REF P1.TerminalNode] RETURNS [newDotWords: REF P1.DotWordsNode] = {
Adds default registry to dot-words if necessary.
RETURN [NEW[P1.DotWordsNode ← [dotWords: dotWords, dot: NEW[P1.TerminalNode ← [text: "."]], word: IF defaultDomain # NIL THEN defaultDomain ELSE NEW[P1.TerminalNode ← [text: localRegistry]]]]]; };
AddDefaultDomain: PROC [addrSpec: REF P1.AddrSpecNode, defaultDomainType: DomainType, defaultDomain: REF ANY, addXerox: BOOL, onlyRegistryDefault: BOOL] RETURNS [newAddrSpec: REF P1.AddrSpecNode] = {
Add default domain information to addrSpec, which is passed in with no domain. Returned addr-spec may have registry and certainly will have Arpanet domain. If addXerox is true, then @Xerox.COM will be added if a registry is added. If onlyRegistryDefault is true, then the default added must be a registry. Destructive.
localPart: REF P1.DotWordsNode ← NARROW[addrSpec.localPart];
IF defaultDomainType = registry OR defaultDomainType = unknown OR onlyRegistryDefault THEN {
addrSpec.localPart ← localPart ← MaybeUnFixQuotes[localPart];
IF localPart.dotWords = NIL THEN
addrSpec.localPart ← AddDefaultRegistry[localPart, IF defaultDomainType = registry THEN NARROW[defaultDomain] ELSE NIL];
IF addXerox THEN
addrSpec ← AddDomain[addrSpec, NEW[P1.DomainNode ← [subDomain: NEW[P1.TerminalNode ← [text: localHostNames.first]]]], TRUE]; }
ELSE addrSpec ← AddDomain[addrSpec, NARROW[defaultDomain]];
RETURN[addrSpec]; };
AddDomain: PROC [addrSpec: REF P1.AddrSpecNode, domain: REF P1.DomainNode, addXerox: BOOLEANFALSE] RETURNS [newAddrSpec: REF P1.AddrSpecNode] = {
localPart: REF P1.DotWordsNode ← NARROW[addrSpec.localPart];
addrSpec.localPart ← MaybeFixQuotes[localPart];
newAddrSpec ← NEW[P1.AddrSpecNode ← [localPart: addrSpec]];
newAddrSpec.atSign ← NEW[P1.TerminalNode ← [text: "@"]];
IF ~addXerox THEN newAddrSpec.domain ← AddArpa[domain]
ELSE newAddrSpec.domain ← NARROW[XeroxDomain[]];
};
MaybeFixQuotes: PROC [localPart: REF P1.DotWordsNode] RETURNS [newLocalpart: REF P1.DotWordsNode] = {
"Joe Smith".OSBUNorth => "Joe←Smith.OSBUNorth"
dotWords: REF P1.DotWordsNode ← NARROW[localPart.dotWords];
newLocalpart ← localPart;
IF dotWords = NIL THEN RETURN; -- User
IF dotWords.word = NIL THEN RETURN;
IF dotWords.word.text = NIL THEN RETURN;
IF dotWords.dotWords # NIL THEN RETURN; -- A.B.C
IF Rope.Fetch[dotWords.word.text, 0] # '" THEN RETURN; -- User.PA (no Quotes)
IF localPart.word.whiteSpace # NIL THEN RETURN;
IF localPart.dot.whiteSpace # NIL THEN RETURN;
IF ~Rope.Equal[localPart.dot.text, "."] THEN RETURN;
dotWords.word.text ← Rope.Cat[
Rope.Substr[dotWords.word.text, 0, Rope.Length[dotWords.word.text]-1],
".", localPart.word.text, "\""];
dotWords.word.text ← FixupSpaces[dotWords.word.text]; -- Change spaces to underscores
RETURN[dotWords]; };
FixupSpaces: PROC [raw: Rope.ROPE] RETURNS [user: Rope.ROPE] =
BEGIN
length: INT ← raw.Length[];
user ← raw;
FOR i: INT IN [0..length) DO
IF raw.Fetch[i] = ' THEN EXIT;
REPEAT FINISHED => RETURN;
ENDLOOP;
user ← Rope.Translate[base: user, translator: SpaceToUnderbar];
END;
FixupUnderbars: PROC [raw: Rope.ROPE] RETURNS [user: Rope.ROPE] =
BEGIN
length: INT ← raw.Length[];
user ← raw;
FOR i: INT IN [0..length) DO
IF raw.Fetch[i] = '← THEN EXIT;
REPEAT FINISHED => RETURN;
ENDLOOP;
user ← Rope.Translate[base: user, translator: UnderbarToSpace];
END;
SpaceToUnderbar: PROC [old: CHAR] RETURNS [new: CHAR] =
BEGIN
IF old = ' THEN RETURN['←] ELSE RETURN[old];
END;
UnderbarToSpace: PROC [old: CHAR] RETURNS [new: CHAR] =
BEGIN
IF old = '← THEN RETURN[' ] ELSE RETURN[old];
END;
MaybeUnFixQuotes: PROC [localPart: REF P1.DotWordsNode] RETURNS [newLocalpart: REF P1.DotWordsNode] = {
Joe←Smith.OSBUNorth => "Joe Smith".OSBUNorth
Joe𡤌.←Smith.OSBUNorth => "Joe C. Smith".OSBUNorth
"Joe C. Smith.OSBUNorth" => "Joe C. Smith".OSBUNorth
name: Rope.ROPE ← TreeToRope[localPart, TRUE];
whiteSpace: Rope.ROPE ← NIL;
hasQuotes: BOOL ← Rope.Fetch[name, 0] = '";
newLocalpart ← localPart;
IF localPart = NIL THEN RETURN;
IF localPart.word = NIL THEN RETURN;
IF localPart.dotWords = NIL THEN
IF ~hasQuotes THEN RETURN
ELSE {
FOR i: INT DECREASING IN [0..Rope.Length[name]) DO
IF Rope.Fetch[name, i] = '. THEN {
spaces: BOOL ← Rope.Find[name, " "] # -1 OR Rope.Find[name, "←"] # -1;
IF spaces THEN
localPart.dotWords ← NEW[P1.DotWordsNode ← [word: NEW[P1.TerminalNode ← [text: Rope.Substr[name, 0, i]]]]]
ELSE
localPart.dotWords ← NEW[P1.DotWordsNode ← [word: NEW[P1.TerminalNode ← [text: Rope.Substr[name, 1, i-1]]]]];
localPart.dotWords.word.text ← FixupUnderbars[localPart.dotWords.word.text];
IF spaces THEN localPart.dotWords.word.text ← Rope.Cat[localPart.dotWords.word.text, "\""];
localPart.dotWords.word.whiteSpace ← localPart.word.whiteSpace;
localPart.dot ← NEW[P1.TerminalNode ← [text: "."]];
localPart.word.whiteSpace ← NIL;
localPart.word.text ← Rope.Substr[name, i+1, Rope.Length[name]-i-2];
EXIT; };
ENDLOOP;
RETURN;
};
IF localPart.dotWords.word = NIL THEN RETURN;
IF Rope.Find[name, "←"] # -1 THEN {

SELECT TRUE FROM
localPart.word.whiteSpace # NIL => whiteSpace ← localPart.word.whiteSpace;
localPart.dotWords.word.whiteSpace # NIL => whiteSpace ← localPart.dotWords.word.whiteSpace;
localPart.dotWords.dotWords = NIL => {};
localPart.dotWords.dotWords.word = NIL => {};
localPart.dotWords.dotWords.word.whiteSpace # NIL => whiteSpace ← localPart.dotWords.dotWords.word.whiteSpace;
ENDCASE;
FOR i: INT DECREASING IN [0..Rope.Length[name]) DO
IF Rope.Fetch[name, i] = '. THEN {
localPart.dotWords ← NEW[P1.DotWordsNode ← [word: NEW[P1.TerminalNode ← [text: Rope.Substr[name, 0, i]]]]];
localPart.dotWords.word.text ← Rope.Cat["\"", localPart.dotWords.word.text, "\""];
localPart.dotWords.word.text ← FixupUnderbars[localPart.dotWords.word.text];
localPart.dotWords.word.whiteSpace ← whiteSpace;
localPart.dot ← NEW[P1.TerminalNode ← [text: "."]];
localPart.word.whiteSpace ← NIL;
localPart.word.text ← Rope.Substr[name, i+1, Rope.Length[name]-i-1];
EXIT; };
ENDLOOP;};
};

ToArpa: PUBLIC PROC [tree: REF ANY, defaultDomainType: DomainType, defaultDomain: REF ANY] RETURNS [newTree: REF ANY] = {
Given a name tree, return the tree modified to allow it to be sent on to the Arpanet. This is a destructive operation. The default domain passed in is added to unqualified names and @Xerox.COM is added to Grapevine names.
InternalTA: PROC [tree: REF ANY, mailboxNodeSeen: BOOL] RETURNS [newTree: REF ANY] = {
IF tree = NIL OR (~mailboxNodeSeen AND ~(ISTYPE[tree, P1.InternalNode] OR ISTYPE[tree, REF P1.MailboxNode])) THEN RETURN[tree];
WITH tree SELECT FROM
asn: REF P1.AddrSpecNode =>
SELECT TRUE FROM
asn.domain = NIL =>
Need to qualify.
tree ← AddDefaultDomain[asn, defaultDomainType, defaultDomain, TRUE, FALSE];
NARROW[asn.localPart, REF P1.AddrSpecNode].domain = NIL =>
IF IsLocalDomain[asn.domain, TRUE] THEN
We have a name of the form rname@Xerox. We want to default the rname and leave the Xerox. We zap the domain field since AddDefaultDomain likes things that way.
tree ← AddDefaultDomain[NARROW[asn.localPart], defaultDomainType, defaultDomain, TRUE, TRUE]
ELSE {
Hackery for User@Host.CSNet => User%Host@relay.cs.net
Beware: There is similar code in SMTPSyntaxImpl
Redirect[asn, "BITNET", ArpaConfig.bitnetGateway];
Redirect[asn, "CSNet", ArpaConfig.csnetGateway];
Redirect[asn, "UUCP", ArpaConfig.uucpGateway];
asn.domain ← NARROW[InternalTA[asn.domain, mailboxNodeSeen]]; };
ENDCASE =>
IF IsLocalDomain[asn.domain, TRUE] THEN
We have multiple at signs and the last host is Xerox. Strip it off and process the rest of the address normally.
tree ← InternalTA[asn.localPart, mailboxNodeSeen]
ELSE {
We have multiple at signs with non-Xerox last host. Quote leading part and splice the leading white space from it onto the new node.
asn2: REF P1.AddrSpecNode ← NARROW[asn.localPart];
dwn: REF P1.DotWordsNode;
WHILE asn2.domain # NIL DO -- Find the simple localPart.
asn2 ← NARROW[asn2.localPart];
ENDLOOP;
dwn ← NARROW[asn2.localPart];
WHILE dwn.dotWords # NIL DO -- Find the first word in it.
dwn ← dwn.dotWords;
ENDLOOP;
asn.localPart ← NEW[P1.AddrSpecNode ← [localPart~NEW[P1.DotWordsNode ← [word~NEW[P1.TerminalNode ← [whiteSpace~dwn.word.whiteSpace, text~Quote[TreeToRope[asn.localPart, TRUE]]]]]]]];
asn.domain ← NARROW[InternalTA[asn.domain, mailboxNodeSeen]]; };
dn: REF P1.DomainNode => tree ← AddArpa[dn];
dwn: REF P1.DotWordsNode => NULL;
in: P1.InternalNode =>
IF mailboxNodeSeen THEN
Must have DL with @foo.dl syntax.
tree ← LIST[NEW[P1.TerminalNode ← [text~Quote[TreeToRope[in, TRUE]]]]]
ELSE
WHILE in # NIL DO
in.first ← InternalTA[in.first, mailboxNodeSeen];
in ← in.rest;
ENDLOOP;
mbn: REF P1.MailboxNode =>
mbn.address ← InternalTA[mbn.address, TRUE];
ran: REF P1.RouteAddrNode =>
IF ran.route = NIL THEN
There's an ordinary addr-spec in there to handle.
ran.addrSpec ← NARROW[InternalTA[ran.addrSpec, mailboxNodeSeen]]
ELSE
Fix the first host in the route.
ran.route ← NARROW[InternalTA[ran.route, mailboxNodeSeen]];
rn: REF P1.RouteNode =>
IF rn.route = NIL THEN
End of the line.
rn.domain ← NARROW[InternalTA[rn.domain, mailboxNodeSeen]]
ELSE
rn.route ← NARROW[InternalTA[rn.route, mailboxNodeSeen]];
tn: REF P1.TerminalNode => NULL;
ENDCASE => ERROR;
RETURN[tree]; };
RETURN InternalTA[tree, FALSE]; };
ToGrapevine: PUBLIC PROC [tree: REF ANY, defaultDomainType: DomainType, defaultDomain: REF ANY] RETURNS [newTree: REF ANY] = {
Given a name tree, return the tree modified to allow it to be sent to the Grapevine. This is a destructive operation. @Xerox.COM is removed from Grapevine names.
InternalTGV: PROC [tree: REF ANY, mailboxNodeSeen: BOOL] RETURNS [newTree: REF ANY] = {
IF tree = NIL OR (~mailboxNodeSeen AND ~(ISTYPE[tree, P1.InternalNode] OR ISTYPE[tree, REF P1.MailboxNode])) THEN RETURN[tree];
WITH tree SELECT FROM
asn: REF P1.AddrSpecNode =>
SELECT TRUE FROM
asn.domain = NIL => {
Need to qualify.
IF defaultDomainType # registry THEN
Why add .PA to (bogus) names that don't have a @Host
tree ← AddDefaultDomain[asn, defaultDomainType, defaultDomain, FALSE, FALSE]; };
NARROW[asn.localPart, REF P1.AddrSpecNode].domain = NIL => {
IF IsLocalDomain[asn.domain] THEN
We have a name of the form foo@Xerox.COM and we want to default the foo and remove the Xerox.COM.
tree ← AddDefaultDomain[NARROW[asn.localPart], defaultDomainType, defaultDomain, FALSE, TRUE]
ELSE {
UnRedirect[asn, "BITNET", ArpaConfig.bitnetGateway];
UnRedirect[asn, "CSNET", ArpaConfig.csnetGateway];
asn.domain ← NARROW[InternalTGV[asn.domain, mailboxNodeSeen]]; } };
IsLocalDomain[asn.domain] =>
We have multiple at signs and the last host is Xerox. Strip it off and process the rest of the address normally.
tree ← InternalTGV[asn.localPart, mailboxNodeSeen]
ENDCASE => {
We have multiple at signs with non-Xerox last host. Quote leading part and splice the leading white space from it onto the new node.
asn2: REF P1.AddrSpecNode ← NARROW[asn.localPart];
dwn: REF P1.DotWordsNode;
WHILE asn2.domain # NIL DO -- Find the simple localPart.
asn2 ← NARROW[asn2.localPart];
ENDLOOP;
dwn ← NARROW[asn2.localPart];
WHILE dwn.dotWords # NIL DO -- Find the first word in it.
dwn ← dwn.dotWords;
ENDLOOP;
asn.localPart ← NEW[P1.AddrSpecNode ← [localPart~NEW[P1.DotWordsNode ← [word~NEW[P1.TerminalNode ← [whiteSpace~dwn.word.whiteSpace, text~Quote[TreeToRope[asn.localPart, TRUE]]]]]]]];
asn.domain ← NARROW[InternalTGV[asn.domain, mailboxNodeSeen]];
};
dn: REF P1.DomainNode => IF dn # NIL THEN tree ← AddArpa[dn];
dwn: REF P1.DotWordsNode => NULL;
in: P1.InternalNode =>
IF mailboxNodeSeen THEN
Must have DL with @foo.dl syntax.
tree ← LIST[NEW[P1.TerminalNode ← [text~Quote[TreeToRope[in, TRUE]]]]]
ELSE
WHILE in # NIL DO
in.first ← InternalTGV[in.first, mailboxNodeSeen];
in ← in.rest;
ENDLOOP;
mbn: REF P1.MailboxNode =>
mbn.address ← InternalTGV[mbn.address, TRUE];
ran: REF P1.RouteAddrNode =>
IF ran.route = NIL THEN
There's an ordinary addr-spec in there to handle.
ran.addrSpec ← NARROW[InternalTGV[ran.addrSpec, mailboxNodeSeen]]
ELSE {
Fix the first host in the route.
ran.route ← NARROW[InternalTGV[ran.route, mailboxNodeSeen]];
IF ran.route = NIL THEN ran.colon ← NIL; };
rn: REF P1.RouteNode =>
IF rn.route = NIL THEN
End of the line.
IF rn.domain = NIL OR IsLocalDomain[rn.domain] THEN tree ← NIL
ELSE
rn.domain ← NARROW[InternalTGV[rn.domain, mailboxNodeSeen]]
ELSE {
rn.route ← NARROW[InternalTGV[rn.route, mailboxNodeSeen]];
IF rn.route = NIL THEN rn.comma ← NIL; };
tn: REF P1.TerminalNode => NULL;
ENDCASE => ERROR;
RETURN[tree]; };
RETURN InternalTGV[tree, FALSE]; };
END.