<> <> <> <> <> <> <> DIRECTORY Basics USING [bytesPerWord], GVBasics USING [ItemHeader, RopeFromTimestamp, Timestamp], GVProtocol USING [Failed, ReceiveCount, ReceiveItemHeader, ReceiveRName, ReceiveTimestamp], IO USING [EndOfStream, GetBlock, GetIndex, PutBlock, PutChar, PutF, PutRope, SetIndex, STREAM], IPConfig USING [bitnetGateway, uucpGateway, csnetGateway, mailnetGateway, validDomains], RefText USING [AppendChar, ObtainScratch, ReleaseScratch], Rope USING [Cat, Concat, Equal, Fetch, Find, FromChar, FromRefText, IsEmpty, Length, ROPE, Substr, Translate], IPName USING [LoadCacheFromName, NormalizeName], SMTPControl USING [defaultRegistry, xeroxDomain], SMTPSupport USING [CreateSubrangeStream, Log], SMTPSyntax USING [GVItemProc]; SMTPSyntaxImpl: CEDAR PROGRAM IMPORTS GVBasics, GVProtocol, IO, RefText, Rope, IPConfig, IPName, SMTPControl, SMTPSupport EXPORTS SMTPSyntax = BEGIN STREAM: TYPE = IO.STREAM; ROPE: TYPE = Rope.ROPE; bitnetGateway: Rope.ROPE _ IPConfig.bitnetGateway; uucpGateway: Rope.ROPE _ IPConfig.uucpGateway; csnetGateway: Rope.ROPE _ IPConfig.csnetGateway; mailnetGateway: Rope.ROPE _ IPConfig.mailnetGateway; EnumerateGVItems: PUBLIC PROC [GVStream: STREAM, proc: SMTPSyntax.GVItemProc, procData: REF ANY _ NIL] = { nextItemIndex: INT; continue: BOOL; itemHeader: GVBasics.ItemHeader; DO itemHeader _ GVProtocol.ReceiveItemHeader[GVStream]; nextItemIndex _ GVStream.GetIndex[] + (itemHeader.length+ bpw-1)/bpw*bpw --word boundary--; continue _ proc[itemHeader, GVStream, procData]; IF (itemHeader.type = LastItem) OR (NOT continue) THEN EXIT; GVStream.SetIndex[nextItemIndex]; ENDLOOP; }; bpw: INT = Basics.bytesPerWord; ReceiveRName: PUBLIC PROC[GVStream: STREAM] RETURNS [ROPE] = { ENABLE GVProtocol.Failed => IF why = protocolError THEN ERROR SyntaxError[Rope.Concat["failed to read RName: ", text]]; RETURN[GVProtocol.ReceiveRName[GVStream]]; }; ReceiveCount: PUBLIC PROC[GVStream: STREAM] RETURNS [CARDINAL] = { ENABLE GVProtocol.Failed => IF why = protocolError THEN ERROR SyntaxError[Rope.Concat["failed to read count: ", text]]; RETURN[LOOPHOLE[GVProtocol.ReceiveCount[GVStream]]]; }; SyntaxError: PUBLIC ERROR [reason: ROPE] ~ CODE; PrintGVItem: PUBLIC SMTPSyntax.GVItemProc = { out: STREAM ~ NARROW[procData]; BEGIN ENABLE { IO.EndOfStream => {out.PutRope["<<>>\n"]; GOTO Return}; SyntaxError => { out.PutRope["<<>>\n"]; GOTO Return; }; }; PutHeader: PROC [type: ROPE, raw: BOOL] = TRUSTED { out.PutF["----- %g (%bB), %g bytes", [rope[type]], [integer[LOOPHOLE[itemHeader.type, CARDINAL]]], [integer[itemHeader.length]] ]; out.PutRope[IF raw THEN " (raw format) -----\n" ELSE " -----\n"]; IF itemHeader.length <= 0 THEN ERROR SyntaxError["length <= 0"]; }; PutRaw: PROC [] = { -- somewhat inefficient, but infrequently used currentIndex: INT = itemStream.GetIndex[]; nBytesLeft: INT _ itemHeader.length; itemRestrictedStream: STREAM = SMTPSupport.CreateSubrangeStream[itemStream, currentIndex, currentIndex + nBytesLeft]; buffer: REF TEXT = RefText.ObtainScratch[100]; WHILE nBytesLeft > 0 DO <> nBytesRead: INT _ itemRestrictedStream.GetBlock[ buffer, 0, MIN[nBytesLeft, buffer.maxLength]]; IF nBytesRead = 0 THEN ERROR IO.EndOfStream[itemRestrictedStream]; out.PutBlock[buffer, 0, nBytesRead]; nBytesLeft _ nBytesLeft - nBytesRead; ENDLOOP; out.PutChar['\n]; RefText.ReleaseScratch[buffer]; }; SELECT itemHeader.type FROM PostMark => { PutHeader["PostMark", FALSE]; out.PutRope[GVBasics.RopeFromTimestamp[GVProtocol.ReceiveTimestamp[itemStream]]]; out.PutChar['\n];}; Sender => { PutHeader["Sender", FALSE]; out.PutRope[ReceiveRName[itemStream]]; out.PutChar['\n];}; ReturnTo => { PutHeader["ReturnTo", FALSE]; out.PutRope[ReceiveRName[itemStream]]; out.PutChar['\n];}; Recipients => { numRecips: INT = ReceiveCount[itemStream]; PutHeader["Recipients", FALSE]; THROUGH [1..numRecips] DO out.PutRope[ReceiveRName[itemStream]]; out.PutChar['\n] ENDLOOP;}; Text => {PutHeader["Text", FALSE]; PutRaw[]}; Capability => {PutHeader["Capability", TRUE]; PutRaw[]}; Audio => {PutHeader["Audio", TRUE]; out.PutRope["\n"]}; LastItem => {PutHeader["LastItem", FALSE]; out.PutChar['\n]}; ENDCASE => {PutHeader["", TRUE]; PutRaw[]}; EXITS Return => NULL; END; }; BlessReturnPath: PUBLIC PROC [raw: ROPE] RETURNS [arpa: ROPE] = BEGIN <<1) Bitch if name of first host on return path isn't recognized by name servers>> <<2) Make sure it ends in .ARPA (or such) so GV will send rejections back via us>> length: INT = Rope.Length[raw]; host: ROPE; IF Rope.Fetch[raw, 0] = '@ THEN { -- @Foo:X@Y case FOR i: INT IN [1..length) DO char: CHAR = Rope.Fetch[raw, i]; SELECT char FROM ',, ': => { host _ Rope.Substr[raw, 1, i-1]; EXIT; }; ENDCASE => NULL; REPEAT FINISHED => SMTPSupport.Log[important, "Invalid syntax in return path: ", raw]; ENDLOOP; } ELSE { --Foo@Bar FOR i: INT DECREASING IN [0..length) DO c: CHAR = Rope.Fetch[raw, i]; IF c = '@ THEN { host _ Rope.Substr[raw, i + 1, (length-i-1)]; EXIT; }; ENDLOOP; }; SELECT TRUE FROM (host = NIL) => NULL; ~CheckHostName[host] => SMTPSupport.Log[important, "Invalid character in first return return host: ", raw]; IPName.LoadCacheFromName[host, TRUE, FALSE] = bogus => { SMTPSupport.Log[important, "BOGUS host name in return path: ", host]; }; ENDCASE => NULL; SELECT TRUE FROM Rope.Find[raw, ","] # -1 => <<@A,@B:User@Host => comma would be bogus in rejection msgs>> arpa _ Rope.Cat["\"", raw, "\"@", SMTPControl.xeroxDomain]; ValidDomain[raw] => <> arpa _ raw; raw.Fetch[0] = '@ => <> arpa _ Rope.Cat["\"", raw, "\"@", SMTPControl.xeroxDomain]; ENDCASE => <> <> BEGIN length: INT _ Rope.Length[raw]; user, host: ROPE; FOR i: INT DECREASING IN [0..length) DO c: CHAR = raw.Fetch[i]; IF c = '@ THEN { user _ Rope.Substr[raw, 0, i]; host _ Rope.Substr[raw, i + 1, (length-i-1)]; host _ NormalizeName[host]; IF host.Fetch[0] = '[ THEN host _ Rope.Cat[host, ".ARPA"]; -- [36,1,2,6] arpa _ Rope.Cat[user, "@", host]; IF ~Tailed[arpa, ".ARPA"] THEN { <> <> SMTPSupport.Log[important, "Bogus return path: ", raw]; arpa _ Rope.Cat["\"", raw, "\"@", SMTPControl.xeroxDomain]; }; EXIT; }; REPEAT FINISHED => arpa _ raw; ENDLOOP; END; IF arpa # raw THEN SMTPSupport.Log[important, "Return path fixup: ", raw, " => ", arpa]; END; ValidDomain: PROC [raw: ROPE] RETURNS [BOOLEAN] = { FOR list: LIST OF Rope.ROPE _ IPConfig.validDomains, list.rest UNTIL list = NIL DO domain: Rope.ROPE _ list.first; IF DotTailed[raw, domain] THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE];}; UnBlessReturnPath: PUBLIC PROC [raw: ROPE] RETURNS [arpa: ROPE] = BEGIN <> <<(the ones that aren't bright enough to process quotes)>> IF raw = NIL THEN RETURN[NIL]; IF Rope.Fetch[raw, 0] #'" THEN RETURN[raw]; IF ~Tailed[raw, SMTPControl.xeroxDomain] THEN RETURN[raw]; RETURN[Rope.Substr[raw, 1, Rope.Length[raw]-3-Rope.Length[SMTPControl.xeroxDomain]]]; END; ReversePath: PUBLIC PROC [gv: ROPE] RETURNS [arpa: ROPE] = BEGIN length: INT _ gv.Length[]; FOR i: INT DECREASING IN [0..length) DO c: CHAR = gv.Fetch[i]; IF c = '\" THEN { -- "Foo" or "Foo".OSBUNorth IF gv.Fetch[0] # '\" THEN EXIT; IF i = length-1 THEN gv _ Rope.Substr[gv, 1, length-2] ELSE gv _ Rope.Cat[Rope.Substr[gv, 1, i-1], Rope.Substr[gv, i+1, length-i-1]]; EXIT; }; IF c = '@ THEN { glue: ROPE = IF gv.Fetch[0] = '@ THEN "," ELSE ":"; arpa _ Rope.Cat["@", SMTPControl.xeroxDomain, glue, gv]; RETURN; }; ENDLOOP; gv _ FixupSpaces[gv]; gv _ MaybeAddQuotes[gv]; arpa _ Rope.Cat[gv, "@", SMTPControl.xeroxDomain]; -- Normal GV case END; HostAndUser: PUBLIC PROC [raw: ROPE] RETURNS [host, user: ROPE] = { raw _ FixupTail[raw, ".AG"]; raw _ FixupTail[raw, ".ArpaGateway"]; raw _ FixupTail[raw, ".NotArpa"]; raw _ FixupTail[raw, ".ARPA.ARPA"]; -- Hardy 10.0 always adds .ArpaGateway raw _ FixupTail[raw, ".AG.ARPA"]; FOR list: LIST OF Rope.ROPE _ IPConfig.validDomains, list.rest UNTIL list = NIL DO domain: Rope.ROPE _ list.first; rope: Rope.ROPE _ Rope.Cat[".", domain, ".ARPA"]; raw _ TruncateTail[raw, rope]; ENDLOOP; IF Rope.Find[raw, "].ARPA", 0, FALSE] # -1 THEN raw _ TruncateTail[raw, ".ARPA"]; IF raw.Fetch[0] # '@ THEN { <> <> raw _ Redirect[raw, ".BITNET", bitnetGateway]; raw _ Redirect[raw, ".CSNet", csnetGateway]; raw _ Redirect[raw, ".UUCP", uucpGateway]; raw _ Redirect[raw, ".Mailnet", mailnetGateway]; }; IF raw.Fetch[0] # '@ THEN { <> raw _ StripTail[raw, "@[10.2.0.32].ARPA"]; raw _ StripTail[raw, "@[10.2.0.32].COM"]; raw _ StripTail[raw, "@[10.2.0.32]"]; raw _ StripTail[raw, "@Xerox.COM"]; raw _ StripTail[raw, "@Xerox.ARPA"]; raw _ StripTail[raw, "@Xerox"]; raw _ StripTail[raw, "@PARC.Xerox.COM"]; raw _ StripTail[raw, "@PARC.Xerox"]; raw _ StripTail[raw, "@PARC.ARPA"]; raw _ StripTail[raw, "@PARC"]; raw _ StripTail[raw, "@Parc-Maxc.ARPA"]; raw _ StripTail[raw, "@Parc-Maxc"]; } ELSE { <> <<>> raw _ StripHead[raw, "@[10.2.0.32].ARPA"]; raw _ StripHead[raw, "@[10.2.0.32].COM"]; raw _ StripHead[raw, "@[10.2.0.32]"]; raw _ StripHead[raw, "@Xerox.COM"]; raw _ StripHead[raw, "@Xerox.ARPA"]; raw _ StripHead[raw, "@Xerox"]; raw _ StripHead[raw, "@PARC.Xerox.COM"]; raw _ StripHead[raw, "@PARC.Xerox"]; raw _ StripHead[raw, "@PARC.ARPA"]; raw _ StripHead[raw, "@PARC"]; raw _ StripHead[raw, "@Parc-Maxc.ARPA"]; raw _ StripHead[raw, "@Parc-Maxc"]; }; raw _ StripQuotes[raw]; [host: host, user: user] _ FindHostName[raw]; IF host = NIL THEN { user _ StripTail[user, ".ARPA"]; -- Hack for testing by sending to Foo.PA.Arpa user _ ForceRegistry[user]; user _ FixupUnderbars[user]; }; }; Redirect: PROC [old, domain, relay: ROPE] RETURNS [new: ROPE] = BEGIN tail: ROPE _ Rope.Cat[domain, ".ARPA"]; IF Tailed[old, tail] THEN old _ StripTail[old, ".ARPA"]; IF Tailed[old, domain] THEN { length: INT; old _ StripTail[old, domain]; length _ Rope.Length[old]; FOR i: INT DECREASING IN [0..length) DO IF Rope.Fetch[old, i] = '@ THEN { name: ROPE _ Rope.Substr[old, 0, i]; name _ StripQuotes[name]; -- "Joe User"@Host.xx old _ Rope.Cat[name, "%", Rope.Substr[old, i + 1, (length-i-1)]]; old _ MaybeAddQuotes[old]; -- "Joe User%Host.xx" EXIT; }; ENDLOOP; old _ Rope.Cat[old, domain, "@", relay]; }; RETURN[old]; END; StripQuotes: PROC [old: ROPE] RETURNS [new: ROPE] = { length: INT _ old.Length[]; new _ old; IF length < 2 THEN RETURN; IF old.Fetch[0] # '\" THEN RETURN; SELECT TRUE FROM old.Fetch[length-1] = '\" => new _ old.Substr[1, length-1-1]; Tailed[old, "\".ARPA"] => new _ old.Substr[1, length-1-6]; ENDCASE => RETURN; length _ new.Length[]; FOR i: INT IN [0..length) DO IF new.Fetch[i] = '\\ THEN EXIT; REPEAT FINISHED => RETURN; -- No \ inside the string ENDLOOP; BEGIN quoteSeen: BOOLEAN _ FALSE; text: REF TEXT _ RefText.ObtainScratch[length]; FOR i: INT IN [0..length) DO c: CHAR = new.Fetch[i]; IF c = '\\ AND ~quoteSeen THEN { quoteSeen _ TRUE; LOOP; }; text _ RefText.AppendChar[text, c]; quoteSeen _ FALSE; ENDLOOP; new _ Rope.FromRefText[text]; RefText.ReleaseScratch[text]; END; }; MaybeAddQuotes: PROC [old: ROPE] RETURNS [new: ROPE] = BEGIN <> <> length: INT _ old.Length[]; new _ old; IF Rope.IsEmpty[new] THEN RETURN; IF Rope.Fetch[new, 0] = '" THEN RETURN; -- Assume already quoted correctly FOR i: INT IN [0..length) DO SELECT Rope.Fetch[new, i] FROM > 177C => EXIT; -- Funny characters. What should happen to these?? '(, '), '<, '>, '@, '<, ';, ':, '\\, '", '[, '] => EXIT; -- Specials EXCEPT PERIOD! ' => EXIT; -- Space < 040C => EXIT; -- CTL ENDCASE => NULL; -- Includes underbar REPEAT FINISHED => RETURN; -- Nothing fancy inside the string ENDLOOP; new _ Rope.Cat["\"", old, "\""]; END; FixupTail: PROC [old, tail: ROPE] RETURNS [new: ROPE] = { new _ old; IF Tailed[old, tail] THEN { new _ StripTail[old, tail]; new _ Rope.Concat[new, ".ARPA"]; }; }; TruncateTail: PROC [old, tail: ROPE] RETURNS [new: ROPE] = { new _ old; IF Tailed[old, tail] THEN new _ StripTail[old, ".ARPA"]; }; Tailed: PROC [body, tail: ROPE] RETURNS [match: BOOL] = { bodyLength: INT = body.Length[]; tailLength: INT = tail.Length[]; back: 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]; }; 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]; }; StripTail: PROC [body, tail: ROPE] RETURNS [new: ROPE] = { bodyLength: INT = body.Length[]; tailLength: INT = tail.Length[]; IF ~Tailed[body, tail] THEN RETURN[body]; RETURN[Rope.Substr[body, 0, bodyLength - tailLength]]}; Headed: PROC [body, head: ROPE] RETURNS [match: BOOL] = { bodyLength: INT = body.Length[]; headLength: INT = head.Length[]; char: CHAR; IF bodyLength <= headLength+1 THEN RETURN[FALSE]; char _ Rope.Fetch[body, headLength]; IF char = ', OR char = ': THEN { front: ROPE _ Rope.Substr[body, 0, headLength]; IF Rope.Equal[front, head, FALSE] THEN RETURN[TRUE]; }; RETURN[FALSE]; }; StripHead: PROC [body, head: ROPE] RETURNS [new: ROPE] = { bodyLength: INT = body.Length[]; headLength: INT = head.Length[]; IF ~Headed[body, head] THEN RETURN[body]; <> RETURN[Rope.Substr[body, headLength+1, bodyLength - headLength -1]]}; FindHostName: PROC [raw: ROPE] RETURNS [host, user: ROPE] = { length: INT _ raw.Length[]; user _ raw; IF Rope.Fetch[raw, 0] = '@ THEN { -- @Foo:X@Y case FOR i: INT IN [1..length) DO char: CHAR = Rope.Fetch[raw, i]; SELECT char FROM ',, ': => { host _ Rope.Substr[raw, 1, i-1]; IF ~CheckHostName[host] THEN RETURN["Invalid character in host name", raw]; host _ NormalizeName[host]; user _ Rope.Substr[raw, i + 1, (length-i-1)]; <> user _ Rope.Cat["@", host, Rope.FromChar[char], user]; RETURN; }; ENDCASE => NULL; REPEAT FINISHED => RETURN["Invalid Syntax", raw]; ENDLOOP; }; FOR i: INT DECREASING IN [0..length) DO c: CHAR = raw.Fetch[i]; IF c = '\" THEN EXIT; IF c = '@ THEN { --Foo@Bar user _ Rope.Substr[raw, 0, i]; host _ Rope.Substr[raw, i + 1, (length-i-1)]; IF ~CheckHostName[host] THEN RETURN["Invalid character in host name", raw]; host _ NormalizeName[host]; user _ MaybeAddQuotes[user]; -- "Foo Foo"@Bar user _ Rope.Cat[user, "@", host]; RETURN; }; ENDLOOP; FOR i: INT DECREASING IN [0..length) DO c: CHAR = raw.Fetch[i]; IF c = '\" THEN EXIT; IF c = '% THEN { -- Hackery: foo%bar user _ Rope.Substr[raw, 0, i]; host _ Rope.Substr[raw, i + 1, (length-i-1)]; IF ~CheckHostName[host] THEN RETURN["Invalid character in host name", raw]; host _ NormalizeName[host]; user _ MaybeAddQuotes[user]; user _ Rope.Cat[user, "@", host]; RETURN; }; ENDLOOP; host _ NIL; }; -- No @, Must be GV CheckHostName: PROC [host: ROPE] RETURNS [ok: BOOLEAN] = BEGIN length: INT _ Rope.Length[host]; FOR i: INT IN [1..length) DO char: CHAR = Rope.Fetch[host, i]; SELECT char FROM '(, '), '<, '>, '@, '<, ';, ':, '\\, '" => RETURN[FALSE]; -- Specials EXCEPT PERIOD and []! ' => RETURN[FALSE]; -- Space < 040C => RETURN[FALSE]; -- CTL ENDCASE => NULL; ENDLOOP; RETURN[TRUE]; END; NormalizeName: PROC [raw: ROPE] RETURNS [host: ROPE] = BEGIN host _ IPName.NormalizeName[raw]; IF host # NIL THEN RETURN; RETURN[raw]; END; ForceRegistry: PROC [raw: ROPE] RETURNS [user: ROPE] = BEGIN length: INT _ raw.Length[]; user _ raw; FOR i: INT DECREASING IN [0..length) DO IF raw.Fetch[i] = '. THEN RETURN; ENDLOOP; user _ Rope.Concat[raw, SMTPControl.defaultRegistry]; END; FixupSpaces: PROC [raw: ROPE] RETURNS [user: 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] RETURNS [user: ROPE] = BEGIN length: INT _ raw.Length[]; name, registry: ROPE; user _ raw; FOR i: INT IN [0..length) DO IF raw.Fetch[i] = '_ THEN EXIT; REPEAT FINISHED => RETURN; ENDLOOP; FOR i: INT DECREASING IN [0..length) DO IF raw.Fetch[i] = '. THEN { name _ Rope.Substr[raw, 0, i]; registry _ Rope.Substr[raw, i, (length-i)]; -- Registry includes the dot EXIT; }; REPEAT FINISHED => name _ user; -- No registry (?) ENDLOOP; name _ Rope.Translate[base: name, translator: UnderbarToSpace]; user _ Rope.Cat["\"", name, "\"", registry]; END; UnderbarToSpace: PROC [old: CHAR] RETURNS [new: CHAR] = BEGIN IF old = '_ THEN RETURN[' ] ELSE RETURN[old]; END; SpaceToUnderbar: PROC [old: CHAR] RETURNS [new: CHAR] = BEGIN IF old = ' THEN RETURN['_] ELSE RETURN[old]; END; END.