// RemoteVMemInit.bcpl - handles pulling in remote sysout
// 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 "LispBcpl.decl"
	get "VMem.decl"
	get "Pup.decl"
	get "FtpProt.decl"
	get "AltoDefs.d"

external [	// procedure defined here
	RemoteInitVmem
		// from RemoteVmemInit1.bcpl
	Retrieve; Wss; FixPassword

		// O.S. procedures
	CallSwat; Allocate; Free; InitializeZone; Zero; Puts
	CreateDisplayStream; ShowDisplayStream; Wc; Ws
	OpenFileFromFp; Closes
		// from Raid
	ReadStrng

		// misc procedures used
	IndexedPageIO; LoadIPage 
	Enqueue; InitializeContext; CallContextList
	ExtractSubstring
		// pup procs
	GetPartner; OpenLevel1Socket; InitPupLevel1; DestroyPupLevel1
	InitFtpUtil; InitFtpPList; OpenRTPSocket; CreateBSPStream
	UserOpen; InitPList; UserRetrieve; FreePList; UserClose
		// statics used
	dsp 
	UserName; UserPassword; CtxRunning
		// statics defined
	SysinName; sysZone; VMStream; sysoutHost
	]

static [
	SysinName; done; sysZone; VMStream; sysoutHost
	]

manifest [
	myBufferSize = WordsPerPage*6
	myZoneSize = 7000 + myBufferSize
	lenDSPBlock = lDCB*2 + (380*3)/2
	firstMouseX = 260
	firstMouseY = 50
	lastMouseY = 800
	]

structure String: [ length byte; char↑1,255 byte ]
 


let RemoteInitVmem (filename, VMemID) be

[
SysinName = filename
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))
VMStream = OpenFileFromFp (VMemID)

done = false
CallContextList (ctxQ!0) repeatuntil done
DestroyPupLevel1()
Closes (VMStream)
sysZone = oldSysZone
]

and FTPGuy (ctx) be
[
Zero(lv ctx>>FtpCtx.bspSoc, lenFTPI)	// clear out extra ctx stuff
@mouseX, @mouseY = firstMouseX, firstMouseY
let oldCursorBitMap = vec 15
for i = 0 to 15 do oldCursorBitMap!i = cursorBitMap!i
				// save cursor
for i = 0 to 7 do cursorBitMap!i = #177400
for i = 8 to 15 do cursorBitMap!i = #377	// show ftp cursor

dsp = CreateDisplayStream (2, Allocate(sysZone, lenDSPBlock), lenDSPBlock)
ShowDisplayStream (dsp, DSalone)
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 [ CallSwat ("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 [ CallSwat ("Illegal SYSIN name", SysinName); return ]
  ] repeat
host>>String.length = i-2
unless GetPartner (host, dsp, fport, 0, socketFTP)
   do CallSwat ("No such host", host)
sysoutHost = host			// So Retrieve can get it

let soc = Allocate(sysZone, lenBSPSoc)
OpenLevel1Socket (soc, 0 , fport)	// open socket to partner
unless OpenRTPSocket (soc)	// establish connection with ftp server
   do CallSwat ("Can't open FTP connection")

ctx>>FtpCtx.bspStream = CreateBSPStream (soc)
ctx>>FtpCtx.bspSoc = soc
ctx>>FtpCtx.dspStream = dsp
ctx>>FtpCtx.buffer = Allocate(sysZone, myBufferSize)
ctx>>FtpCtx.bufferLength = myBufferSize
ctx>>FtpCtx.debugFlag = false

unless UserOpen (Version)
   do CallSwat ("UserOpen failed")

let localPL = InitPList()
localPL>>PL.SFIL = ExtractSubstring(SysinName, i+1)
localPL>>PL.UNAM = UserName
localPL>>PL.UPSW = UserPassword

[
let mark = UserRetrieve (localPL, Retrieve)
if mark eq markEndOfCommand
   then break
let code = mark<<Mark.subCode
test (code eq #20) % (code eq #21) % (code eq 2)
   ifso FixPassword(host)
   ifnot CallSwat ("Retrieve of sysout failed", ctx>>FtpCtx.getCmdString)
] repeat

UserClose()
for i = 0 to 15 do cursorBitMap!i = oldCursorBitMap!i
				// restore cursor
ShowDisplayStream (dsp, DSdelete)
dsp = 0
done = true
]

and Version (stream, nil) be Wss(stream, "Lisp FTP User")