<> <> <> <> DIRECTORY Ascii USING [Digit, Letter], MTMiscOps USING [Lookup, Table], MTTreeOps, MTP1 --P1-- USING [AddrSpecNode, DomainNode, DotWordsNode, InternalNode, MailboxNode, RouteAddrNode, RouteNode, TerminalNode], Rope USING [Cat, Concat, Equal, Fetch, Find, FromChar, IsEmpty, Length, ROPE, SkipTo, Substr, Translate], IPConfig USING [bitnetGateway, uucpGateway, csnetGateway, mailnetGateway, validDomains, ourLocalName], IPName USING [NormalizeName]; MTTreeOpsImpl: CEDAR PROGRAM IMPORTS Ascii, MTMiscOps, Rope, IPConfig, IPName EXPORTS MTTreeOps = BEGIN OPEN P1: MTP1, MTTreeOps; <> arpaRegistries: MTMiscOps.Table _ LIST["ARPA", "AG", "ArpaGateway", "NotArpa"]; arpaAliases: MTMiscOps.Table _ LIST["AG", "ArpaGateway"]; arpaTopDomain: Rope.ROPE _ "ARPA"; validDomains: MTMiscOps.Table _ IPConfig.validDomains; localDomain: Rope.ROPE _ "COM"; localHostName: Rope.ROPE _ IPConfig.ourLocalName; oldLocalHostName: Rope.ROPE _ "Xerox.ARPA"; localRegistry: Rope.ROPE _ "PA"; localHostNames: MTMiscOps.Table _ LIST["Xerox", "PARC.XEROX", "PARC-MAXC"]; -- Names for the local domain. The first is the preferred one and the others are aliases. bitnetGateway: Rope.ROPE _ IPConfig.bitnetGateway; uucpGateway: Rope.ROPE _ IPConfig.uucpGateway; csnetGateway: Rope.ROPE _ IPConfig.csnetGateway; mailnetGateway: Rope.ROPE _ IPConfig.mailnetGateway; TreeToRope: PUBLIC PROC [tree: REF ANY, squeezeWhiteSpace: BOOL _ FALSE, insertDiscretionaryBlanks: BOOL _ FALSE] RETURNS [r: Rope.ROPE] = { <> <> WhiteSpaceOption: TYPE ~ {none, ifMatch, required}; Splice: PROC [leadingWhiteSpace: WhiteSpaceOption, tree: LIST OF REF ANY, spaceAfterCommas: BOOL _ FALSE] RETURNS [r: Rope.ROPE, trailingWhiteSpace: WhiteSpaceOption] = { <> 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] = { <> 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] = { <> 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] = { <> 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: BOOL _ FALSE] RETURNS [BOOL] = { <> domainRope: Rope.ROPE _ NIL; hostRope: Rope.ROPE _ NIL; 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 [MTMiscOps.Lookup[domainRope, localHostNames]]}; XeroxDomain: PUBLIC PROC RETURNS [domain: REF ANY --P1.DomainNode-- ] = { subDomain: REF P1.TerminalNode _ NEW[P1.TerminalNode _[text: localHostName]]; domain _ NEW[P1.DomainNode _ [subDomain: subDomain]]; }; DefaultDomain: PUBLIC PROC [tree: REF ANY] RETURNS [domainType: DomainType, domain: REF ANY] = { <> <> InternalDD: PROC [tree: REF ANY, mailboxNodeSeen: BOOL] RETURNS [domainType: DomainType, domain: REF ANY] = { <> 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 asn.domain # NIL AND IsLocalDomain[asn.domain] THEN { <> [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 => <> RETURN[registry, IF dwn.dotWords # NIL THEN dwn.word ELSE NIL]; in: P1.InternalNode => <> 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 => { <> 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 => { <> 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] = { <> 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] = { <> in, temp, out: Rope.ROPE; IF MTMiscOps.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 { <> RETURN[domain]; }; IF domain # NIL AND domain.domain # NIL AND domain.domain.dot # NIL AND Rope.Equal[domain.domain.dot.text, "@"] THEN { <> RETURN[domain.domain]; }; SELECT TRUE FROM domain.subDomain.text = localHostName => newDomain _ domain; MTMiscOps.Lookup[domain.subDomain.text, 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 _ TreeToRope[newDomain]; temp _ FixupTail[in, ".ARPA.ARPA"]; IF Rope.Equal[temp, oldLocalHostName, FALSE] THEN RETURN; out _ IPName.NormalizeName[temp]; IF out = NIL AND Tailed[temp, ".ARPA"] THEN { <> temp _ StripTail[temp, ".ARPA"]; out _ IPName.NormalizeName[temp]; }; IF Rope.Equal[in, out, FALSE] OR out = NIL THEN RETURN; <> newDomain _ NEW[ P1.DomainNode _ [domain: NIL, dot: NIL, subDomain: NEW[P1.TerminalNode _ [text: out]]]]; }; 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"]; }; }; 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@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 MTMiscOps.Lookup[asn.domain.subDomain.text, arpaRegistries] AND Rope.Equal[asn.domain.domain.subDomain.text, domain, FALSE] THEN { < 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; <> 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 { <> 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] = { <> 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] = { <> 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: BOOLEAN _ FALSE] 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 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] = { <> 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 => <> tree _ AddDefaultDomain[asn, defaultDomainType, defaultDomain, TRUE, FALSE]; NARROW[asn.localPart, REF P1.AddrSpecNode].domain = NIL => IF IsLocalDomain[asn.domain, TRUE] THEN <> tree _ AddDefaultDomain[NARROW[asn.localPart], defaultDomainType, defaultDomain, TRUE, TRUE] ELSE { < User%Host@relay.cs.net>> <> Redirect[asn, "BITNET", bitnetGateway]; Redirect[asn, "CSNet", csnetGateway]; Redirect[asn, "Mailnet", mailnetGateway]; Redirect[asn, "UUCP", uucpGateway]; asn.domain _ NARROW[InternalTA[asn.domain, mailboxNodeSeen]]; }; ENDCASE => IF IsLocalDomain[asn.domain, TRUE] THEN <> tree _ InternalTA[asn.localPart, mailboxNodeSeen] ELSE { <> 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 <> 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 <> ran.addrSpec _ NARROW[InternalTA[ran.addrSpec, mailboxNodeSeen]] ELSE <> ran.route _ NARROW[InternalTA[ran.route, mailboxNodeSeen]]; rn: REF P1.RouteNode => IF rn.route = NIL THEN <> 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] = { <> 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 => { <> IF defaultDomainType # registry THEN <> tree _ AddDefaultDomain[asn, defaultDomainType, defaultDomain, FALSE, FALSE]; }; NARROW[asn.localPart, REF P1.AddrSpecNode].domain = NIL => { IF IsLocalDomain[asn.domain] THEN <> tree _ AddDefaultDomain[NARROW[asn.localPart], defaultDomainType, defaultDomain, FALSE, TRUE] ELSE { UnRedirect[asn, "BITNET", bitnetGateway]; UnRedirect[asn, "CSNET", csnetGateway]; UnRedirect[asn, "Mailnet", mailnetGateway]; asn.domain _ NARROW[InternalTGV[asn.domain, mailboxNodeSeen]]; } }; IsLocalDomain[asn.domain] => <> tree _ InternalTGV[asn.localPart, mailboxNodeSeen] ENDCASE => { <> 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 <> 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 <> ran.addrSpec _ NARROW[InternalTGV[ran.addrSpec, mailboxNodeSeen]] ELSE { <> ran.route _ NARROW[InternalTGV[ran.route, mailboxNodeSeen]]; IF ran.route = NIL THEN ran.colon _ NIL; }; rn: REF P1.RouteNode => IF rn.route = NIL THEN <> 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.