// 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
]