// 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)
]