// FtpKbd.bcpl - Keyboard command interpreter
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified December 12, 1981  1:05 AM by Boggs

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

external
[
// outgoing procedures
FtpKbd
KbdOpen; KbdClose; KbdByte; KbdDirectory; KbdDevice
KbdType; KbdEol; KbdLogin; KbdConnect; KbdVersion
KbdQuit; KbdUser; KbdTelnet; KbdServer

// incoming procedures
OpenUserConn; UserClose
Block; FreePointer
GetNamePassword; GetPartner
Endofs; Puts; Closes; Errors; Resets; Wss

Confirm; GetString; GetKeyword; GetNumber
InitCmd; DefaultPhrase; CmdError; GetPhrase

// outgoing static
kbdCS

// incoming statics
CtxRunning; hostName; defaultPL
eolcKT; typeKT; kbdKT; servKT; userKT; chatKT
userSoc; userKeys; userDsp
]

static kbdCS

//---------------------------------------------------------------------------
let FtpKbd(ctx) be  // keyboard command context
//---------------------------------------------------------------------------
[
kbdCS = InitCmd(256, 5, 0, 0, 0, userKeys, userDsp) repeatuntil kbdCS ne 0
Wss(kbdCS, "*N**")
test hostName eq 0
   ifso while Endofs(userKeys) do
      [
      //Wait for type-in and blink the cursor.
      //If we have an open connecton, monitor its state.
      Block()
      if ctx>>FtpCtx.connFlag &
       userSoc>>BSPSoc.state ne stateOpen then
         [
         CmdError(kbdCS, "Connection closed by remote host.")
         UserClose(true)
         Errors(kbdCS, ecCmdDestroy)
         ]
      ]
   ifnot
      [
      DefaultPhrase(kbdCS, hostName, $*S)
      FreePointer(lv hostName)
      ]

let kte = GetKeyword(kbdCS, kbdKT, true)
Puts(kbdCS, $*S)
test kte ne 0
   ifso test kte>>cmdKTE.conReq & not ctx>>FtpCtx.connFlag
      ifso CmdError(kbdCS, "- Please 'OPEN' a connection first.")
      ifnot (kte>>cmdKTE.proc)()  //execute command
   ifnot  //Perhaps it's a host name or address
      [
      Resets(kbdCS)
      if ctx>>FtpCtx.connFlag then
         Errors(kbdCS, GetPhrase(kbdCS) eq 0? ecBackupReplace, ecKeyNotFound)
      KbdOpen(true)
      ]
Closes(kbdCS)
] repeat

//---------------------------------------------------------------------------
and KbdOpen(noNoise; numargs na) be
//---------------------------------------------------------------------------
[
if na ls 1 then noNoise = false
if CtxRunning>>FtpCtx.connFlag then
   [
   CmdError(kbdCS, "- there is already an open connection")
   return
   ]
unless noNoise do Wss(kbdCS, "connection with remote host ")
let host = GetString(kbdCS)
let frnport = vec lenPort
if GetPartner(host, userDsp, frnport, 0, socketFTP) then OpenUserConn(frnport)
FreePointer(lv host)
]

//---------------------------------------------------------------------------
and KbdClose() be
//---------------------------------------------------------------------------
// Close cancels any defaults (CONNECT, DIRECTORY, BYTE etc).
[
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 KbdLogin() be
//---------------------------------------------------------------------------
   GetNamePassword("user ", lv defaultPL>>PL.UNAM, lv defaultPL>>PL.UPSW)

//---------------------------------------------------------------------------
and KbdConnect() be
//---------------------------------------------------------------------------
// Connect cancels any previous DIRECTORY or DEVICE
[
GetNamePassword("to directory ", lv defaultPL>>PL.CNAM, lv defaultPL>>PL.CPSW)
FreePointer(lv defaultPL>>PL.DIRE, lv defaultPL>>PL.DEVI)
]

//---------------------------------------------------------------------------
and KbdByte() be defaultPL>>PL.BYTE = GetNumber(kbdCS)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdType() be defaultPL>>PL.TYPE = GetKeyword(kbdCS, typeKT)!0
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdEol() be defaultPL>>PL.EOLC = GetKeyword(kbdCS, eolcKT)!0
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdQuit() be finish
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdDirectory() be KbdGetString(lv defaultPL>>PL.DIRE)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdDevice() be KbdGetString(lv defaultPL>>PL.DEVI)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdVersion() be KbdGetString(lv defaultPL>>PL.VERS)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdUser() be KbdGetKeyword(userKT)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdTelnet() be (GetKeyword(kbdCS, chatKT)!0)()
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdServer() be KbdGetKeyword(servKT)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and KbdGetString(lvDest) be
//---------------------------------------------------------------------------
[
if @lvDest ne 0 then DefaultPhrase(kbdCS, @lvDest)
let string = GetString(kbdCS)
FreePointer(lvDest); @lvDest = string
]

//---------------------------------------------------------------------------
and KbdGetKeyword(kt) be
//---------------------------------------------------------------------------
[
let lvSwitch = GetKeyword(kbdCS, kt)!0
@lvSwitch = not @lvSwitch
Wss(kbdCS, (@lvSwitch? " Yes", " No"))
]