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

get "FtpProt.decl"
get "FtpUser.decl"
get "AltoFileSys.d"
get "Streams.d"

external
[
// outgoing procedures
CliDelete; CliRename; CliCompare; CliList

// incoming procedures from FtpCliUtil
CliSwitches; BadSwitch; IsCommand
CliGetString; CliConfirm; CliError

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

// incoming procedures from FtpUtil
FileType; CompareNetWithDisk

// incoming procedures from FtpPlist
FreePList; InitPList; WritePTV

// incoming procedures from FtpMisc
ProcessNoCode; CloseLocalFile; FreePointer

// incoming misc procedures
ListPrint; ListPuts
ExtractSubstring; PutTemplate; Wss; Puts
Zero; SetBlock; Free; SysErr; OpenFile

// incoming statics
sysZone; ftpDisk; CtxRunning
defaultPL; userDsp; cli; listST
selective; verify; dates
]

structure String [ length byte; char↑1,1 byte ]

//-----------------------------------------------------------------------------------------
let CliDelete() be
//-----------------------------------------------------------------------------------------
[
dates, verify = false, false
CliSwitches()

let firstTime = true
   [
   cli = CliGetString(false); if IsCommand() return
   unless firstTime do Wss(userDsp, "*N**Delete ")
   firstTime = false
   PutTemplate(userDsp, "remote file $S", cli)
   let localPL = InitPList(defaultPL)
   localPL>>PL.SFIL = cli; cli = 0
   localPL>>PL.DPRP.SFIL = true
   if dates then localPL>>PL.DPRP.CDAT = true
   let mark = nil
      [
      mark = UserDelete(localPL, CliDeleteFile)
      if mark<<Mark.mark eq markEndOfCommand break
      test mark<<Mark.mark eq markNo
         ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
         ifnot CliError(" - command failed")
      break
      ] repeat
   FreePList(localPL)
   if mark eq 0 return  //catastrophic error
   ] repeat
]

//-----------------------------------------------------------------------------------------
and CliDeleteFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
PutTemplate(userDsp, "*NDelete $S",
 (remotePL>>PL.SFIL? remotePL>>PL.SFIL, remotePL>>PL.NAMB))
if dates then PutTemplate(userDsp, " [$P]", WritePTV, lv remotePL>>PL.CDAT)
let doit = verify? CliConfirm(), true
unless doit do Wss(userDsp, " - Not deleted")
resultis doit
]

//-----------------------------------------------------------------------------------------
and CliCompare() be
//-----------------------------------------------------------------------------------------
[
selective = false
CliSwitches()

let firstTime = true
   [
   cli = CliGetString(false)
   if IsCommand() return
   unless firstTime do Wss(userDsp, "*N**Compare ")
   firstTime = false
   PutTemplate(userDsp, "remote file $S", cli)
   let localPL = InitPList(defaultPL)
   localPL>>PL.SFIL = cli; cli = 0
   localPL>>PL.DPRP.SFIL = true
   localPL>>PL.DPRP.NAMB = true
   localPL>>PL.DPRP.TYPE = true
   localPL>>PL.DPRP.BYTE = true
   let mark = nil
      [
      mark = UserRetrieve(localPL, CliCompareWantFile, CloseLocalFile)
      if mark<<Mark.mark eq markEndOfCommand break
      test mark<<Mark.mark eq markNo
         ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
         ifnot CliError(" - command failed")
      break
      ] repeat
   CloseLocalFile()
   FreePList(localPL)
   if mark eq 0 % (selective & mark ne markEndOfCommand) break
   ] repeat
]

//-----------------------------------------------------------------------------------------
and CliCompareWantFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
if remotePL>>PL.NAMB eq 0 resultis false
cli = selective? CliGetString(), ExtractSubstring(remotePL>>PL.NAMB)
PutTemplate(userDsp, "*N$S with local file $S",
 (remotePL>>PL.SFIL? remotePL>>PL.SFIL, remotePL>>PL.NAMB), cli)
CtxRunning>>FtpCtx.diskStream = OpenFile(cli, ksTypeReadOnly,
 charItem, 0, 0, 0, 0, 0, ftpDisk)
FreePointer(lv cli)
test CtxRunning>>FtpCtx.diskStream eq 0
   ifso [ CliError(" - No such file"); resultis false ]
   ifnot [ Puts(userDsp, $*N); resultis CompareNetWithDisk ]
]

//----------------------------------------------------------------------------------------
and CliList() be
//----------------------------------------------------------------------------------------
[
let options, length = 1b15 rshift offset DPRP.SFIL, cli>>String.length+1
for i = 1 to cli>>String.char↑length do
   options = options % selecton cli>>String.char↑(length+i) into
      [
      case $A: case $a: lbAuthor
      case $C: case $c: case $-: 0
      case $D: case $d: lbCreate
      case $E: case $e: lbEverything
      case $L: case $l: lbLength
      case $R: case $r: lbRead
      case $T: case $t: lbType
      case $V: case $v: lbVerbose
      case $W: case $w: lbWrite
      default: valof [ BadSwitch(i); resultis 0 ]
      ]

FreePointer(lv cli)
let v = vec lST; listST = v; SetBlock(listST, SysErr, lST)
listST>>ST.puts = ListPuts
listST>>ST.par1 = options
listST>>ST.par3 = true
let firstTime = true
   [
   cli = CliGetString(false); if IsCommand() return
   unless firstTime do Wss(userDsp, "*N**List ")
   firstTime = false
   PutTemplate(userDsp, "remote files matching $S", cli)
   let localPL = InitPList(defaultPL)
   localPL>>PL.DPRP = options
   if localPL>>PL.DPRP.TYPE then localPL>>PL.DPRP.BYTE = true
   localPL>>PL.SFIL = cli; cli = 0
   let mark = nil
      [
      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 CliError(" - command failed")
      break
      ] repeat
   FreePList(localPL)
   if mark eq 0 return  //catastrophic error
   ] repeat
]

//-----------------------------------------------------------------------------------------
and CliRename() be
//-----------------------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString()
if IsCommand() return
let oldName = cli; cli = CliGetString()
if IsCommand() then [ Free(sysZone, oldName); return ]
PutTemplate(userDsp, "remote file $S to be $S", oldName, cli)
let oldPL = InitPList(defaultPL)
oldPL>>PL.SFIL = oldName
let newPL = InitPList(defaultPL)
newPL>>PL.SFIL = cli; cli = 0
   [
   let mark = UserRename(oldPL, newPL)
   if mark<<Mark.mark eq markYes break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, oldPL) loop
      ifnot CliError(" - command failed")
   break
   ] repeat
FreePList(oldPL)
FreePList(newPL)
]