// 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")) ]