// FtpCli.bcpl - Com.cm command interpreter
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified December 12, 1981  1:06 AM by Boggs

get "Pup.decl"
get "FtpProt.decl"
get "FtpUser.decl"

external
[
// outgoing procedures
FtpCli
CliOpen; CliClose; CliByte; CliDirectory; CliDevice
CliType; CliEol; CliLogin; CliConnect; CliQuit
CliDebug; CliVersion; CliComment

// incoming procedures
OpenUserConn; UserClose
GetNamePassword; GetPartner
Puts; Wss; PutTemplate; Dismiss
LookupKeyword; ExtractSubstring
Nin; Free; FreePointer
CliGetString; CliSwitches
CliError; IsCommand

// incoming statics
CtxRunning; sysZone; hostName; defaultPL
eolcKT; typeKT; cliKT; query
userSoc; userDsp; cli; errorFlag
]

//---------------------------------------------------------------------------
let FtpCli(ctx) be  // command interpreter context
//---------------------------------------------------------------------------
[
Wss(userDsp, "*N**")
if ctx>>FtpCtx.connFlag & userSoc>>BSPSoc.state ne stateOpen then
   [
   UserClose(true)
   CliError("Connection closed by remote host.", false)
   ]
test hostName ne 0
   ifso CliOpen()  //special case: "Ftp <host> ..."
   ifnot
      [
      let kte = CliGetKeyword(cliKT)
      test kte eq 0
         ifso
            [
            Wss(userDsp, cli)
            CliError(" <- unknown command")
            Wss(userDsp, "*NIgnoring the following text: ")
               [
               Wss(userDsp,cli)
               FreePointer(lv cli)
               Puts(userDsp, $*S)
               cli = CliGetString(false)
               if IsCommand() break
               ] repeat
            ]
         ifnot
            [
            Puts(userDsp, $*S)
            test kte>>cmdKTE.conReq & not ctx>>FtpCtx.connFlag
               ifso CliError("- Connection required", false)
               ifnot (kte>>cmdKTE.proc)()  //execute command
            ]
      ]
] repeat

//---------------------------------------------------------------------------
and CliGetKeyword(kt) = valof
//---------------------------------------------------------------------------
// Returns a kte or 0.
// Outputs the keyword to userDsp if found.
[
if cli eq 0 then cli = CliGetString()
let string = nil
let kte = LookupKeyword(kt, cli, lv string)
if kte ne 0 then Wss(userDsp, string)
resultis kte
]

//---------------------------------------------------------------------------
and CliOpen() be
//---------------------------------------------------------------------------
// If hostName is nonzero, then we are opening the first connection,
//  which is not preceeded by the verb 'Open'.
[
test hostName ne 0
   ifso Wss(userDsp, "Open ")
   ifnot
      [
      FreePointer(lv cli)
      hostName = CliGetString()
      ]
PutTemplate(userDsp, "connection to $S", hostName)
test CtxRunning>>FtpCtx.connFlag
   ifso CliError("*NThere is already an open connection", false)
   ifnot
      [
      let port = vec lenPort
      if GetPartner(hostName, userDsp, port, 0, socketFTP) then
         unless OpenUserConn(port) do
            [
            CliError()
            Dismiss(500)  // 5 seconds
            loop
            ]
      ]
FreePointer(lv hostName)
return
] repeat

//---------------------------------------------------------------------------
and CliClose() be
//---------------------------------------------------------------------------
// Close cancels any defaults (CONNECT, DIRECTORY, BYTE etc).
[
FreePointer(lv cli)
UserClose(false)
defaultPL>>PL.BYTE = 0
defaultPL>>PL.TYPE = 0
defaultPL>>PL.EOLC = 0
FreePointer(lv defaultPL>>PL.DIRE, lv defaultPL>>FPL.DEVI,
 lv defaultPL>>PL.CNAM, lv defaultPL>>PL.CPSW, lv defaultPL>>PL.VERS)
]

//---------------------------------------------------------------------------
and CliByte() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString()
if IsCommand() return
Wss(userDsp, cli)
unless Nin(cli, lv defaultPL>>PL.BYTE) do CliError(" - illegal Byte-size")
FreePointer(lv cli)
]

//---------------------------------------------------------------------------
and CliType() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli)
let kte = CliGetKeyword(typeKT)
if IsCommand() return
test kte
   ifso defaultPL>>PL.TYPE = kte!0
   ifnot CliError(" - illegal Type")
FreePointer(lv cli)
]

//--------------------------------------------------------------------------
and CliEol() be
//--------------------------------------------------------------------------
[
FreePointer(lv cli)
let kte = CliGetKeyword(eolcKT)
if IsCommand() return
test kte
   ifso defaultPL>>PL.EOLC = kte!0
   ifnot CliError(" - illegal EOL convention")
FreePointer(lv cli)
]

//---------------------------------------------------------------------------
and CliDirectory() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString()
if IsCommand() return
Wss(userDsp, cli)
FreePointer(lv defaultPL>>PL.DIRE)
defaultPL>>PL.DIRE = cli; cli = 0
]

//---------------------------------------------------------------------------
and CliDevice() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString()
if IsCommand() return
Wss(userDsp, cli)
FreePointer(lv defaultPL>>PL.DEVI)
defaultPL>>PL.DEVI = cli; cli = 0
]

//---------------------------------------------------------------------------
and CliVersion() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString()
if IsCommand() return
Wss(userDsp, cli)
FreePointer(lv defaultPL>>PL.VERS)
defaultPL>>PL.VERS = cli; cli = 0
]

//---------------------------------------------------------------------------
and CliQuit() be finish
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and CliDebug() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli)
CtxRunning>>FtpCtx.debugFlag = not CtxRunning>>FtpCtx.debugFlag
PutTemplate(userDsp, "printout $S", CtxRunning>>FtpCtx.debugFlag? "on","off")
]

//---------------------------------------------------------------------------
and CliComment() be
//---------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString()
if IsCommand() return
PutTemplate(userDsp, "$S ", cli)
] repeat

//---------------------------------------------------------------------------
and CliConnect() be
//---------------------------------------------------------------------------
// Connect cancels any previous DIRECTORY
[
query = false
CliSwitches()
cli = CliGetString(); if IsCommand() return
PutTemplate(userDsp, "to directory $S", cli)
FreePointer(lv defaultPL>>PL.CNAM, lv defaultPL>>PL.DIRE)
defaultPL>>PL.CNAM = cli; cli = 0
test query
   ifso GetNamePassword(0, 0, lv defaultPL>>PL.CPSW)
   ifnot
      [
      FreePointer(lv defaultPL>>PL.CPSW)
      cli = CliGetString()
      if IsCommand() return
      defaultPL>>PL.CPSW = cli; cli = 0
      ]
]

//---------------------------------------------------------------------------
and CliLogin() be
//---------------------------------------------------------------------------
[
query = false
CliSwitches()
cli = CliGetString(); if IsCommand() return
PutTemplate(userDsp, "user $S", cli)
FreePointer(lv defaultPL>>PL.UNAM)
defaultPL>>PL.UNAM = cli; cli = 0
test query
   ifso GetNamePassword(0, 0, lv defaultPL>>PL.UPSW)
   ifnot
      [
      FreePointer(lv defaultPL>>PL.UPSW)
      cli = CliGetString()
      if IsCommand() return
      defaultPL>>PL.UPSW = cli; cli = 0
      ]
]