// GateConEFTP.bcpl -- store/retrieve a file on the gateway's disk
// Last modified July 2, 1983 10:31 PM by Boggs
get "Streams.d"
get "AltoDefs.d"
get "PupEftp.decl"
get "GateConServ.decl"
external
[
// outgoing procedures
Eftp
// incoming procedures
Zero; MoveBlock; SendCommand
DoubleAdd; DoubleDifference; Divide32x16
SetTimer; TimerHasExpired; Dismiss; ReadCalendar
GetPBI; ReleasePBI; AppendStringToPup; CompletePup
StringCompare; CopyString
CreateCmdBox; ResetCmdMenu; TopLevel; BoxProc; ReturnFrom
Gets; GetString; PutTemplate; Ws; Wss; BackSpace
OpenFile; SetFilePos; ReadBlock; WriteBlock
FilePos; Endofs; Closes; Puts
OpenEFTPSoc; SendEFTPBlock; ReceiveEFTPBlock
SendEFTPEnd; CloseEFTPSoc
// incoming statics
dsp; keys; errorDsp; gcHost; gcNet
]
//----------------------------------------------------------------------------
let Eftp() be
//----------------------------------------------------------------------------
[
ResetCmdMenu()
CreateCmdBox(TopLevel, "TopLevel")
CreateCmdBox(StoreFile, "Store")
CreateCmdBox(RetrieveFile, "Retrieve")
// ResetCmdMenu destroyed the BoxQ which BoxProc is following.
// If we just return now, BoxProc will get horribly confused.
// So don't let it continue: force a return from BoxProc.
ReturnFrom(BoxProc)
]
//----------------------------------------------------------------------------
and StoreFile() = valof
//----------------------------------------------------------------------------
// This procedure doesn't actually return a value:
// If things go sour, we abort by saying "resultis BailOut(...)"
[
let bytes, soc, pbi, stream = 0, 0, 0, 0
let name = vec 128
unless GetString("*NStore local file ", name) resultis false
stream = OpenFile(name, ksTypeReadOnly, charItem)
if stream eq 0 then resultis Ws(" - no such file")
let bootFile = StringCompare(name, ".boot", name>>String.length-4) eq 0
PutTemplate(dsp, "as remote file $S", name)
let char = Gets(keys); if char ne $*N then
[
for i = name>>String.length to 1 by -1 do
BackSpace(dsp, name>>String.char↑i)
unless GetString(0, name, true, char) resultis
BailOut(bytes, soc, pbi, stream)
]
// send file name and get EFTP port
let soc = vec lenEFTPSoc; OpenEFTPSoc(soc, 0, 0)
pbi = GetPBI(soc)
AppendStringToPup(pbi, 1, name)
pbi = SendCommand(pbi, ptStore, pbi>>PBI.pup.length, 10)
if pbi eq 0 then
[
Ws(" - no response")
resultis BailOut(bytes, soc, pbi, stream)
]
if pbi>>PBI.pup.type ne ptAck then
[
Ws(" - server refuses")
resultis BailOut(bytes, soc, pbi, stream)
]
MoveBlock(lv soc>>PupSoc.frnPort, lv pbi>>PBI.pup.words, lenPort)
// send file, reformatting if SO-format bootFile
let buffer = lv pbi>>PBI.pup
bytes = ReadBlock(stream, buffer, 256) lshift 1
if (FilePos(stream) & 1) eq 1 then bytes = bytes -1
if bootFile then
[
ReadCalendar(buffer+3) //set date to now
test buffer!1 ne 0 //SO-format?
ifso buffer!1 = 0 //mark as B-format now
ifnot bootFile = false //already B-format
]
bytes = SendEFTPBlock(soc, buffer, bytes, 1000)
if bytes le 0 resultis BailOut(bytes, soc, pbi, stream)
test bootFile
ifso
[
Ws("*NReformatting...")
SetFilePos(stream, 1, 254 lshift 9)
ReadBlock(stream, buffer, 256) //loc 0-#377
bytes = SendEFTPBlock(soc, buffer, 512, 1000)
if bytes le 0 resultis BailOut(bytes, soc, pbi, stream)
SetFilePos(stream, 0, 512)
]
ifnot Ws("*NTransferring...")
let bits = vec 1; Zero(bits, 2)
let saveCursor = vec 16; MoveBlock(saveCursor, cursorBitMap, 16)
for i = 0 to 7 do cursorBitMap!i = 177400b
for i = 8 to 15 do cursorBitMap!i = 377b
let startTime = vec 1; ReadCalendar(startTime)
for i = 2 to bootFile? 253, 1000 do
[
if Endofs(stream) then break
bytes = ReadBlock(stream, buffer, 256) lshift 1
if (FilePos(stream) & 1) eq 1 then bytes = bytes -1
if bytes eq 0 break
bytes = SendEFTPBlock(soc, buffer, bytes, 3000)
for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
let inc = vec 1; inc!0 = 0; inc!1 = 8*bytes
DoubleAdd(bits, inc)
if bytes ls 0 break
]
MoveBlock(cursorBitMap, saveCursor, 16)
if bytes ls 0 resultis BailOut(bytes, soc, pbi, stream)
let stopTime = vec 1; ReadCalendar(stopTime)
test SendEFTPEnd(soc, 3000)
ifso
[
Divide32x16(bits, DoubleDifference(stopTime, startTime))
PutTemplate(dsp, "$EUD bits/sec...", bits)
]
ifnot resultis BailOut(EFTPTimeout, soc, pbi, stream)
// See if he got it
let gotReply = false
let timer = nil; SetTimer(lv timer, 12000) //2 minutes!
[
let rpbi = SendCommand(GetPBI(soc), ptStats, pupOvBytes)
if rpbi ne 0 then
[
let status = rpbi>>PBI.pup.type eq ptAck?
(lv rpbi>>PBI.pup.words)>>Stats.ftpStatus, statusBusy
ReleasePBI(rpbi)
switchon status into
[
case statusBusy:
[ Dismiss(500); loop ]
case statusYes:
[ Ws("Done"); gotReply = true; break ]
default:
[
Ws(" - failed")
gotReply = true
if status ne statusNo then
PutTemplate(errorDsp, " - error code $UO", status)
break
]
]
]
] repeatuntil TimerHasExpired(lv timer)
unless gotReply do
[
Ws("no response")
Ws("*NI am unable to confirm safe delivery of the file")
]
BailOut(0, soc, pbi, stream)
]
//----------------------------------------------------------------------------
and BailOut(bytes, soc, pbi, stream) be
//----------------------------------------------------------------------------
// Releases any resources we accumulated.
[
if stream ne 0 then Closes(stream)
if pbi ne 0 then ReleasePBI(pbi)
if soc ne 0 then CloseEFTPSoc(soc)
if bytes ls 0 then
[
Ws(selecton bytes into
[
case EFTPTimeout: " - Timeout"
case EFTPAbortReceived: " - Abort received"
case EFTPAbortSent: " - Abort sent"
default: " - Unknown error code"
])
]
]
//----------------------------------------------------------------------------
and RetrieveFile() = valof
//----------------------------------------------------------------------------
// This procedure doesn't actually return a value:
// If things go sour, we abort by saying "resultis BailOut(...)"
[
let bytes, soc, pbi, stream = 0, 0, 0, 0
let buffer = vec 256
let localName, remoteName = buffer, buffer+128
unless GetString("*NRetrieve remote file ", remoteName) resultis false
CopyString(localName, remoteName)
PutTemplate(dsp, "as local file $S", localName)
let char = Gets(keys); if char ne $*N then
[
for i = localName>>String.length to 1 by -1 do
BackSpace(dsp, localName>>String.char↑i)
unless GetString(0, localName, true, char) resultis false
]
stream = OpenFile(localName, ksTypeWriteOnly, charItem)
// send file name
let soc = vec lenEFTPSoc; OpenEFTPSoc(soc, 0, 0)
for i = 1 to 10 do //worst case: 20 seconds
[
let pbi = GetPBI(soc)
pbi>>PBI.pup.id↑1 = gcPassword
pbi>>PBI.pup.dPort.net = gcNet
pbi>>PBI.pup.dPort.host = gcHost
pbi>>PBI.pup.dPort.socket↑1 = gcSocket1
pbi>>PBI.pup.dPort.socket↑2 = gcSocket2
AppendStringToPup(pbi, 1, remoteName)
CompletePup(pbi, ptRetrieve)
bytes = ReceiveEFTPBlock(soc, buffer, 200) //2 seconds
if bytes gr 0 break
]
if bytes le 0 resultis BailOut(bytes, soc, pbi, stream)
Ws("*NTransferring...")
let bits = vec 1; Zero(bits, 2)
let saveCursor = vec 16; MoveBlock(saveCursor, cursorBitMap, 16)
for i = 0 to 7 do cursorBitMap!i = 177400b
for i = 8 to 15 do cursorBitMap!i = 377b
let startTime = vec 1; ReadCalendar(startTime)
[
WriteBlock(stream, buffer, bytes rshift 1)
if (bytes & 1) eq 1 then Puts(stream, buffer!(bytes rshift 1) rshift 8)
bytes = ReceiveEFTPBlock(soc, buffer, 3000) //30 seconds
for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
let inc = vec 1; inc!0 = 0; inc!1 = 8*bytes
DoubleAdd(bits, inc)
] repeatuntil bytes le 0
MoveBlock(cursorBitMap, saveCursor, 16)
if bytes ls 0 resultis BailOut(bytes, soc, pbi, stream)
let stopTime = vec 1; ReadCalendar(stopTime)
Divide32x16(bits, DoubleDifference(stopTime, startTime))
PutTemplate(dsp, "$EUD bits/sec...", bits)
BailOut(0, soc, pbi, stream)
Ws("Done")
]