// IfsMailSort.bcpl -- Sorts newly arrived mail // Copyright Xerox Corporation 1979, 1980, 1981 // Last modified November 18, 1981 9:31 AM by Taft get "Ifs.decl" get "IfsDirs.decl" get "IfsMail.decl" get "IfsFiles.decl" external [ // outgoing procedure SortNewMail // incoming procedures from IFS Dirs DestroyFD; IFSOpenFile; OpenIFSStream GetBufferForFD; LockTransferLeaderPage // incoming procedures from disk streams WriteBlock; Closes; Puts FilePos; SetFilePos; FileLength // incoming procedures from other mail modules EnumerateMailFile; EnumerateMB; ReadMB; WriteMNB CheckName; MailStatDelay; DiskToDisk // incoming procedures -- miscellaneous SysAllocateZero; SysFree; Zero; MoveBlock; Usc DoubleSubtract; DoubleIncrement; MultEq IFSError; Dequeue; ReadCalendar ConcatenateStrings; StringCompare; ExtractSubstring SetTimer; TimerHasExpired; Dismiss LockCell; UnlockCell; VFileReadPage // incoming statics mail ] //---------------------------------------------------------------------------- let SortNewMail(stream) = EnumerateMailFile(stream, Sort) //---------------------------------------------------------------------------- //---------------------------------------------------------------------------- and Sort(msg) be //---------------------------------------------------------------------------- [ DoubleIncrement(lv mail>>Mail.msgID) //for duplicate suppression // Deliver copies to local mailboxes, and build a list of remote servers EnumerateMB(msg, DeliverLocal) // Queue copies for forwarding to remote mailboxes [ let hqi = Dequeue(lv msg>>Msg.hostQ); if hqi eq 0 break if hqi>>HQI.used then DeliverRemote(msg, hqi) SysFree(hqi) ] repeat ] //---------------------------------------------------------------------------- and DeliverLocal(mb, msg) = valof //---------------------------------------------------------------------------- // Called from EnumerateMB in Sort. // If mb describes a local mailbox, then append a copy of msg to it. // If mb describes a remote mailbox, skip it. // If mb's syntax is bad or it references a nonexistant local mailbox, // then change mb into an exception block. [ if mb>>MB.type ne mbTypeMlbx resultis false let fd = CheckName(lv mb>>MNB.name, msg, lv mb>>MNB.ec, true) if fd eq 0 then [ mb>>MNB.type = mbTypeExcp; resultis true ] //bad syntax if fd eq -1 then [ // Non-local and can forward. // Reset MNB.ec in case local mailbox just became non-local. if mb>>MNB.ec ne 0 then [ mb>>MNB.ec = 0; resultis true ] resultis false ] // Mailbox is local, check for duplicates let ild = GetBufferForFD(fd) if LockTransferLeaderPage(fd, ild) eq 0 then // read [ let fProp = ild + ild>>LD.propertyBegin until fProp>>FPROP.type eq 0 % fProp>>FPROP.type eq fPropTypeMsgID do fProp = fProp + fProp>>FPROP.length if ild+ild>>LD.propertyBegin+ild>>LD.propertyLength uls fProp+lenFPropMsgID then IFSError(ecLeaderProps, ild) if fProp>>FPROP.type eq 0 then [ fProp>>FPROP.type = fPropTypeMsgID fProp>>FPROP.length = lenFPropMsgID Zero(lv fProp>>FPropMsgID.msgID, 2) fProp!lenFPropMsgID = 0 ] if MultEq(lv fProp>>FPropMsgID.msgID, lv mail>>Mail.msgID) then [ // duplicate SysFree(ild) DestroyFD(fd) mb>>MNB.type = mbTypeFree resultis true ] MoveBlock(lv fProp>>FPropMsgID.msgID, lv mail>>Mail.msgID, 2) LockTransferLeaderPage(fd, ild, true) // write ] SysFree(ild) // try to open a stream on it let stream, ec = nil, nil let timer = nil; SetTimer(lv timer, openTimeout*100) [ stream = OpenIFSStream(fd, lv ec, modeAppend) if stream ne 0 % ec ne ecFileBusy % TimerHasExpired(lv timer) break Dismiss(100) ] repeat if stream eq 0 then [ // Busy, try again later DestroyFD(fd) mb>>MNB.ec = ecFileBusy // so RemoteRecipients will skip over it resultis true ] // append a copy of the message to it FinishAppendingMsg(StartAppendingMsg(stream), msg) mb>>MNB.type = mbTypeFree resultis true ] //---------------------------------------------------------------------------- and DeliverRemote(inMsg, hqi, outMsg) be //---------------------------------------------------------------------------- // Generates a message for forwarding to host. Specifically, it: // copies the sender from inMsg; // copies recipients whose registry matches hqi; // copies the text of inMsg. // Caller is responsible for ensuring that there is at least one recipient // for the specified host. // Note: if hqi is the HQI corresponding to gvName, ALL remote recipients // are forwarded to this host. In this case, all the other HQIs will // not have had their HQI.used bits set, so the HQI for gvName is the // only one on which DeliverRemote will be called. // outMsg isn't really an argument, just a local. Its up there so // the compiler will allocate it after 'hqi', which is convenient // when calling RemoteRecipients via EnumerateMB, below. [ // try to open a forwarding file let fileName = ConcatenateStrings("Fwd>", lv hqi>>HQI.name) let outStream = IFSOpenFile(fileName, 0, modeAppend) SysFree(fileName) if outStream eq 0 return // append to forwarding file outMsg = StartAppendingMsg(outStream) // generate the sender SetFilePos(inMsg>>Msg.stream, lv inMsg>>Msg.posSndr) let mb = ReadMB(inMsg) WriteMNB(outMsg, mbTypeSndr, lv mb>>MNB.name) SysFree(mb) // generate the list of recipients EnumerateMB(inMsg, RemoteRecipients, lv hqi) // Copy message text, close outMsg. FinishAppendingMsg(outMsg, inMsg) // don't set Mail.workToDo since the forwarder will run next anyway ] //---------------------------------------------------------------------------- and RemoteRecipients(mb, inMsg, args) = valof //---------------------------------------------------------------------------- // Called from EnumerateMB in DeliverRemote. // Copies mailbox blocks from inMsg to outMsg. // Marks the mailbox blocks in inMsg free. // args!0 -> hqi, args!1 -> outMsg [ let hqi, outMsg = args!0, args!1 if mb>>MNB.type ne mbTypeMlbx % mb>>MNB.ec ne 0 resultis false // Append entry if hqi corresponds to gvName or registry matches hqi.name. if hqi ne inMsg>>Msg.gvHQI then [ let name, dot = lv mb>>MNB.name, 0 for i = name>>String.length to 1 by -1 do if name>>String.char^i eq $. then [ dot = i; break ] if StringCompare(name, lv hqi>>HQI.name, dot+1) ne 0 resultis false ] WriteMNB(outMsg, mbTypeMlbx, lv mb>>MNB.name) mb>>MNB.type = mbTypeFree resultis true ] // These two procedures perform the mechanical aspects of appending // new messages to message files. They are used by: // DeliverLocal on local mail boxes, and by // DeliverRemote on forward files for remote mail systems. //---------------------------------------------------------------------------- and StartAppendingMsg(outStream) = valof //---------------------------------------------------------------------------- // Creates and returns an Msg for appending to outStream. [ let outMsg = SysAllocateZero(lenMsg) outMsg>>Msg.stream = outStream FilePos(outStream, lv outMsg>>Msg.posBegin) WriteBlock(outStream, lv outMsg>>Msg.mh, lenMH) FilePos(outStream, lv outMsg>>Msg.posBlk) FilePos(outStream, lv outMsg>>Msg.posTxt) resultis outMsg ] //---------------------------------------------------------------------------- and FinishAppendingMsg(outMsg, inMsg) = valof //---------------------------------------------------------------------------- // Finishes appending inMsg to outMsg -- copies the text, finishes the // header, closes the stream, and destroys outMsg. [ let outStream = outMsg>>Msg.stream let inStream = inMsg>>Msg.stream SetFilePos(inStream, lv inMsg>>Msg.posTxt) MoveBlock(lv outMsg>>Msg.lenTxt, lv inMsg>>Msg.lenTxt, 2) DiskToDisk(outStream, inStream, lv outMsg>>Msg.lenTxt) MoveBlock(lv outMsg>>Msg.lenTxt, lv inMsg>>Msg.lenTxt, 2) if (FilePos(outStream, lv outMsg>>Msg.posEnd) & 1) eq 1 then [ Puts(outStream, 0) //pad to word boundary DoubleIncrement(lv outMsg>>Msg.posEnd) ] ReadCalendar(lv outMsg>>Msg.date) SetFilePos(outStream, lv outMsg>>Msg.posBegin) outMsg>>Msg.version = mhVersion outMsg>>Msg.seal = mhSeal WriteBlock(outStream, lv outMsg>>Msg.mh, lenMH) FileLength(outStream) //so Closes doesn't truncate Closes(outStream) // time in seconds msg waited in New>Mail MailStatDelay(msTypeSort, lv inMsg>>Msg.date) SysFree(outMsg) resultis 0 ]