// EFTP.bcpl -- top level routine and user interface for
// the EFTP subsystem
// June 17, 1976 3:44 PM ap,bak,jfs
// last modified on September 25, 1982 11:04 AM by Taft
// Copyright Xerox Corporation 1979
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
//outgoing statics
EFTPZone; EFTPCtxq
EFTPFrnPort; EFTPLclPort; EFTPSocket
//incoming statics
keys;dsp
]
compileif nova then [ external [ InitNovaAlto ] ]
static
[
EFTPZone;EFTPCtxq
EFTPFrnPort;EFTPLclPort;EFTPSocket
tempfile; tempstring
DebugSwitch = false
DebugConfirmSwitch = false
cliBody; cliSwitches
]
manifest
[
cliStackSize = 3000
kbdStackSize = 3000
]
//-----------------------------------------------------------------
let EFTP() be
//-----------------------------------------------------------------
[
let versionText = "EFTP of September 25, 1982"
//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)
//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
]
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:")
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")
unless GetPartner(ReadParam("P"), dsp, EFTPFrnPort) do
[
CliError()
endcase
]
ReportResult(EFTPReceiveFile(tempfile, EFTPFrnPort))
Closes(tempfile)
endcase
]
default:
[
CliError()
endcase
]
]CliCmd
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)
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)
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)
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 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
]