// IfsMailJob.bcpl -- sorts and forwards mail // Copyright Xerox Corporation 1979, 1980, 1981, 1982 // Last modified April 9, 1982 12:33 PM by Taft get "Ifs.decl" get "IfsMail.decl" get "IfsDirs.decl" get "IfsFtpProt.decl" get "AltoFileSys.d" external [ // outgoing procedures MailJob; EnumerateMailFile; EnumerateMB; ReadMB // incoming procedures from other mail modules SortNewMail; ForwardMail; StartUndelivMsg; FinishUndelivMsg // incoming procedures from IFS dirs LookupIFSFile; NextFD; DestroyFD; DeleteFileFromFD; GetBufferForFD LockTransferLeaderPage; OpenIFSStream; CloseIFSStream; CloseIFSFile // incoming procedures - misc DestroyJob; JobOK; IFSError; IFSPrintError ReadBlock; WriteBlock; Closes; Endofs; FilePos; SetFilePos DoubleIncrement; DoubleUsc; DoubleAdd; Mul SysAllocate; SysFree; ReadCalendar; Zero; PutTemplate // incoming statics mail; debugFlag ] //--------------------------------------------------------------------------- let MailJob(ctx) be // a context //--------------------------------------------------------------------------- [ ctx>>RSCtx.userInfo = mail>>Mail.ui [ // repeat mail>>Mail.workToDo = false EnumerateMailDir("New>Mail!**", SortNewMail, minSortInterval) EnumerateMailDir("Fwd>**!1", ForwardMail, minForwardInterval) ] repeatwhile mail>>Mail.enabled ne 0 & mail>>Mail.workToDo ne 0 & JobOK(jobTypeMail) mail>>Mail.wake = jobInterval/eventInterval mail>>Mail.ctx = 0 DestroyJob() ] //---------------------------------------------------------------------------- and EnumerateMailDir(dirName, Proc, minInterval) be //---------------------------------------------------------------------------- // Enumerates all files matching dirName, opens a stream and calls Proc. // Skips over a file if it was last checked less than minInterval seconds ago, // unless it has been written more recently than that. // If Proc returns true, the file is then deleted. [ let fd = LookupIFSFile(dirName, lcMultiple) if fd eq 0 return [ // repeat // Continue or stop? if mail>>Mail.enabled eq 0 break unless JobOK(jobTypeMail) do [ mail>>Mail.workToDo = true; break ] // We should look closely at this file if it has been written since // last read or if it hasn't been read for at least minInterval. let time = vec 1; ReadCalendar(time) DoubleIncrement(time, -minInterval) let ld = GetBufferForFD(fd) let ok = LockTransferLeaderPage(fd, ld) eq 0 & (DoubleUsc(lv ld>>LD.written, lv ld>>LD.read) gr 0 % DoubleUsc(time, lv ld>>LD.read) ge 0) SysFree(ld) unless ok loop // Open the file and see what's inside. let stream = OpenIFSStream(fd, 0, modeReadWrite) if stream ne 0 then [ let delete = Proc(stream) // Do not unlock file if we're going to delete it. CloseIFSStream(stream, delete) if delete then if DeleteFileFromFD(fd, false, true) ne 0 then CloseIFSFile(fd) ] ] repeatwhile NextFD(fd) // Done enumeration -- cleanup and go away DestroyFD(fd) ] //---------------------------------------------------------------------------- and EnumerateMailFile(stream, Proc) = valof //---------------------------------------------------------------------------- // Enumerates all msgs in the stream, calling Proc for each one. // Returns true if the file behind stream can be deleted. [ let delete = true let msg = vec lenMsg; Zero(msg, lenMsg) msg>>Msg.stream = stream [ // read next message in file SetFilePos(stream, lv msg>>Msg.posEnd) if Endofs(stream) break // if the message is damaged, skip it. if ReadBlock(stream, lv msg>>Msg.mh, lenMH) ne lenMH then [ if debugFlag then IFSError(ecEofInHdr, msg); break ] if msg>>Msg.seal ne mhSeal then [ if debugFlag then IFSError(ecBadMsgSeal, msg); break ] if msg>>Msg.numActive eq 0 loop Proc(msg) // Check long-term timeout and handle any Exception blocks. let timeout = vec 1; Mul(0, 3600, deliveryTimeout, timeout) DoubleAdd(timeout, lv msg>>Msg.date) let now = vec 1; ReadCalendar(now) EnumerateMB(msg, Undeliv, DoubleUsc(now, timeout) ge 0) // if there is one, finish off the undeliverable msg msg if msg>>Msg.uMsg then FinishUndelivMsg(msg) // rewrite message header if msg>>Msg.numActive ne 0 then delete = false SetFilePos(stream, lv msg>>Msg.posBegin) WriteBlock(stream, lv msg>>Msg.mh, lenMH) ] repeat resultis delete ] //---------------------------------------------------------------------------- and Undeliv(mb, msg, timeout) = valof //---------------------------------------------------------------------------- // Called from EnumeratMB in EnumerateMailFile. // If 'timeout' then converts all active blocks into exception blocks. // Generates an undeliverable message message for all exception blocks. [ let rewrite, type = false, mb>>MB.type if timeout & type ne mbTypeFree & type ne mbTypeSndr & type ne mbTypeExcp then [ mb>>MB.type = mbTypeExcp mb>>MNB.ec = ecDeliveryTimeout rewrite = true ] if mb>>MB.type ne mbTypeExcp resultis false if msg>>Msg.uMsg eq 0 then StartUndelivMsg(msg) if msg>>Msg.uMsg ne 0 then [ let uStream = msg>>Msg.uMsg>>Msg.stream PutTemplate(uStream, "*N$S - ", lv mb>>MNB.name) IFSPrintError(uStream, mb>>MNB.ec) mb>>MB.type = mbTypeFree rewrite = true ] resultis rewrite ] //---------------------------------------------------------------------------- and EnumerateMB(msg, Proc, arg) be //---------------------------------------------------------------------------- // Enumerates the Blocks in msg calling Proc for each one. // If Proc returns true, the block is rewritten. // Changing the length of the block is forbidden. [ let stream = msg>>Msg.stream SetFilePos(stream, lv msg>>Msg.posBlk) msg>>Msg.numActive = 0 let mb = SysAllocate(maxLenMB) [ let thisPos = vec 1; FilePos(stream, thisPos) if DoubleUsc(thisPos, lv msg>>Msg.posTxt) ge 0 break ReadMB(msg, mb) let nextPos = vec 1; FilePos(stream, nextPos) test Proc(mb, msg, arg) //rewrite block? ifnot SetFilePos(stream, nextPos) //Proc may have changed stream pos. ifso //back up and rewrite the block [ SetFilePos(stream, thisPos) WriteBlock(stream, mb, mb>>MB.length) ] unless mb>>MB.type eq mbTypeFree % mb>>MB.type eq mbTypeSndr do msg>>Msg.numActive = msg>>Msg.numActive +1 ] repeat SysFree(mb) ] //---------------------------------------------------------------------------- and ReadMB(msg, mb; numargs na) = valof //---------------------------------------------------------------------------- [ let temp = nil ReadBlock(msg>>Msg.stream, lv temp, 1) if na ls 2 % mb eq 0 then mb = SysAllocate(temp<>Msg.stream, mb+1, mb>>MB.length-1) ne mb>>MB.length-1 then IFSError(ecEofInBlk, msg) resultis mb ]