// IfsMailRetrieve.bcpl - IFS Mail Server Retrieve command // Copyright Xerox Corporation 1979, 1980, 1981, 1982 // Last modified May 13, 1982 2:21 PM by Taft get "Ifs.decl" get "IfsDirs.decl" get "IfsFiles.decl" get "IfsFtpProt.decl" get "IfsMail.decl" external [ // outgoing procedures MtpSRetrieve; MtpSRetrieveMail; MtpSRetrieveCleanup // incoming procedures from other FTP and Mail modules FtpSCheckAccess; FtpSSendMark FlipCursor; DiskToNet; FreePList; InitPList; MailStatDelay // incoming procedures from IFS Dirs IFSOpenFile; OpenIFSStream; CloseIFSStream DestroyFD; DeleteFileFromFD; StreamsFD // incoming procedures - miscellaneous SysAllocateZero; SysFree; ExtractSubstring; ConcatenateStrings; RNamesEqual SetTimer; Dismiss; TimerHasExpired; SetFilePos Resets; Closes; Endofs; ReadBlock; TruncateDiskStream MoveBlock; Zero IFSError // incoming statics CtxRunning; mail; debugFlag ] //---------------------------------------------------------------------------- let MtpSRetrieve(remotePL, localPL) = valof //---------------------------------------------------------------------------- [ localPL = FreePList(localPL) if CtxRunning>>FtpCtx.msg eq 0 then //first time for this Retrieve [ // Check out his pList unless FtpSCheckAccess(remotePL) resultis 0 let mailbox = remotePL>>PL.MLBX if mailbox eq 0 resultis FtpSSendMark(markNo, ecMlbxRequired) for i = mailbox>>String.length to 1 by -1 do if mailbox>>String.char^i eq $. then [ mailbox>>String.length = i-1; break ] unless RNamesEqual(mailbox, remotePL>>PL.UNAM) % RNamesEqual(mailbox, remotePL>>PL.CNAM) do resultis FtpSSendMark(markNo, ecMlbxNotUnamOrCnam) // Is there a mailbox? // IFSOpenFile checks access, so switch to our "Mail" identity. let ui = CtxRunning>>FtpCtx.userInfo CtxRunning>>FtpCtx.userInfo = mail>>Mail.ui mailbox = ConcatenateStrings("Box>", mailbox) let ec, stream = 0, 0 let timer = nil; SetTimer(lv timer, openTimeout*100) [ // repeat stream = IFSOpenFile(mailbox, lv ec, modeReadWrite, 0, lcVHighest) if stream ne 0 % ec ne ecFileBusy % TimerHasExpired(lv timer) break Dismiss(100) // Busy. Wait 1 second, then try again ] repeat CtxRunning>>FtpCtx.userInfo = ui // switch back to user's identity SysFree(mailbox) if stream eq 0 then resultis FtpSSendMark(markNo, (ec eq ecFileNotFound % ec eq ecDirNotFound? ecNoMailbox, ec)) let msg = SysAllocateZero(lenMsg) msg>>Msg.stream = stream CtxRunning>>FtpCtx.msg = msg ] let msg = CtxRunning>>FtpCtx.msg SetFilePos(msg>>Msg.stream, lv msg>>Msg.posEnd) if Endofs(msg>>Msg.stream) resultis -1 // If the next message is damaged, then say 'no more messages', // which will case the file to be emptied thereby healing it. if ReadBlock(msg>>Msg.stream, lv msg>>Msg.mh, lenMH) ne lenMH then [ if debugFlag then IFSError(ecEofInHdr, msg); resultis -1 ] if msg>>Msg.seal ne mhSeal then [ if debugFlag then IFSError(ecBadMsgSeal, msg); resultis -1 ] // Set up the pList for the next message. localPL = InitPList() MoveBlock(lv localPL>>PL.LGTH, lv msg>>Msg.lenTxt, 2) MoveBlock(lv localPL>>PL.RCVD, lv msg>>Msg.date, 2) // ready to transfer message body resultis localPL ] //---------------------------------------------------------------------------- let MtpSRetrieveMail(nil, nil) = valof //---------------------------------------------------------------------------- [ let msg = CtxRunning>>FtpCtx.msg let bytes = vec 1; MoveBlock(bytes, lv msg>>Msg.lenTxt, 2) SetFilePos(msg>>Msg.stream, lv msg>>Msg.posTxt) let ec = DiskToNet(CtxRunning>>FtpCtx.bspStream, msg>>Msg.stream, bytes) if ec eq 0 then [ // time in seconds message waited in mailbox MailStatDelay(msTypeRetr, lv msg>>Msg.date) resultis true ] FtpSSendMark(markNo, ec) resultis false ] //---------------------------------------------------------------------------- and MtpSRetrieveCleanup(remotePL, ok) = valof //---------------------------------------------------------------------------- [ let msg = CtxRunning>>FtpCtx.msg let stream = msg>>Msg.stream if ok then [ // ok to flush mail from mailbox let fd = StreamsFD(stream) let ui = CtxRunning>>FtpCtx.userInfo let mbxName = ExtractSubstring(lv fd>>FD.dr>>DR.pathName, fd>>FD.lenSubDirString+1, fd>>FD.lenBodyString-1) test ui>>UserInfo.capabilities.mail eq 0 & RNamesEqual(mbxName, ui>>UserInfo.userName) ifso [ // User no longer has mail capability; destroy mailbox. // To avoid a race with another process attempting to store new // mail, we exploit the feature of DeleteFileFromFD that permits // the caller to pass in the FD for an open file. CloseIFSStream(stream, true) // just destroy stream; FD stays open CtxRunning>>FtpCtx.userInfo = mail>>Mail.ui unless DeleteFileFromFD(fd, false, true) eq 0 do IFSError(ecMlbxDelFailed) CtxRunning>>FtpCtx.userInfo = ui DestroyFD(fd) stream = 0 ] ifnot [ // Normal case: make mailbox empty Resets(stream) TruncateDiskStream(stream) ] SysFree(mbxName) ] if msg ne 0 then [ if stream ne 0 then Closes(stream) SysFree(msg) CtxRunning>>FtpCtx.msg = 0 ] resultis ok ]