MTTreeOpsImpl:
CEDAR
PROGRAM
IMPORTS Ascii, MTMiscOps, Rope, IPConfig, IPName
EXPORTS MTTreeOps =
BEGIN OPEN P1: MTP1, MTTreeOps;
The various ROPE constants used by this program.
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] = {
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:
BOOL ←
FALSE]
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:
BOOL ←
FALSE]
RETURNS [
BOOL] = {
Temporary! Also, this is the wrong home for this.
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] = {
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 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 {
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 = 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 the old days, things were finished now.
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 {
Mumble.EDU got mashed to Mumble.EDU.ARPA
temp ← StripTail[temp, ".ARPA"];
out ← IPName.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
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 => 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.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:
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 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", 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
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", bitnetGateway];
UnRedirect[asn, "CSNET", csnetGateway];
UnRedirect[asn, "Mailnet", mailnetGateway];
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.