// FtpServProt.bcpl - Server FTP protocol routines
// Copyright Xerox Corporation 1979, 1980, 1982
// Last modified May 13, 1982  1:14 PM by Boggs

get "FtpProt.decl"

external
[
// outgoing procedures
FtpServProt; ServProtocolError

// incoming procedures
ServRetrieve; ServStore
ServDelete; ServDirectory; ServRename
ServStoreMail; ServRetrieveMail
GetCommand; FTPM
CloseBSPSocket; Free

// incoming statics
CtxRunning; defaultTimeout; sysZone
]

//-----------------------------------------------------------------------------------------
let FtpServProt(timeout) be
//-----------------------------------------------------------------------------------------
[
CtxRunning>>FtpCtx.serverFlag = true
   [
   let mark = GetCommand(timeout)<<Mark.mark
   switchon mark into
      [
      case markVersion: [ ServVersion(); endcase ]
      case markRetrieve: [ ServRetrieve(); endcase ]
      case markStore: [ ServStore(false); endcase ]
      case markNewStore: [ ServStore(true); endcase ]
      case markDelete: [ ServDelete(); endcase ]
      case markDirectory: [ ServDirectory(false); endcase ]
      case markNewDirectory: [ ServDirectory(true); endcase ]
      case markRename: [ ServRename(); endcase ]
      compileif MTP then
         [
         case markStoreMail: [ ServStoreMail(); endcase ]
         case markRetrieveMail: [ ServRetrieveMail(); endcase ]
         ]
      case markEndOfCommand: [ FTPM(markEndOfCommand); endcase ]
      case markComment: endcase
      case markNo: endcase
      case markHereIsPList:
      case markHereIsFile:
      case markYes:
      case markFlushMailBox: ServProtocolError()  //falls through
      case 0: break
      default: FTPM(markNo, 1, "Unimplemented Command [$O]", 0, mark)
      ]
   ] repeat
ServClose(false)
]

//-----------------------------------------------------------------------------------------
and ServVersion() be
//-----------------------------------------------------------------------------------------
   FTPM(markVersion, FTPVersion, "$P", false, CtxRunning>>FtpCtx.Version)

//-----------------------------------------------------------------------------------------
and ServProtocolError() be
//-----------------------------------------------------------------------------------------
[
FTPM(markNo, 3, "Protocol Error - Aborting connection")
ServClose(true)
]

//-----------------------------------------------------------------------------------------
and ServClose(abortIt) be
//-----------------------------------------------------------------------------------------
[
if CtxRunning>>FtpCtx.getCmdString then
   [
   Free(sysZone, CtxRunning>>FtpCtx.getCmdString)
   CtxRunning>>FtpCtx.getCmdString = 0
   ]
if CtxRunning>>FtpCtx.connFlag then
   [
   CtxRunning>>FtpCtx.connFlag = false
   CloseBSPSocket(CtxRunning>>FtpCtx.bspSoc, (abortIt? 0, defaultTimeout))
   ]
]