// FtpServProtMail.bcpl - MTP server commands // Copyright Xerox Corporation 1979, 1980, 1981 // Last modified December 8, 1981 6:07 PM by Boggs get "FtpProt.decl" external [ // outgoing procedures ServStoreMail; ServRetrieveMail // incoming procedures GetCommand; FTPM; ServProtocolError FreePList; ScanPList; GeneratePList // incoming statics CtxRunning ] //--------------------------------------------------------------------------- let ServStoreMail() be //--------------------------------------------------------------------------- [ let ok = false [ let ec = nil; let pl = ScanPList(lv ec) if ec eq 0 then ok = (CtxRunning>>FtpCtx.StoreMail)(pl) if pl eq 0 break FreePList(pl) ] repeatwhile ok if ok then [ FTPM(markYes, 0, "Ready for mail") switchon GetCommand()<<Mark.mark into [ case markEndOfCommand: FTPM(markEndOfCommand); endcase case markHereIsFile: break default: ServProtocolError() //falls through case 0: ok = false; break ] repeat if ok then [ ok = (CtxRunning>>FtpCtx.StoreMailMessage)() switchon GetCommand()<<Mark.mark into [ case markYes: [ if ok then FTPM(markYes, 0, "Mail Stored AOK") endcase ] case markNo: [ if ok then FTPM(markNo, 106b, "Mail not stored") ok = false endcase ] default: ServProtocolError() case 0: ok = false; endcase ] ] ] (CtxRunning>>FtpCtx.StoreMailCleanup)(ok) ] //--------------------------------------------------------------------------- and ServRetrieveMail() be //--------------------------------------------------------------------------- //if FtpCtx.RetrieveMail returns false or -1 then // it will never again be called (0 means a markNo was sent, -1 means done) //if FtpCtx.RetrieveMail returns a PList then // FtpCtx.RetrieveMailMessage MAY OR MAY NOT be called // but FtpCtx.RetrieveMailCleanup will ALWAYS be called [ let remotePList = ScanPList(); if remotePList eq 0 return let localPList, ok = 0, nil [ localPList = (CtxRunning>>FtpCtx.RetrieveMail)(remotePList, localPList) if localPList eq 0 % localPList eq -1 then [ ok = localPList; break ] FTPM(markHereIsPList) GeneratePList(localPList) ok = (CtxRunning>>FtpCtx.RetrieveMailMessage)(remotePList, localPList) ] repeatwhile ok if ok then [ FTPM(markYes, 0, "Transfer complete") switchon GetCommand()<<Mark.mark into [ case markEndOfCommand: FTPM(markEndOfCommand); endcase case markFlushMailBox: break default: ServProtocolError() //falls through case 0: ok = false; break ] repeat ] let ok1 = (CtxRunning>>FtpCtx.RetrieveMailCleanup)(remotePList, ok) if ok & ok1 then FTPM(markYes, 0, "MailBox Flushed") FreePList(remotePList) ]