// TridentEFTP.bcpl

// last modified on October 24, 1980  11:18 AM by Butterfield
// - EFTP, add T global switch to go to Trident drive 0 - 10/23
// - EFTPCli, don't use GP to open the files - 10/23
// - derived from:
   // EFTP.bcpl -- top level routine and user interface for
   // the EFTP subsystem
   // June 17, 1976  3:44 PM  ap,bak,jfs
   // last modified on June 3, 1979  11:52 AM by Taft
   // Copyright Xerox Corporation 1979
//                                                 - 10/23/80

get "PupEFTP.decl"  //that will also get pup-related stuff
get "Streams.d"

external
[
//outgoing procedures
Msg

//incoming procedures
InitEFTPPackage; EFTPSendFile; EFTPReceiveFile
FixedLeft; GetFixed; InitializeZone; Allocate
InitializeContext; CallContextList; Block
InitPupLevel1; InitializeTimer; Enqueue; GetPartner
OpenFile; Closes; Endofs; Gets; Puts
Ws; Wl; Wo; Wns; CallSwat
SetupReadParam; ReadParam; EvalParam
LoadRam; SysErr; TFSInit; TFSClose; TFSSilentBoot;

//outgoing statics
EFTPZone; EFTPCtxq
EFTPFrnPort; EFTPLclPort; EFTPSocket

//incoming statics
keys;dsp
DiskRamImage; sysDisk;
]

compileif nova then [ external [ InitNovaAlto ] ]

static
[
eftpDisk;
EFTPZone;EFTPCtxq
EFTPFrnPort;EFTPLclPort;EFTPSocket

tempfile; tempstring
DebugSwitch = false
DebugConfirmSwitch = false
cliBody; cliSwitches   
]

manifest
[
cliStackSize = 3000
kbdStackSize = 3000
noHintFp = 0;  // so readers won't have to figure out what the argument is
]


//-----------------------------------------------------------------
let EFTP() be
//-----------------------------------------------------------------
[
let versionText = "EFTP of October 23, 1980"

//For the time being, allocate everything here
let frnPort = vec lenPort; EFTPFrnPort = frnPort
let lclPort = vec lenPort; EFTPLclPort = lclPort
let socket = vec lenEFTPSoc; EFTPSocket = socket
let tempString = vec 128; tempstring = tempString

compileif alto then [ Msg("Initialize zones") ]
let zoneSize = FixedLeft()-1500   //Set up a zone, for later use
if zoneSize ls 0 then zoneSize = #77777  //biggest Alloc can handle
EFTPZone = GetFixed(zoneSize)
InitializeZone(EFTPZone, zoneSize)
compileif nova then [ InitNovaAlto(EFTPZone) ]
Wl(versionText)
// Ws("["); Wns(dsp, zoneSize, 0, 10); Ws(" - (")
// Wns(dsp, zoneSize, 0, 10); Ws("+1) = ")
// Wns(dsp, FixedLeft(), 0, 10)
// Wl("]")

// Check for any global flags...  We will set it up here, others
// can read more of it later
let cli = false
let body = vec 256; cliBody = body
let switches = vec 128; cliSwitches = switches

// Read from the default, file COM.CM
SetupReadParam(cliBody, cliSwitches, 0, 0)
// Set global switch defaults
eftpDisk = sysDisk;
// Scan the global switches
for i = 1 to cliSwitches!0 switchon cliSwitches!i into
   [GlobalSwitchBlock
   case $d: case $D:
      [
      DebugSwitch = true
      endcase
      ]
   case $c: case $C:
      [
      DebugConfirmSwitch = true
      DebugSwitch = true
      endcase
      ]
   case $s: case $S:
      [
      CallSwat("Scanning global switches")
      endcase
      ]
   case $t: case $T:
      [
      if LoadRam(DiskRamImage, true) ls 0 then
       [ Wl("Cannot load ram"); finish; ]
      eftpDisk = TFSInit(EFTPZone, true);
      if eftpDisk eq 0 then [ Wl("Cannot initialize Trident"); finish; ]
      endcase
      ]
   default:
      [
      Ws("Unknown global switch: ")
      Puts(dsp, cliSwitches!i)
      Wl("")
      ]
   ]GlobalSwitchBlock

// See if there is anything else left in COM.CM, get unpacked string
ReadParam(0, 0, 0, 0, true)   //puts file name into cliBody
if cliBody!0 ne 0 then cli = true

// Major task here is to initialize storage and context list,
// start level1 running, decide what other processes (contexts)
// to enable, and then let them all run

Msg("Initialize contexts")
EFTPCtxq = Allocate(EFTPZone, 2)   //Main context queue
EFTPCtxq!0 = 0

Msg("Initialize pup stuff")
//Initializations
InitPupLevel1(EFTPZone, EFTPCtxq, 10)   //up to 10 buffers
InitEFTPPackage()


// Decide if we should schedule the interactive input handler,
// or the command line interpreter

test cli   
   ifso InitEFTPCli()
   ifnot InitEFTPKbd()

Msg("Start context mechanism")
//Now pass off control, and never return here
CallContextList(EFTPCtxq!0) repeat    //loop forever
]


// These next two routines run in the context (and stack) of
// EFTP(), but merely establish and enqueue a context in which
// the real routines can run.  Actual routines can live elsewhere.
//-----------------------------------------------------------------
and InitEFTPCli() be
//-----------------------------------------------------------------
Enqueue(EFTPCtxq, InitializeContext(Allocate(EFTPZone, cliStackSize),
 cliStackSize, EFTPCli))


//-----------------------------------------------------------------
and InitEFTPKbd() be
//-----------------------------------------------------------------
Enqueue(EFTPCtxq, InitializeContext(Allocate(EFTPZone, kbdStackSize),
 kbdStackSize, EFTPKbd))


//-----------------------------------------------------------------
and Msg(str) be
//-----------------------------------------------------------------
[
unless DebugSwitch return
Ws(str)
test DebugConfirmSwitch  
   ifso [ Wl("[OK??]"); Gets(keys) ]
   ifnot Wl("")
]


// One of these routines will have been placed on the context list,
// and will therefore be running
//-----------------------------------------------------------------
and EFTPCli() be
//-----------------------------------------------------------------
[
// Pick off the relevent information from the file COM.CM
// format is: eftp <filename> to/from <machine name or number>
// If we get here, the file name is already in cliBody
ReadParam(0, 0, tempstring)   //get the direction
switchon tempstring!1 into
   [CliCmd
   case $t: case $T:
      [
      //tempfile =
      //   EvalParam(cliBody, "I", "File does not exist, try again:")
      let body = cliBody;
         [  // beginning of a repeat
         EvalParam(body, "P", "File does not exist, try again: ", tempstring);
         tempfile = OpenFile(tempstring, ksTypeReadOnly, charItem, verLatest,
          noHintFp, SysErr, EFTPZone, nil, eftpDisk);
         let nullBody = vec 256; nullBody!0 = 0; body = nullBody;
         ] repeatuntil tempfile
      unless GetPartner(ReadParam("P"), dsp, EFTPFrnPort,
       0, socketEFTPReceive) do
         [
         CliError()
         endcase
         ]
      ReportResult(EFTPSendFile(tempfile, EFTPFrnPort))
      Closes(tempfile)
      endcase
      ]
   case $f: case $F:
      [
      //tempfile= EvalParam(cliBody, "O")
      let body = cliBody;
         [  // beginning of a repeat
         EvalParam(body, "P", "Can't open file, try again: ", tempstring);
         tempfile = OpenFile(tempstring, ksTypeWriteOnly, charItem, verNew,
          noHintFp, SysErr, EFTPZone, nil, eftpDisk);
         let nullBody = vec 256; nullBody!0 = 0; body = nullBody;
         ] repeatuntil tempfile
      unless GetPartner(ReadParam("P"), dsp, EFTPFrnPort) do
         [
         CliError()
         endcase
         ]
      ReportResult(EFTPReceiveFile(tempfile, EFTPFrnPort))
      Closes(tempfile)
      endcase
      ]
   default:
      [
      CliError()
      endcase
      ]
   ]CliCmd
if eftpDisk ne sysDisk then [ TFSClose(eftpDisk); TFSSilentBoot(); ]
finish   // we do not hang around.....
]

//-----------------------------------------------------------------
and CliError() be
//-----------------------------------------------------------------
[
Wl("Take care, the syntax for command line should be:")
Ws("eftp <filename> to/from <machine name or number>")
]

//-----------------------------------------------------------------
and EFTPKbd() be
//-----------------------------------------------------------------
[
[CmdLoop
let abortCmd = false
Msg("Get command from kbd")
Ws("->")
let cmd = GetKeys()
switchon cmd into
   [CommandBlock
   case $S: case $s:
      [
      Ws("Send file -- name or number of remote host: ")
         [
         unless GetString(tempstring) then 
            [
            abortCmd = true
            break
            ]
         if tempstring>>String.length eq 0 then loop
         if GetPartner(tempstring, dsp, EFTPFrnPort,
          0, socketEFTPReceive) then break
         Ws("...try again: ")
         ] repeat
      if abortCmd then loop
      Ws("local file name: ")
         [
         unless GetString(tempstring) then 
            [
            abortCmd = true
            break
            ]
         tempfile = OpenFile(tempstring, ksTypeReadOnly, charItem, verLatest,
          noHintFp, SysErr, EFTPZone, nil, eftpDisk); 
         if tempfile ne 0 then break
         Ws("File "); Ws(tempstring)
         Ws(" does not exist, try again: ")
         ] repeat
      if abortCmd then loop
      ReportResult(EFTPSendFile(tempfile, EFTPFrnPort))
      Closes(tempfile)
      endcase
      ]
   case $R: case $r:
      [
      Ws("Receive a file -- name or number of remote host: ")
         [
         unless GetString(tempstring) then 
            [
            abortCmd = true
            break
            ]
         if tempstring>>String.length eq 0 then loop
         if GetPartner(tempstring, dsp, EFTPFrnPort) then break
         Ws("...try again: ")
         ] repeat
      if abortCmd then loop
         [
         Ws("local file name: ")
         unless GetString(tempstring) then 
            [
            abortCmd = true
            break
            ]
         tempfile = OpenFile(tempstring, ksTypeReadOnly, charItem, verLatest,
          noHintFp, SysErr, EFTPZone, nil, eftpDisk);
         if tempfile ne 0 then
            [
            //File opened, it already exists
            Closes(tempfile)
            unless Confirm("File exists, OK to Overwrite?")  loop
            ] 
         //Now open a new file, for writing
         tempfile = OpenFile(tempstring, ksTypeWriteOnly, charItem, verNew,
          noHintFp, SysErr, EFTPZone, nil, eftpDisk);
         break
         ] repeat
      if abortCmd then loop

      ReportResult(EFTPReceiveFile(tempfile, EFTPFrnPort))
      Closes(tempfile)
      endcase
      ]
   case #15:      //CR is a no-op
      [
      Wl("")
      endcase
      ]
   case $Q: case $q:
      [
      Ws("Quit...")
      if Confirm("Confirm?") then
         [
         if eftpDisk ne sysDisk then [ TFSClose(eftpDisk); TFSSilentBoot(); ]
         finish;
         ]
      endcase   //program terminates here!!!!
      ]
   case $?: 
      [
      Wl("Send, Receive, Quit...")
      endcase
      ]
   default:
      [
      Puts(dsp,cmd)
      Wl(" ??? Send, Receive, Quit...")
      endcase
      ]
   ]CommandBlock
Block()
]CmdLoop repeat         //will run until a quit
]


//-----------------------------------------------------------------
and ReportResult(boolean) be
//-----------------------------------------------------------------
[
test boolean
   ifso Wl("...all done")
   ifnot Wl("...file transfer failed")
]


//-----------------------------------------------------------------
and GetKeys() = valof
//-----------------------------------------------------------------
[
while Endofs(keys) do Block()
resultis Gets(keys)
]


//-----------------------------------------------------------------
and GetString(str) = valof
//-----------------------------------------------------------------
[
// Caller must provide the place to put the string
// Returns false if DEL is hit.  Uses default streams dsp and keys
let deletingFlag, char = false, 0
str>>String.length = 0

   [charLoop
   if str>>String.length eq 255 then resultis true
   char = GetKeys()   //this will block for a bit
   switchon char into
      [CharBlock
      case #15:      //CR
         [
         Wl("")
         resultis true
         ]
      case #21:      //^Q, reset the line
         [
         Wl(" xxx")
         deletingFlag=false
         char=0
         str>>String.length=0
         endcase
         ]
      case #10: case #1:      //BS or ^A
         [
         if str>>String.length eq 0 then endcase
         unless deletingFlag then
            [
            deletingFlag=true
            Ws("[")
            ]
         Puts(dsp,str>>String.char^(str>>String.length))
         str>>String.length = str>>String.length - 1
         endcase
         ]
      case #22:      //^R, retype the line
         [
         Wl(""); Ws(str); deletingFlag=false
         endcase
         ]
      case #177:   //DEL,delete the line and return false
         [
         Wl(" XXX")
         resultis false
         ]
      default:      
         [
         if deletingFlag then
            [
            deletingFlag=false
            Ws("]")
            ]
         str>>String.length = str>>String.length + 1
         str>>String.char^(str>>String.length) = char
         Puts(dsp, char)
         ]
      ]CharBlock
   ]charLoop  repeat

]


//-----------------------------------------------------------------
and Confirm(confirmString) = valof
//-----------------------------------------------------------------
[
// A general guy, for confirming some action
Puts(dsp,$[); Ws(confirmString); Puts(dsp,$])
switchon GetKeys() into
   [
   case $y: case $Y: case $*N:
      [ Wl(" Yes."); resultis true ]
   case $n: case $N: case $*177:
      [ Wl(" No."); resultis false ]
   default: Wl(" ?")
   ] repeat
]