// FtpUserProtFile.bcpl - FTP User file protocol
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 30, 1983  5:50 PM by van Melle
// Last modified July 22, 1982  5:32 PM by Boggs

get "FtpProt.decl"

external
[
// outgoing procedures
UserStore; UserRetrieve; UserDirectory; UserDelete; UserRename

// incoming procedrues
UserGetYesNo; UserProtocolError; UserFlushEOC
FTPM; GetCommand; ScanPList; GeneratePList; FreePList
Wss; PutTemplate

// incoming statics
CtxRunning; mt
]

//-----------------------------------------------------------------------------------------
let UserDirectory(localPL, Directory) = valof
//-----------------------------------------------------------------------------------------
// Returns: subcode,,mark.  0 means catastrophic error.
[
let temp = mt>>MT.ptx↑markNo
mt>>MT.ptx↑markNo = false
let res = valof
   [
   FTPM(CtxRunning>>FtpCtx.newDirectory? markNewDirectory, markDirectory)
   GeneratePList(localPL)
   FTPM(markEndOfCommand)
      [
      let mark = GetCommand()
      switchon mark<<Mark.mark into
         [
         default: UserProtocolError()  //falls through
         case 0: resultis 0  //catastrophic errors
         case markNo:
            [
            UserFlushEOC()
            if CtxRunning>>FtpCtx.newDirectory & mark<<Mark.subCode eq 1 then
               [ CtxRunning>>FtpCtx.newDirectory = false; break ]
            if temp ne 0 then
               PutTemplate(CtxRunning>>FtpCtx.lst, "*N$S", CtxRunning>>FtpCtx.getCmdString)
            ]
         case markEndOfCommand: resultis mark  //normal end
         case markHereIsPList:
            [
            let remotePL = ScanPList()
            if remotePL eq 0 break
            Directory(remotePL, localPL)
            FreePList(remotePL)
            ] repeat
         ]
      ] repeat
   ] repeat
mt>>MT.ptx↑markNo = temp
resultis res
]

//-----------------------------------------------------------------------------------------
and UserRename(oldPL, newPL) = valof
//-----------------------------------------------------------------------------------------
// Returns subcode,,mark.  0 means catastrophic error.
[
FTPM(markRename)
GeneratePList(oldPL)
GeneratePList(newPL)
FTPM(markEndOfCommand)
resultis UserGetYesNo(true)
]

//-----------------------------------------------------------------------------------------
and UserDelete(localPL, Delete) = valof
//-----------------------------------------------------------------------------------------
// Returns subcode,,mark.  0 means catastrophic error.
[
FTPM(markDelete)
GeneratePList(localPL)
FTPM(markEndOfCommand)
   [
   let remotePL = 0
      [
      let mark = GetCommand()
      switchon mark<<Mark.mark into
         [
         default: UserProtocolError()  //falls through
         case 0: resultis 0  //catastrophic error
         case markNo: UserFlushEOC()  //falls through
         case markEndOfCommand: resultis mark
         case markHereIsPList:
            [
            remotePL = ScanPList()
            UserFlushEOC()
            if remotePL break
            FTPM(markEndOfCommand)
            Wss(CtxRunning>>FtpCtx.lst, "*NBad property list - file skipped")
            endcase
            ]
         ]
      ] repeat
   let okToDelete = Delete(remotePL, localPL)
   FreePList(remotePL)
   test okToDelete
      ifnot FTPM(markNo, 0, "Please don't delete that file", true)
      ifso
         [
         FTPM(markYes, 0, "Please delete that file", true)
         if UserGetYesNo(false) eq 0 resultis 0
         ]
   ] repeat
]

//-----------------------------------------------------------------------------------------
and UserStore(localPL, StoreFile) = valof
//-----------------------------------------------------------------------------------------
// Returns subcode,,mark.  0 means catastrophic error.
[
let temp = mt>>MT.ptx↑markNo
mt>>MT.ptx↑markNo = false
let res = valof
   [
   FTPM(CtxRunning>>FtpCtx.newStore? markNewStore, markStore)
   GeneratePList(localPL)
   FTPM(markEndOfCommand)

   let remotePL = 0
   let mark = GetCommand()
   switchon mark<<Mark.mark into
      [
      case markHereIsPList:
         [
         remotePL = ScanPList()
         UserFlushEOC()
         if remotePL eq 0 then  //plist module said [No]
            [
            FTPM(markEndOfCommand)
            resultis UserGetYesNo(true)
            ]
         endcase
         ]
      case markNo:
         [
         UserFlushEOC()
         if CtxRunning>>FtpCtx.newStore & mark<<Mark.subCode eq 1 then
            [ CtxRunning>>FtpCtx.newStore = false; loop ]
         if temp ne 0 then
            PutTemplate(CtxRunning>>FtpCtx.lst, "*N$S", CtxRunning>>FtpCtx.getCmdString)
         ]
      case 0: resultis mark
      case markYes: unless CtxRunning>>FtpCtx.newStore do [ UserFlushEOC(); endcase ]
      default: resultis UserProtocolError()
      ]

   mt>>MT.ptx↑markNo = temp
   if StoreFile(remotePL, localPL) then
      FTPM(markYes, 0, "Transfer Complete", true)
   FreePList(remotePL)
   resultis UserGetYesNo(true)
   ] repeat
mt>>MT.ptx↑markNo = temp
resultis res
]

//-----------------------------------------------------------------------------------------
and UserRetrieve(localPL, WantFile, Cleanup; numargs na) = valof
//-----------------------------------------------------------------------------------------
// Returns subcode,,mark.  0 means catastrophic error.
// If Cleanup is supplied, it is called after every call on RetrieveFile.
[
FTPM(markRetrieve)
GeneratePList(localPL)
FTPM(markEndOfCommand)
let remotePL = 0
let ok = valof
   [
      [
      let mark = GetCommand()
      switchon mark<<Mark.mark into
         [
         default: UserProtocolError()  //falls through
         case 0: resultis 0  //catastrophic error
         case markNo: UserFlushEOC()  //falls through
         case markEndOfCommand: resultis mark
         case markHereIsPList:
            [
            remotePL = ScanPList()
            UserFlushEOC()
            if remotePL ne 0 break
            FTPM(markEndOfCommand)
            Wss(CtxRunning>>FtpCtx.lst, "*NBad property list - file skipped")
            endcase
            ]
         ]
      ] repeat
   let RetrieveFile = WantFile(remotePL, localPL)
   test RetrieveFile eq 0
      ifso FTPM(markNo, 0, "No thanks", true)
      ifnot
         [
         FTPM(markYes, 0, "File open, ready for data", true)
	 let thismark = GetCommand()
         switchon thismark<<Mark.mark into
            [
            default: UserProtocolError()  //falls through
            case 0: resultis 0
            case markNo: [ ok = false; endcase ]
            case markHereIsFile:
               [
               ok = RetrieveFile(remotePL, localPL)
               unless UserGetYesNo(false) resultis 0
               endcase
               ]
            ]
         if na gr 2 then Cleanup(remotePL, ok, thismark)
         ]
   remotePL = FreePList(remotePL)
   ] repeat
FreePList(remotePL)
resultis ok
]