// IfsMailUndeliv.bcpl -- "Return to sender: undeliverable" // Copyright Xerox Corporation 1980, 1981 // Last modified September 18, 1983 1:44 PM by Taft get "Ifs.decl" get "IfsSystemInfo.decl" get "IfsMail.decl" external [ // outgoing procedure StartUndelivMsg; FinishUndelivMsg // incoming procedures from other mail modules StartMsg; WriteMNB; FinishMsg MailStat; EnumerateMB; ReadMB; AppendRegistry // incoming procedures - misc LockCell; UnlockCell; VFileReadPage StringCompare; ExtractSubstring; CopyString PutTemplate; Wss; WRITEUDT; PrintIFSVersion ReadBlock; SetFilePos; DiskToDisk SysFree; FreePointer; MoveBlock IFSError // incoming statics infoVMD ] //---------------------------------------------------------------------------- let StartUndelivMsg(msg) be //---------------------------------------------------------------------------- // Starts an undeliverable message msg to the sender of msg. [ let uMsg = StartMsg(); if uMsg eq 0 return // Sender of uMsg is Mailer.registry. let sender = AppendRegistry("Mailer") WriteMNB(uMsg, mbTypeSndr, sender) // Recipient of uMsg is sender of msg. SetFilePos(msg>>Msg.stream, lv msg>>Msg.posSndr) let recip = ReadMB(msg); CopyString(recip, lv recip>>MNB.name) if StringCompare(recip, sender) eq 0 then //Mailer sent msg. [ let ms = VFileReadPage(infoVMD, msPage) LockCell(lv ms) let deadLtr, dot = lv ms>>MS.deadLtr, 0 test deadLtr>>String.length eq 0 ifso deadLtr = 0 ifnot [ // Make sure deadLtr contains a registry. for i = deadLtr>>String.length to 1 by -1 do if deadLtr>>String.char^i eq $. then [ dot = i; break ] deadLtr = dot? ExtractSubstring(deadLtr), AppendRegistry(deadLtr) ] UnlockCell(lv ms) // Mailer sent msg so recipient should be deadLtr. SysFree(recip); recip = deadLtr EnumerateMB(msg, UndelivUndeliv, lv deadLtr) if deadLtr eq 0 then //msg is undeliverable to deadLtr. [ // Abondon uMsg, thereby discarding msg. MailStat(msTypeDiscard) FreePointer(lv recip, lv sender) FinishMsg(uMsg, false) return ] ] WriteMNB(uMsg, mbTypeMlbx, recip) // Generate the covering letter's header text. let uStream = uMsg>>Msg.stream PutTemplate(uStream, "To: $S", recip) PutTemplate(uStream, "*NFrom: $S ($P mail job)", sender, PrintIFSVersion, 0) FreePointer(lv recip, lv sender) Wss(uStream, "*NDate: "); WRITEUDT(uStream, 0, true) Wss(uStream, "*NSubject: Undeliverable mail*N") // Ready to generate the list of undeliverable recipients. Wss(uStream, "*NUndeliverable to:") msg>>Msg.uMsg = uMsg ] //---------------------------------------------------------------------------- and UndelivUndeliv(mb, msg, lvDeadLtr) = valof //---------------------------------------------------------------------------- // Called by EnumerateMB on behalf of StartUndelivMsg. // Scans msg's recipients (which are by now exception blocks), // looking for a recipient = deadLtr. // If it finds one, then msg is undeliverable to deadLtr and // a uMsg should not be created. [ if mb>>MB.type ne mbTypeExcp % @lvDeadLtr eq 0 resultis false if StringCompare(lv mb>>MNB.name, @lvDeadLtr) eq 0 then [ mb>>MB.type = mbTypeFree @lvDeadLtr = 0 //signal StartUndelivMsg to abandon uMsg ] resultis mb>>MB.type eq mbTypeFree ] //---------------------------------------------------------------------------- and FinishUndelivMsg(msg) be //---------------------------------------------------------------------------- [ // copy the original message SetFilePos(msg>>Msg.stream, lv msg>>Msg.posTxt) let bytes = vec 1; MoveBlock(bytes, lv msg>>Msg.lenTxt, 2) Wss(msg>>Msg.uMsg>>Msg.stream, "*N---------------------------*N") DiskToDisk(msg>>Msg.uMsg>>Msg.stream, msg>>Msg.stream, bytes) msg>>Msg.uMsg = FinishMsg(msg>>Msg.uMsg, true) ]