// FtpKbd2.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 20, 1982  5:34 PM by Boggs

get "PupParams.decl"
get "FtpProt.decl"
get "FtpUser.decl"
get "AltoFileSys.d"
get "CmdScan.decl"

external
[
// outgoing procedures
KbdDelete; KbdRename; KbdCompare; KbdList

// incoming procedures from FtpUserProt
UserDelete; UserRename; UserDirectory; UserRetrieve

// incoming procedures from FtpUtil
FileType; CompareNetWithDisk

// incoming procedures from FtpPlist
FreePList; InitPList

// incoming procedures from FtpMisc
ProcessNoCode; CloseLocalFile

// incoming misc procedures
ListPrint; ListPuts
PutTemplate; Wss; Puts; Closes; Resets; Errors
Zero; SetBlock; SysErr; ExtractSubstring

GetString; GetFile; GetKeyword; Confirm
GetPhrase; TerminatingChar; InitCmd; DefBreak
EnableCatch; EndCatch; DefaultPhrase

// incoming statics
ftpDisk; defaultPL; CtxRunning
kbdCS; listKT; listST; userDsp; userKeys
]

structure String [ length byte; char^1,1 byte ]

//-----------------------------------------------------------------------------------------
let KbdDelete() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "remote file ")
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = InitPList(defaultPL)
localPL>>PL.SFIL = GetString(kbdCS)
localPL>>PL.DPRP.SFIL = true
localPL>>PL.DPRP.NAMB = true
   [
   let mark = UserDelete(localPL, KbdDeleteFile)
   if mark<<Mark.mark eq markEndOfCommand break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
FreePList(localPL)
]

//-----------------------------------------------------------------------------------------
and KbdDeleteFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let doit = nil
let cs = InitCmd(256, 3, 0, 0, 0, userKeys, userDsp)
test cs eq 0
   ifso doit = false
   ifnot
      [
      PutTemplate(cs, "*NDelete $S",
       (remotePL>>PL.SFIL? remotePL>>PL.SFIL, remotePL>>PL.NAMB))
      doit = Confirm(cs)
      Closes(cs)
      ]
unless doit do Wss(userDsp, " - Not deleted")
resultis doit
]

//-----------------------------------------------------------------------------------------
and KbdRename() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "remote file ")
let oldPL = 0
if EnableCatch(kbdCS) then [ FreePList(oldPL); EndCatch(kbdCS) ]
oldPL = InitPList(defaultPL)
oldPL>>PL.SFIL = GetString(kbdCS)
Wss(kbdCS, " to be ")
let newPL = 0
if EnableCatch(kbdCS) then [ FreePList(newPL); EndCatch(kbdCS) ]
newPL = InitPList(defaultPL)
newPL>>PL.SFIL = GetString(kbdCS)
   [
   let mark = UserRename(oldPL, newPL)
   if mark<<Mark.mark eq markYes then
      [ Wss(userDsp, " - Done"); break ]
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, oldPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
FreePList(oldPL)
FreePList(newPL)
]

//-----------------------------------------------------------------------------------------
and KbdCompare() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "remote file ")
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = InitPList(defaultPL)
localPL>>PL.SFIL = GetString(kbdCS)
localPL>>PL.DPRP.SFIL = true
localPL>>PL.DPRP.NAMB = true
localPL>>PL.DPRP.TYPE = true
localPL>>PL.DPRP.BYTE = true
   [
   let mark = UserRetrieve(localPL, KbdCompareWantFile, CloseLocalFile)
   if mark<<Mark.mark eq markEndOfCommand break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
FreePList(localPL)
CloseLocalFile()
]

//-----------------------------------------------------------------------------------------
and KbdCompareWantFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
if remotePL>>PL.NAMB eq 0 resultis false
if remotePL>>PL.SFIL eq 0 then
   remotePL>>PL.SFIL = ExtractSubstring(remotePL>>PL.NAMB)
let cs = InitCmd(256, 5, 0, 0, 0, userKeys, userDsp)
if cs eq 0 resultis false  //user typed delete
PutTemplate(cs, "*N$S to local file ", remotePL>>PL.SFIL)
DefaultPhrase(cs, remotePL>>PL.NAMB)
CtxRunning>>FtpCtx.diskStream = GetFile(cs, ksTypeReadOnly,
 charItem, 0, 0, 0, 0, 0, ftpDisk)
Closes(cs)
Puts(userDsp, $*N)
resultis CompareNetWithDisk
]

//-----------------------------------------------------------------------------------------
and KbdList() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "remote files matching ")
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = InitPList(defaultPL)
localPL>>PL.SFIL = GetString(kbdCS)

let options = 1b15 rshift offset DPRP.SFIL
if TerminatingChar(kbdCS) eq $*n then
   [
   let sfil = localPL>>PL.SFIL
   let length = sfil>>String.length
   if sfil>>String.char^length eq $, then
      [
      length = length -1
      sfil>>String.length = length
      if length eq 0 then Errors(kbdCS, ecCmdDestroy)
         [
         let cs = InitCmd(20, 2, 0, 0, 0, userKeys, userDsp)
         if cs eq 0 then Errors(kbdCS, ecCmdDestroy)
         Wss(cs, "*N****")
         let kte = GetKeyword(cs, listKT, true)
         if kte eq 0 then
            [
            Resets(cs)  //0 characters?
            if GetPhrase(cs) ne 0 then Errors(cs, ecKeyNotFound)
            ]
         Closes(cs)
         test kte ne 0
            ifso options = options % kte!0
            ifnot break
         ] repeat
      ]
   ]
localPL>>PL.DPRP = options
if localPL>>PL.DPRP.TYPE then localPL>>PL.DPRP.BYTE = true
let v = vec lST; listST = v; SetBlock(listST, SysErr, lST)
listST>>ST.puts = ListPuts
listST>>ST.par1 = options
listST>>ST.par3 = options ne 0

   [
   let mark = UserDirectory(localPL, ListPrint)
   if mark<<Mark.mark eq markEndOfCommand break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat

FreePList(localPL)
]