// IfsFtpCmd.bcpl - More IFS Ftp server commands // Copyright Xerox Corporation 1979, 1980, 1981, 1982, 1983 // Last modified September 27, 1983 4:33 PM by Taft get "IfsDirs.decl" get "IfsFiles.decl" get "IfsFtpProt.decl" external [ // outgoing procedures FtpSVersion; FtpSRename; FtpSDirectory FtpSDelete; FtpSDeleteFile; FtpSNotImpl // incoming procedures from IfsFtpServUtil.bcpl FtpSMakeSFIL; FtpSSendMark; FtpSCheckConnection FtpSCheckAccess; FtpSFillPLFromLD // incoming procedures from IFS Dirs LookupIFSFile; DeleteFileFromFD; RenameFileFromFD NextFD; DestroyFD; LookupFD // incoming procedures - miscellaneous FreePList; PrintIFSVersion; PutTemplate; ActiveJobs; FtpSSetProps // incoming statics CtxRunning; maxJobs ] //--------------------------------------------------------------------------- let FtpSVersion() be //--------------------------------------------------------------------------- [ PrintIFSVersion(CtxRunning>>FtpCtx.bspStream, (CtxRunning>>FtpCtx.type eq jobTypeMTP? "Mail server", "File server")) let activeJobs = ActiveJobs() PutTemplate(CtxRunning>>FtpCtx.bspStream, "; $D user$S out of $D", activeJobs, (activeJobs eq 1? "", "s"), maxJobs) ] //--------------------------------------------------------------------------- and FtpSNotImpl() = FtpSSendMark(markNo, ecNotImplemented) //--------------------------------------------------------------------------- //--------------------------------------------------------------------------- and FtpSDirectory(remotePL, localPL) = valof //--------------------------------------------------------------------------- [ // repeat localPL = FreePList(localPL) unless FtpSCheckConnection() resultis false test CtxRunning>>FtpCtx.fd eq 0 ifso [ // first time for this Directory request unless FtpSCheckAccess(remotePL) resultis false FtpSMakeSFIL(remotePL) let ec = nil CtxRunning>>FtpCtx.fd = LookupIFSFile(remotePL>>PL.SFIL, lcMultiple+lcVAll, lv ec, 0, remotePL>>PL.DIRE) if CtxRunning>>FtpCtx.fd eq 0 resultis FtpSSendMark(markNo, ec) ] ifnot unless NextFD(CtxRunning>>FtpCtx.fd) do [ // failed - no more files CtxRunning>>FtpCtx.fd = DestroyFD(CtxRunning>>FtpCtx.fd) resultis false ] localPL = FtpSFillPLFromLD(remotePL) if localPL ne 0 resultis localPL ] repeat //--------------------------------------------------------------------------- and FtpSRename(oldPL, newPL) = valof //--------------------------------------------------------------------------- [ unless FtpSCheckAccess(oldPL) resultis false FtpSMakeSFIL(oldPL) FtpSMakeSFIL(newPL) let ec = 0 let fd = LookupIFSFile(oldPL>>PL.SFIL, lcVHighest, lv ec, 0, oldPL>>PL.DIRE) if fd ne 0 then [ ec = RenameFileFromFD(fd, newPL>>PL.SFIL, newPL>>PL.DIRE, FtpSSetProps, newPL) DestroyFD(fd) ] resultis ec eq 0? true, FtpSSendMark(markNo, ec) ] //--------------------------------------------------------------------------- and FtpSDelete(remotePL, localPL) = valof //--------------------------------------------------------------------------- [ // repeat localPL = FreePList(localPL) unless FtpSCheckConnection() resultis false test CtxRunning>>FtpCtx.fd eq 0 ifso [ // first time for this Delete request unless FtpSCheckAccess(remotePL) resultis false FtpSMakeSFIL(remotePL) let ec = nil CtxRunning>>FtpCtx.fd = LookupIFSFile(remotePL>>PL.SFIL, lcMultiple+lcVLowest, lv ec, 0, remotePL>>PL.DIRE) if CtxRunning>>FtpCtx.fd eq 0 resultis FtpSSendMark(markNo, ec) ] ifnot unless NextFD(CtxRunning>>FtpCtx.fd) do [ // failed - no more files CtxRunning>>FtpCtx.fd = DestroyFD(CtxRunning>>FtpCtx.fd) resultis false ] localPL = FtpSFillPLFromLD(remotePL) if localPL ne 0 resultis localPL ] repeat //--------------------------------------------------------------------------- and FtpSDeleteFile(pl) = valof //--------------------------------------------------------------------------- [ let ec = DeleteFileFromFD(CtxRunning>>FtpCtx.fd) resultis ec eq 0? true, FtpSSendMark(markNo, ec) ]