// RemoteVMemInit.bcpl - handles pulling in remote sysout
// Last change August 1, 1983 2:31 PM by Bill van Melle
// Last change January 21, 1983 11:14 AM by Bill van Melle
// Last change October 25, 1982 3:15 PM by Bill van Melle
// Last change June 8, 1982 10:41 PM by Bill van Melle
// Last change March 18, 1982 11:49 AM by Bill van Melle
// Last change December 29, 1981 11:50 AM by Bill van Melle
// Last change November 30, 1981 9:59 PM by Bill van Melle
// Last change September 6, 1981 3:34 PM by Bill van Melle
get "Pup.decl"
get "FtpProt.decl"
get "AltoDefs.d"
external [ // procedure defined here
RemoteInitVmem; AppendString
// from RemoteVmemInit1.bcpl
Retrieve; Wss; FixPassword; SwapCursors; RestoreCursor
// O.S. procedures
CallSwat; Allocate; Free; InitializeZone; Zero; Puts
CreateDisplayStream; ShowDisplayStream; Wc; Ws
OpenFileFromFp; Closes; Block; Dismiss
// from Raid
ReadStrng
// misc procedures used
IndexedPageIO; LoadIPage; GiveUp
Enqueue; InitializeContext; CallContextList; Noop
ExtractSubstring
// pup procs
GetPartner; OpenLevel1Socket; InitPupLevel1; DestroyPupLevel1
InitFtpUtil; InitFtpPList; OpenRTPSocket; CreateBSPStream
UserOpen; InitPList; UserRetrieve; FreePList; UserClose
ReleasePBI
// statics used
dsp
UserName; UserPassword; CtxRunning
SysinName; VmemStream
// statics defined
sysZone; sysoutFailed; nameInSysinIndex; ftpBadPup
]
static [
done; sysZone; nameInSysinIndex
sysoutFailed = -1
ftpBadPup = 0
]
manifest [
WordsPerPage = 256
myBufferSize = WordsPerPage*6
myZoneSize = 7000 + myBufferSize
lenDSPBlock = lDCB*2 + (380*3)/2
firstMouseX = 260
firstMouseY = 50
lastMouseY = 800
ptAbort = #11
ptError = #4
ftpNoUserName = 2
ftpBadUserName = 16
ftpBadUserPassword = 17
ftpBusy = 73
]
structure String: [ length byte; char↑1,255 byte ]
let RemoteInitVmem (filename, VMemID) be
[
let zone = vec myZoneSize // make local sysZone that goes away when we finish
let oldSysZone = sysZone
sysZone = InitializeZone(zone, myZoneSize)
let ctxQ = vec 1
ctxQ!0 = 0 // make a context queue
InitFtpUtil()
InitFtpPList()
InitPupLevel1 (sysZone, ctxQ, 10)
Enqueue(ctxQ, InitializeContext (Allocate(sysZone, 1000), 1000, FTPGuy, lenExtraCtx))
VmemStream = OpenFileFromFp (VMemID)
done = false
CallContextList (ctxQ!0) repeatuntil done
DestroyPupLevel1()
Closes (VmemStream); VmemStream = 0
sysZone = oldSysZone
]
and FTPGuy (ctx) be
[
Block()
Zero(lv ctx>>FtpCtx.bspSoc, lenFTPI) // clear out extra ctx stuff
@mouseX, @mouseY = firstMouseX, firstMouseY
let oldCursorBitMap = vec 15
SwapCursors (oldCursorBitMap,
table [ #177400; #177400; #177400; #177400;
#177400; #177400; #177400; #177400;
#377; #377; #377; #377; #377; #377; #377; #377 ])
// show ftp cursor
dsp = CreateDisplayStream (2, Allocate(sysZone, lenDSPBlock), lenDSPBlock)
ShowDisplayStream (dsp, DSalone)
let sink = vec lST
Zero(sink, lST)
sink>>ST.puts = Noop
let fport = vec lenPort
let host = vec 20
let i = 2
let ch = SysinName>>String.char↑1
let namelen = SysinName>>String.length
// first parse SysinName. Extract hostname
if ch ne ${ & ch ne $[
then [ GiveUp ("Illegal SYSIN name: ", SysinName); return ]
[ ch = SysinName>>String.char↑i
if ch eq $} % ch eq $]
then break
host>>String.char↑(i-1) = SysinName>>String.char↑i
i = i+1
if i ge namelen
then [ GiveUp ("Illegal SYSIN name: ", SysinName); return ]
] repeat
host>>String.length = i-2
unless GetPartner (host, dsp, fport, 0, socketFTP)
do GiveUp ("No such host: ", host)
let soc = Allocate(sysZone, lenBSPSoc)
OpenLevel1Socket (soc, 0 , fport) // open socket to partner
// establish connection with ftp server
if (not OpenRTPSocket (soc, 0, 0, 0, FTPGuyPupHandler))
& ((not ftpBadPup) %
(not OpenRTPSocket (soc, 0, 0, 0, FTPGuyPupHandler, 1000)))
then [
let errstring = vec 50
errstring!0 = 0
AppendString(errstring, "Can't open FTP connection with ")
AppendString(errstring, host)
AppendString(errstring, ":*N// ")
test ftpBadPup
ifso [
let type, firstByte = nil, nil
switchon ftpBadPup>>PBI.pup.type
into [
case ptError:
type = "[Error] "
firstByte = 25
endcase
case ptAbort:
type = "[Abort] "
firstByte = 3
endcase
]
Wss(dsp, type)
let nBytes = ftpBadPup>>PBI.pup.length-pupOvBytes-firstByte+1
for i = firstByte to firstByte+nBytes-1
do Puts(dsp, ftpBadPup>>PBI.pup.bytes↑i)
Dismiss(100) // wait 1 second so user can see it
ReleasePBI(ftpBadPup)
AppendString(errstring, type)
let curlen = errstring>>String.length
for i = 0 to nBytes-1
do errstring>>String.char↑(i+curlen+1) =
ftpBadPup>>PBI.pup.bytes↑(i+firstByte)
errstring>>String.length = curlen+nBytes
ReleasePBI(ftpBadPup)
]
ifnot AppendString(errstring, "No response")
GiveUp (errstring)
]
ctx>>FtpCtx.bspStream = CreateBSPStream (soc)
ctx>>FtpCtx.bspSoc = soc
ctx>>FtpCtx.dspStream = dsp
ctx>>FtpCtx.lst = sink // log stream
ctx>>FtpCtx.dls = sink // debugging log stream
ctx>>FtpCtx.dbls = ctx>>FtpCtx.bspStream
ctx>>FtpCtx.buffer = Allocate(sysZone, myBufferSize)
ctx>>FtpCtx.bufferLength = myBufferSize
ctx>>FtpCtx.debugFlag = false
unless UserOpen (Version)
do CallSwat ("UserOpen failed")
let localPL = InitPList()
nameInSysinIndex = i+1 // for Retrieve
localPL>>PL.SFIL = ExtractSubstring(SysinName, nameInSysinIndex)
localPL>>PL.UNAM = UserName
localPL>>PL.UPSW = UserPassword
[
let mark = UserRetrieve (localPL, Retrieve, FTPGuyCleanup)
let busyCnt = 0
unless sysoutFailed
do break
if sysoutFailed ne -1
then mark = sysoutFailed
let code = mark<<Mark.subCode
switchon code into
[
case ftpNoUserName: case ftpBadUserName: case ftpBadUserPassword:
FixPassword(host)
endcase
case ftpBusy:
if busyCnt < 10
then [
busyCnt = busyCnt+1
Wss(dsp, "*N")
Wss(dsp, ctx>>FtpCtx.getCmdString)
Wss(dsp, "; will retry")
Dismiss(1500) // wait 15 seconds
endcase
]
default:
[ // inline concat here
let errstring = vec 50
errstring!0 = 0
AppendString(errstring, "Retrieve of sysout ")
AppendString(errstring, SysinName)
AppendString(errstring, " failed*N// ")
GiveUp (errstring, ctx>>FtpCtx.getCmdString)
]
]
] repeat
UserClose()
RestoreCursor (oldCursorBitMap)
ShowDisplayStream (dsp, DSdelete)
dsp = 0
done = true
]
and Version (stream, nil) be Wss(stream, "Lisp FTP User")
and AppendString(str, newstr) = valof
[
let i = str>>String.length
for j = 1 to newstr>>String.length
do [ i = i+1; str>>String.char↑i = newstr>>String.char↑j ]
str>>String.length = i
resultis str
]
and FTPGuyPupHandler(pbi) be
[
test sysoutFailed &
(pbi>>PBI.pup.type eq ptError %
pbi>>PBI.pup.type eq ptAbort)
ifso [
if ftpBadPup then ReleasePBI (ftpBadPup)
ftpBadPup = pbi
]
ifnot ReleasePBI (pbi)
]
and FTPGuyCleanup (remotePL, ok, mark) be
[
if not ok
then sysoutFailed = mark
]