// FtpCli1.bcpl -- data transfer commands
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 21, 1982  6:23 PM by Boggs

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

external
[
// outgoing procedures
CliStore; CliRetrieve; CliDump; CliLoad

// incoming procedures from FtpUserProt
UserStore; UserRetrieve; UserDirectory

// incoming procedures from FtpUtil
DiskToNet; NetToDisk; DumpToNet; LoadFromNet
FTPM; DblUsc; FillPLFromLD

// incoming procedures from FtpMiscB
CloseLocalFile; MakeNAMB; ProcessNoCode; FreePointer

// incoming procedures form FtpPlist
FreePList; InitPList; WritePTV

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

// miscellaneous
ExtractSubstring; StringCompare; CopyString
Allocate; Free; Zero; MoveBlock; CallSwat
OpenFile; DeleteFile; LookupEntries
ReadLeaderPage; WriteLeaderPage
Closes; Puts; Enqueue; Dequeue
PutTemplate; Wss

// incoming statics
sysZone; ftpDisk; defaultPL; CtxRunning
userDsp; cli; mt; fpSysDir

overwrite; selective; verify
all; dates; update
]

manifest maxNames = 50

static [ nameVec; cdat; newVers ]

structure String [ length byte; char^1,1 byte ]

//-----------------------------------------------------------------------------------------
let CliStore() be
//-----------------------------------------------------------------------------------------
[
selective, verify = false, false
all, dates, update = false, false, false
CliSwitches()

let localPL = 0
nameVec = Allocate(sysZone, maxNames); Zero(nameVec, maxNames)
let dvVec = Allocate(sysZone, lDV*maxNames)
let numNames = 0  //number of valid entries in nameVec
let nameIndex = 0  //name we are working on
let firstTime = true
   [  //giant repeat loop
   if selective & not firstTime break
   if nameIndex eq numNames then  //nameVec is empty.  fill it.
      [
      if cli ne 0 break  //exhausted nameVec and bumped into a command
      numNames, nameIndex = 0, 0
      for i = 0 to maxNames-1 do FreePointer(nameVec+i)
      for i = 0 to maxNames-1 do
         [
         cli = CliGetString(false); if IsCommand() break
         nameVec!i = cli; cli = 0; numNames = numNames+1
         ]
      if numNames eq 0 break  //didn't find any.  we are done.
      let sysDir = OpenFile("SysDir", 0, 0, 0, fpSysDir, 0, 0, 0, ftpDisk)
      if sysDir eq 0 then CallSwat("Can't open sysDir!")
      LookupEntries(sysDir, nameVec, dvVec, numNames, true)
      Closes(sysDir)
      ]

   if selective & numNames ne 2 then
      [ CliError("Store/S must specifiy EXACTLY 2 filenames"); break ]
   let dv = dvVec + lDV*nameIndex
   let fp = dv + offset DV.fp/16
   let name = nameVec!nameIndex
   PutTemplate(userDsp, "$S$S", (firstTime? "", "*N**Store "), name)
   firstTime = false
   CtxRunning>>FtpCtx.diskStream = OpenFile(name, ksTypeReadOnly, charItem,
    0, fp, 0, 0, 0, ftpDisk)
   nameIndex = nameIndex+1
   if CtxRunning>>FtpCtx.diskStream eq 0 then
      [ CliError(" - No such file"); loop ]

   localPL = FillPLFromLD()
   if dates then PutTemplate(userDsp, " [$P]", WritePTV, lv localPL>>PL.CDAT)
   Wss(userDsp, " as remote file ")
   test selective
      ifso
         [
         localPL>>PL.SFIL = nameVec!1; nameVec!1 = 0
         Wss(userDsp, localPL>>PL.SFIL)
         ]
      ifnot
         [
         localPL>>PL.NAMB = MakeNAMB(name)
         Wss(userDsp, localPL>>PL.NAMB)
         ]

// CliStore (cont'd)

   let mark, ok = 0, true
   if update % verify % dates then
      [
      localPL>>PL.DPRP.CDAT = true
      localPL>>PL.DPRP.VERS = true
      mt>>MT.ptx^markNo = false
      let v = vec 2; Zero(v, 2); cdat = v
      newVers = true
         [
         mark = UserDirectory(localPL, CliStoreList)
         if mark<<Mark.mark eq markNo then
            test mark<<Mark.subCode eq 100b  // file not found
               ifso
                  [
                  Wss(userDsp, " [New file]")
                  if update then ok = all
                  ]
               ifnot if ProcessNoCode(mark<<Mark.subCode, localPL) loop
         if mark<<Mark.mark eq markEndOfCommand then
            [
            if update then
               ok = (((table [ dLS; dEQ; dGR ]+1)!DblUsc(lv localPL>>PL.CDAT, cdat)) & update) ne 0
            test dates
               ifso PutTemplate(userDsp, " [$P]", WritePTV, cdat)
               ifnot test newVers
                  ifso Wss(userDsp, " [New version]")
                  ifnot Wss(userDsp, " [Old file]")
            ]
         break
         ] repeat
      mt>>MT.ptx^markNo = true
      ]

   if ok & verify then ok = CliConfirm()
   localPL>>PL.DPRP = 0
   localPL>>PL.DPRP.SFIL = true
   if ok then
      [
      mark = UserStore(localPL, CliStoreFile)
      if mark<<Mark.mark eq markNo then
         if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      break
      ] repeat
   if mark ne markYes then Wss(userDsp, " - NOT stored")

   CloseLocalFile()
   localPL = FreePList(localPL)
   if mark eq 0 break
   ] repeat

CloseLocalFile()
FreePList(localPL)
for i = 0 to maxNames-1 do FreePointer(nameVec+i)
Free(sysZone, nameVec)
Free(sysZone, dvVec)
]

//-----------------------------------------------------------------------------------------
and CliStoreFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
if remotePL eq 0 then remotePL = localPL
PutTemplate(userDsp, "*N$S, ", remotePL>>PL.SFIL)
resultis DiskToNet(remotePL, localPL)
]

//-----------------------------------------------------------------------------------------
and CliStoreList(remotePL, localPL) be
//-----------------------------------------------------------------------------------------
[
if DblUsc(lv remotePL>>PL.CDAT, cdat) gr 0 then
   MoveBlock(cdat, lv remotePL>>PL.CDAT, 2)
newVers = remotePL>>PL.VERS ne 0
]

//-----------------------------------------------------------------------------------------
and CliRetrieve() be
//-----------------------------------------------------------------------------------------
[
overwrite = true
selective, verify = false, false
all, dates, update = false, false, false
CliSwitches()

let firstTime = true
   [
   cli = CliGetString(false); if IsCommand() return
   unless firstTime do Wss(userDsp, "*N**Retrieve ")
   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
   localPL>>PL.DPRP.CDAT = true
   localPL>>PL.DPRP.SIZE = true
   if dates % update then localPL>>PL.DPRP.CDAT = true
   let mark = nil
      [
      mark = UserRetrieve(localPL, CliRetrieveWantFile, CliRetrieveCleanup)
      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 CliRetrieveWantFile(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)
if selective then
   [
   FreePointer(lv remotePL>>PL.NAMB)
   remotePL>>PL.NAMB = CliGetString()
   ]
test CliOpenLocalFile(remotePL)
   ifnot [ Wss(userDsp, " - Not retrieved"); resultis false ]
   ifso [ Puts(userDsp, $*N); resultis NetToDisk ]
]

//-----------------------------------------------------------------------------------------
and CliRetrieveCleanup(remotePL, ok) be
//-----------------------------------------------------------------------------------------
[
CloseLocalFile()
unless ok do DeleteFile(remotePL>>PL.NAMB, 0, 0, 0, 0, ftpDisk)
]

//-----------------------------------------------------------------------------------------
and CliDump() be
//-----------------------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString(); if IsCommand() return
PutTemplate(userDsp, "to remote file $S", cli)
let localPL = InitPList(defaultPL)
localPL>>PL.TYPE = Binary
localPL>>PL.BYTE = 8
localPL>>PL.SFIL = cli; cli = 0
localPL>>PL.DPRP.SFIL = true
   [
   let mark = UserStore(localPL, CliDumpFile)
   if mark<<Mark.mark eq markYes break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot CliError(" - command failed")
   break
   ] repeat
CloseLocalFile()
FreePList(localPL)
]

//-----------------------------------------------------------------------------------------
and CliDumpFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let itWentOK = true
let nameVec = Allocate(sysZone, maxNames); Zero(nameVec, maxNames)
let dvVec = Allocate(sysZone, lDV*maxNames)
let numNames = 0  //number of valid entries in nameVec
let nameIndex = 0  //name we are working on
FTPM(markHereIsFile)
   [  //repeat
   if nameIndex eq numNames then  //nameVec is empty.  fill it.
      [
      if cli ne 0 break
      numNames, nameIndex = 0, 0
      for i = 0 to maxNames-1 do FreePointer(nameVec+i)
      for i = 0 to maxNames-1 do
         [
         cli = CliGetString(false); if IsCommand() break
         nameVec!i = cli; cli = 0; numNames = numNames+1
         ]
      if numNames eq 0 break  //didn't find any.  we are done.
      let sysDir = OpenFile("SysDir", 0, 0, 0, fpSysDir, 0, 0, 0, ftpDisk)
      if sysDir eq 0 then CallSwat("Can't open sysDir!")
      LookupEntries(sysDir, nameVec, dvVec, numNames, true)
      Closes(sysDir)
      ]

   let dv = dvVec + lDV*nameIndex
   let fp = dv + offset DV.fp/16
   let name = nameVec!nameIndex; nameIndex = nameIndex+1
   PutTemplate(userDsp, "*N$S _ $S", remotePL>>PL.SFIL, name)
   CtxRunning>>FtpCtx.diskStream = OpenFile(name, ksTypeReadOnly, charItem,
    0, fp, 0, 0, 0, ftpDisk)
   if CtxRunning>>FtpCtx.diskStream eq 0 then
      [ CliError(" - No such file"); loop ]
   FreePointer(lv localPL>>PL.NAMB)
   localPL>>PL.NAMB = ExtractSubstring(name)
   let ld = CtxRunning>>FtpCtx.buffer
   ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
   MoveBlock(lv localPL>>PL.CDAT, lv ld>>LD.created, 2)
   itWentOK = DumpToNet(remotePL, localPL)
   CloseLocalFile()
   unless itWentOK break
   ] repeat

if itWentOK then DumpToNet(0)  //write END block
for i = 0 to maxNames-1 do FreePointer(nameVec+i)
Free(sysZone, nameVec)
Free(sysZone, dvVec)
resultis itWentOK
]

//-----------------------------------------------------------------------------------------
and CliLoad() be
//-----------------------------------------------------------------------------------------
[
overwrite = true
selective, verify = false, false
all, dates, update = false, false, false
CliSwitches()

let firstTime = true
   [
   cli = CliGetString(false); if IsCommand() return
   unless firstTime do Wss(userDsp, "*N**Load ")
   firstTime = false
   PutTemplate(userDsp, "from remote file $S", cli)
   let localPL = InitPList(defaultPL)
   localPL>>PL.TYPE = Binary
   localPL>>PL.BYTE = 8
   localPL>>PL.SFIL = cli; cli = 0
   localPL>>PL.DPRP.SFIL = true
   localPL>>PL.DPRP.NAMB = true
   localPL>>PL.DPRP.BYTE = true
   localPL>>PL.DPRP.TYPE = true

   if selective then
      [
      let t = vec 1; t!0 = 0; nameVec = t
         [
         cli = CliGetString(false); if IsCommand() break
         if cli>>String.char^(cli>>String.length) eq $. then
            cli>>String.length = cli>>String.length -1
         let t = Allocate(sysZone, cli>>String.length lshift 1 +2)
         CopyString(t+1, cli); FreePointer(lv cli)
         Enqueue(nameVec, t)
         ] repeat
      if nameVec!0 eq 0 then selective = false
      ]

   let mark = nil
      [
      mark = UserRetrieve(localPL, CliLoadWantFile)
      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 selective then
      [
      while nameVec!0 ne 0 do
         Free(sysZone, Dequeue(nameVec))
      break
      ]
   if mark eq 0 break  //catastrophic error
   ] repeat
]

//-----------------------------------------------------------------------------------------
and CliLoadWantFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
unless remotePL>>PL.TYPE eq Binary & remotePL>>PL.BYTE eq 8 do
   [
   CliError("*N$S skipped - not in dump format", false, remotePL>>PL.SFIL)
   resultis false
   ]
resultis CliLoadFile
]

//-----------------------------------------------------------------------------------------
and CliLoadFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let more = LoadFromNet(remotePL, localPL)
CloseLocalFile()
unless more resultis true
FreePointer(lv remotePL>>PL.SFIL)
remotePL>>PL.SFIL = ExtractSubstring(remotePL>>PL.NAMB)
let found = not selective
if selective then
   [
   let name = nameVec!0
   while name ne 0 do
      [
      let namb = remotePL>>PL.NAMB
      if namb>>String.char^(namb>>String.length) eq $. then
         namb>>String.length = namb>>String.length -1
      if StringCompare(name+1, namb) eq 0 then [ found = true; break ]
      name = name!0
      ]
   ]
test found
   ifso CliOpenLocalFile(remotePL)
   ifnot PutTemplate(userDsp, "*N$S", remotePL>>PL.NAMB)
] repeat

//-----------------------------------------------------------------------------------------
and CliOpenLocalFile(pl) = valof
//-----------------------------------------------------------------------------------------
// Handles the all, overwrite, update, dates, and verify flags.
// Returns true with CtxRunning>>FtpCtx.diskStream open for writing,
//  or zero if the file should be skipped.
[
PutTemplate(userDsp, "*N$S", pl>>PL.SFIL)
if dates then PutTemplate(userDsp, " [$P]", WritePTV, lv pl>>PL.CDAT)
PutTemplate(userDsp, " to local file $S", pl>>PL.NAMB)

let hintFP = vec lFP; Zero(hintFP, lFP)
CtxRunning>>FtpCtx.diskStream = OpenFile(pl>>PL.NAMB,
 ksTypeReadOnly, charItem, verLatest, hintFP, 0, 0, 0, ftpDisk)
let ld = CtxRunning>>FtpCtx.buffer

let ok = true
test CtxRunning>>FtpCtx.diskStream eq 0
   ifso
      [
      Wss(userDsp, " [New file]")
      if update then ok = all
      ]
   ifnot
      [
      if dates % update then
         ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
      if update then
         ok = (((table [ dLS; dEQ; dGR ]+1)!DblUsc(lv pl>>PL.CDAT, lv ld>>LD.created)) & update) ne 0
      test dates
         ifso PutTemplate(userDsp, " [$P]", WritePTV, lv ld>>LD.created)
         ifnot Wss(userDsp, " [Old file]")
      unless overwrite do ok = false
      CloseLocalFile()
      ]

if ok & verify then ok = CliConfirm()
if ok then
   [
   CtxRunning>>FtpCtx.diskStream = OpenFile(pl>>PL.NAMB,
    ksTypeWriteOnly, charItem, 0, hintFP, 0, 0, 0, ftpDisk)
   if CtxRunning>>FtpCtx.diskStream eq 0 resultis CliError(" - Open Failed")
   if pl>>PL.CDAT.h ne 0 then  // remove when Juniper implements dates
      [
      ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
      MoveBlock(lv ld>>LD.created, lv pl>>PL.CDAT, 2)
      WriteLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
      ]
   ]

resultis ok
]