// FtpUserProtMail.bcpl -- User FTP Mail protocol
// Copyright Xerox Corporation 1979, 1980
// Last modified December 25, 1980  7:21 PM by Boggs

get "FtpProt.decl"

external
[
// outgoing procedures
UserStoreMail; UserRetrieveMail

// incoming procedrues
UserGetYesNo; UserFlushEOC; UserProtocolError
FTPM; GetCommand; GeneratePList

// incoming statics
CtxRunning
]

structure String [ length byte; char↑1,1 byte ]

//---------------------------------------------------------------------------
let UserRetrieveMail(pList, RetrieveMail) = valof
//---------------------------------------------------------------------------
// returns subcode,,mark or 0 if catastrophic error
[
compileif false then
[
FTPM(markRetrieveMail)
GeneratePList(pList)
FTPM(markEndOfCommand)

let mark = GetCommand()
switchon mark<<Mark.mark into
   [
   default: UserProtocolError()  //falls through
   case 0: resultis mark
   case markNo: case markYes: [ UserFlushEOC(); resultis mark ]
   case markHereIsPList: endcase
   ]

// *** This is unfinished. ***

mark = UserGetYesNo(true)
if mark eq 0 % mark<<Mark.mark eq markNo resultis mark

FTPM(markFlushMailBox, 0, 0, true)
mark = UserGetYesNo(true)
resultis mark
]
]

//---------------------------------------------------------------------------
and UserStoreMail(PListGen, ExcpHandler, Xfer) = valof
//---------------------------------------------------------------------------
// returns subcode,,mark or 0 if catastrophic error
[
FTPM(markStoreMail)
let pList = 0
   [
   pList = PListGen(pList); if pList eq 0 break
   GeneratePList(pList)
   ] repeat
FTPM(markEndOfCommand)

let mark = HandleExceptions(ExcpHandler)
if mark<<Mark.mark ne markYes resultis mark

if Xfer() then FTPM(markYes, 0, "Transfer Complete", true)

resultis HandleExceptions(ExcpHandler)
]

//---------------------------------------------------------------------------
and HandleExceptions(ExcpHandler) = valof
//---------------------------------------------------------------------------
// This is a variant of UserGetYesNo which also handles mailbox exceptions
[
let mark = GetCommand()
switchon mark<<Mark.mark into
   [
   default: UserProtocolError()  // falls through
   case 0: resultis 0
   case markYes: case markNo: resultis UserFlushEOC()? mark, 0
   case markMailboxException:
      [
      let index = 0
      let getCmdString = CtxRunning>>FtpCtx.getCmdString
      for i = 1 to getCmdString>>String.length do
         switchon getCmdString>>String.char↑i into
            [
            case $0 to $9:
               [ index = index*10 + getCmdString>>String.char↑i-$0; endcase ]
            default:
               [ UserProtocolError(); resultis 0 ]
            case $*S: break
            ]
      ExcpHandler(mark<<Mark.subCode, index)
      endcase
      ]
   ]
] repeat