// RemoteVMemInit.bcpl - handles pulling in remote sysout
// Last change May 20, 1984  4:26 PM by Bill van Melle
// 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
		// from RemoteVmemInit1.bcpl
	Retrieve; Wss; FixPassword; SwapCursors; RestoreCursor
		// from LocalVmemInit.bcpl
	AppendString; SysinFailure

		// O.S. procedures
	CallSwat; Allocate; Free; InitializeZone; Zero; Puts; Ws
	Block; Dismiss
		// from Raid
	ReadStrng

		// misc procedures used
	GiveUp 
	Enqueue; InitializeContext; CallContextList; Noop
	
		// pup procs
	GetPartner; OpenLevel1Socket; InitPupLevel1; DestroyPupLevel1
	InitFtpUtil; InitFtpPList; OpenRTPSocket; CreateBSPStream
	UserOpen; InitPList; UserRetrieve; FreePList; UserClose
	ReleasePBI
		// statics used
	dsp 
	UserName; UserPassword; CtxRunning
	SysinName; SysinHostName
		// statics defined
	sysZone; sysoutFailed; ftpBadPup
	]

static [
	done; sysZone
	sysoutFailed = -1
	ftpBadPup = 0
	]

manifest [
	WordsPerPage = 256
	myBufferSize = WordsPerPage*7
	myZoneSize = 6500 + myBufferSize
	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 () 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))

done = false
CallContextList (ctxQ!0) repeatuntil done
DestroyPupLevel1()
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

let sink = vec lST
Zero(sink, lST)
sink>>ST.puts = Noop
let fport = vec lenPort
unless GetPartner (SysinHostName, dsp, fport, 0, socketFTP)
   do GiveUp ("No such host: ", SysinHostName)

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, SysinHostName)
	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()
localPL>>PL.SFIL = SysinName
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(SysinHostName)
	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:
	SysinFailure (ctx>>FtpCtx.getCmdString)
 ]
] repeat

UserClose()
RestoreCursor (oldCursorBitMap)
done = true
]

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

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
]