// FtpServProtFile.bcpl - FTP server commands
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 8, 1982  8:41 PM by Boggs

get "FtpProt.decl"

external
[
// outgoing procedures
ServRetrieve; ServStore
ServDelete; ServDirectory; ServRename

// incoming procedures
GetCommand; FTPM; ServProtocolError
FreePList; ScanPList; GeneratePList

// incoming statics
CtxRunning
]

//-----------------------------------------------------------------------------------------
let ServRetrieve() be
//-----------------------------------------------------------------------------------------
//if FtpCtx.Retrieve returns false then
//   it will never again be called
//if FtpCtx.Retrieve returns true then
//   FtpCtx.RetrieveFile MAY OR MAY NOT be called
//   but FtpCtx.RetrieveCleanup will ALWAYS be called
[
let remotePL = ScanPList(); if remotePL eq 0 return
let localPL = 0
   [
   localPL = (CtxRunning>>FtpCtx.Retrieve)(remotePL, localPL)
   if localPL eq 0 break
   FTPM(markHereIsPList)
   GeneratePList(localPL)
   let ok = false
   switchon GetCommand()<<Mark.mark into
      [
      case markEndOfCommand: [ FTPM(markEndOfCommand); endcase ]
      case markYes:
         [
         if (CtxRunning>>FtpCtx.RetrieveFile)(localPL, remotePL) then
            [
            FTPM(markYes, 0, "Transfer complete")
            ok = true
            ]
         break
         ]
      default: ServProtocolError()  //falls through
      case markNo: case 0: break
      ] repeat
   (CtxRunning>>FtpCtx.RetrieveCleanup)(localPL, ok, remotePL)
   ] repeat
FreePList(remotePL)
]

//-----------------------------------------------------------------------------------------
and ServStore(new) be
//-----------------------------------------------------------------------------------------
// This handles both the old and new store commands.
[
let remotePL = ScanPList(); if remotePL eq 0 return
let localPL = (CtxRunning>>FtpCtx.Store)(remotePL)
if localPL ne 0 then
   [
   test new  //if new, then localPL is really a pList
      ifso
         [
         FTPM(markHereIsPList)
         GeneratePList(localPL)
         ]
      ifnot FTPM(markYes, 0, "File open, ready for data")
   let ok = true
   switchon GetCommand()<<Mark.mark into
      [
      case markHereIsFile: break
      case markNo:
         [
         FTPM(markNo, 106b, "Store NOT completed")
         ok = false
         break
         ]
      case markEndOfCommand: [ FTPM(markEndOfCommand); endcase ]
      default: ServProtocolError()  //falls through
      case 0: ok = false; break
      ] repeat
   if ok then
      [
      ok = (CtxRunning>>FtpCtx.StoreFile)(remotePL, localPL)
      switchon GetCommand()<<Mark.mark into
         [
         case markYes:
            [
            if ok then FTPM(markYes, 0, "Store completed")
            endcase
            ]
         case markNo:
            [
            if ok then FTPM(markNo, 106b, "Store NOT completed")
            ok = false
            endcase
            ]
         default: ServProtocolError()  //falls through
         case 0: ok = false; endcase
         ]
      ]
   (CtxRunning>>FtpCtx.StoreCleanup)(remotePL, ok, localPL)
   ]
FreePList(remotePL)
]

//-----------------------------------------------------------------------------------------
and ServDelete() be
//-----------------------------------------------------------------------------------------
// If FtpCtx.Delete returns false then
//   it will never again be called
// If FtpCtx.Delete returns true then
//   FtpCtx.DeleteFile MAY OR MAY NOT be called
[
let remotePL = ScanPList(); if remotePL eq 0 return
let localPL = 0
   [
   localPL = (CtxRunning>>FtpCtx.Delete)(remotePL, localPL)
   if localPL eq 0 break
   FTPM(markHereIsPList)
   GeneratePList(localPL)
   switchon GetCommand()<<Mark.mark into
      [
      case markEndOfCommand: [ FTPM(markEndOfCommand); endcase ]
      case markYes:
         [
         if (CtxRunning>>FtpCtx.DeleteFile)(localPL, remotePL) then
            FTPM(markYes, 0, "File Deleted")
         break
         ]
      default: ServProtocolError()  //falls through
      case markNo: case 0: break
      ] repeat
   ] repeat
FreePList(remotePL)
]

//-----------------------------------------------------------------------------------------
and ServDirectory(new) be
//-----------------------------------------------------------------------------------------
// If FtpCtx.Directory ever returns false then
//   it will never be called again
[
let remotePL = ScanPList(); if remotePL eq 0 return
let localPL = 0
let firstTime = true
   [
   localPL = (CtxRunning>>FtpCtx.Directory)(remotePL, localPL)
   if localPL eq 0 break
   if firstTime % not new then FTPM(markHereIsPList)
   GeneratePList(localPL)
   firstTime = false
   ] repeat
FreePList(remotePL)
]

//-----------------------------------------------------------------------------------------
and ServRename() be
//-----------------------------------------------------------------------------------------
[
let oldPL = ScanPList(); if oldPL eq 0 return
let newPL = ScanPList(); if newPL ne 0 then
   if (CtxRunning>>FtpCtx.Rename)(oldPL, newPL) then
      FTPM(markYes, 0, "Renamed ok")
FreePList(newPL)
FreePList(oldPL)
]