// Bcpl SpruceSpool.Bcpl 
// Use EFTP protocol to accept and queue Press Files

//get "Spruce.d" makes too many "get" files
	get "SpruceInLdOutLd.d"		// InLd/OutLd messages for spooler <-> service communication
	get "SprucePrinters.d"
	get "SpruceDoc.d"
//	get "Sprucefont.d"
//	get "Spruceband.d"
	get "spruceMisc.d"
get "SpruceFiles.d"
get "pupEftp.decl"

external // defined here
	[
	InitSpool
	PrepareToSpool
	SomeoneIsKnocking
	SpoolAFile
	]

external // external
	[
	// SpruceQueue
	AddToQueue
	CleanupQueue
	FullQueue
	InitializeQueue

	// SpruceUser
	Post

	// SpruceFiles, SpruceStreams
	CreateSpruceFile
	CreateSpruceSubfile
	CurrentPos
	ForgetSpruceFile
	InitSpruceFile
	ResetSpruceFile
	WindowCreateStream
	WindowNextPage
	WindowWriteBlock

	// SpruceUtils
	CursorChar
	CursorDigit
	FillInNames
	FSGetX
	Reclaim
	VpageToRpage

	// SprucePLists
	ParsePrintInstanceParams
	GenPrinterCapabilities
	GenJobStatus

	// EFTP
	CloseEFTPSoc
	InitEFTPPackage
	OpenEFTPSoc
	ReceiveEFTPPacket
	SendEFTPAbort

	// Pup Package
	AppendStringToPup
	CompletePup
	ExchangePorts
	InitPupLevel1
	OpenLevel1Socket
	ReleasePBI

	// Queue
	Dequeue
	Enqueue

	// Contexts
	Block
	InitializeContext

	// OS
	Closes
	Endofs
	MoveBlock
	Puts
	Zero

	// statics
	Capabilities
	freeFile
	maxQueued
	numFilesSpooled
	numMustPrint
	pressFileIndex
	printerName
	reasonVec
	SpoolFile
	SpoolVec
	spooling
	spoolSocket
	SpruceZone
	]

static [ statusSocket; PostStr ]

// File-wide structure and manifest declarations.

manifest
	[
	STATStackSize = 200 // enough 7-17-79 // 100  8-3-77
	EFTPFailed =  -10
	EFTPServerFailed =  -11
	MediumWaitAbort = 7
	LongWaitAbort = 6
	socketPrinterStatus = #21
	typePrinterStatusRequest = #200
	typePrinterStatusReply = #201
	typePrCapabilityRequest = #202
	typePrCapabilityReply = #203
	typeJobStatusRequest = #204
	typeJobStatusReply = #205

	InterPupTimeout = 1200 // 12 seconds, then check for other requests
	maxTimeouts = 3	     // after this many, abort transfer anyhow

	nahSpool = 3

	PrInstPass0 = #125314
	PrInstPass1 = #170377
	]



//	This module uses PupEFTP, and underlying Pup packages, along with the SpruceQueue module to
// manage the spool queue, to listen to the Ethernet, respond to status requests, and spool incoming
// Press files.

//	PupEFTP has been modestly modified from the publicly available version, allowing better access to
// the pbi-level and to error management.

//	The main routine (see Sprouller() in Spruce.bcpl) calls SomeoneIsKnocking until someone is,
// then SpoolAFile to get one. PrepareToSpool is called, to start EFTP listening, as soon as possible after
// the previous file is in.


// ------------------------------------------------------
let SomeoneIsKnocking() = valof
// ------------------------------------------------------
//	Filter out non-EFTP data requests directed to spoolSocket (socket 20).
//	Returns true only if there's an EFTP data request queued on the socket. Does not dequeue!
//	A simple "ear" function in the Sprint program simulates this function
	[
	let inPbi = spoolSocket>>EFTPSoc.iQ.head	// N.B. NOT dequeued yet!
	unless inPbi do [ Block(); resultis false ]
	// ~~ if locked on host and not this host, release pbi and continue
	if inPbi>>PBI.pup.type eq typeEFTPData resultis inPbi // go try it
	ReleasePBI(Dequeue(lv spoolSocket>>EFTPSoc.iQ)) // ignorable packet
	] repeat // until q empty or a good one found

// ------------------------------------------------------
and SpoolAFile() = valof // Someone is known to be knocking
// ------------------------------------------------------
//	Manages the EFTP operation, the queueing operation via SpruceQueue functions, and the
// reporting of results to the SpruceUser context via the Post() function. FillInNames(), properly a
// Sprint operation, examines the Press directory for Press file information: name, creator, date,
// approximate size, etc. This is used in reports at the user terminal and in spooler status packets.
//	Returns true only if another spool request arrived while spooling (someone else knocked).
  [
  let doc, spoolResult = 0, ECSpoolTerminate
  test spooling then
	[
	test FullQueue() then
		[
		PostStr = "Sorry, Spruce Spooling Facility Full--Please Try Again."
		numMustPrint = 3
		SendEFTPAbort(spoolSocket, MediumWaitAbort, PostStr) 
		]
	    or
		[
		CursorChar($E)
		doc = FetchAFile()
		]
	]
    or
	[
	PostStr = (reasonVec!0? reasonVec, "Sorry, Spruce Service not Available -- Please Try Again Later.")
	 SendEFTPAbort(spoolSocket, LongWaitAbort, PostStr) 
	]

  CloseEFTPSoc(spoolSocket)
  let someoneElseKnocked = spoolSocket>>EFTPSoc.SomeoneElseWaiting
  if doc then
    [
    PostStr = "" // No information to relate
    let spooledFile = doc>>DocG.PressFile
    CleanupQueue(spooledFile>>SPruceFile.numPages, false) // Eliminate obliterated entries
    if doc>>DocG.reportCode eq 0 then
	[
	pressFileIndex = pressFileIndex+1
// Revamp fileCode generation
//	spooledFile>>SPruceFile.fileCode = FILEPress+1+(pressFileIndex rem FILEPressMask)
	spooledFile>>SPruceFile.fileCode = pressFileIndex
 	InitSpruceFile(spooledFile, 1, 3); FillInNames(0, doc, spooledFile) // fill in stuff from Press dir.
	ResetSpruceFile(spooledFile)
	AddToQueue(doc)
	if numFilesSpooled ge maxQueued-(maxQueued rshift 2) % // check queue near-full
	    freeFile>>SPruceFile.numPages le (SpoolFile>>SPruceFile.numPages rshift 2) then
		numMustPrint = 1
	PostStr, spoolResult = "Received from remote host", 0
	]
    ] // doc
  Post(doc, spoolResult, PostStr)
	Reclaim()
  PrepareToSpool(someoneElseKnocked? $I, $R) // Ready, denote whether others at the door
  resultis someoneElseKnocked
  ]

// ------------------------------------------------------
and PrepareToSpool(cursorChar; numargs na) be // Spruce spooler, that is
// ------------------------------------------------------
//	Assumes socket has been initialized, and is at present closed. Called by SpoolAFile() after
// complete processing of a previously-spooled file, and from Sprouller() in Spruce to begin listening on
// initial startup or after returning from Sprint. cursorChar is typically $R (received), or $I
// (interference -- someone else knocked). The cursor will contain this letter and the low order digit of
// the number of files left. This simple, largely vestigial code, assists in status display. 
    [
    let foreignPort = vec lenPort; Zero(foreignPort, lenPort)
    let localPort = vec lenPort; Zero(localPort, lenPort)
    localPort>>Port.socket^2 = socketEFTPReceive // #20
    OpenEFTPSoc(spoolSocket, localPort, foreignPort)
    CursorChar(na? cursorChar, $R)
    CursorDigit(numFilesSpooled rem 10)
    ]


// ------------------------------------------------------
and FetchAFile() = valof
// ------------------------------------------------------
// It is known that at least one EFTP data packet is queued. Use PupEFTP to attempt to spool a file.
// Handle all error communication with remote host. Return any spooled subfile and a success report.
// Returns a DocG structure, with non-empty fields:
// reportCode:
//	  0: successfully received a file.
//	  otherwise: EFTP abort code.
// PressFile:
//	  The subfile of freeFile (of SpoolFile) consumed by the spooling attempt, successful or not
//	    (used by caller to adjust queue, etc.)
// FileHost: network and host of requesting user
// spoolSocket still contains state information concerning the transfer.
    [
    let numTimeouts, byteCount = maxTimeouts, nil
    let doc = FSGetX(lenDocG, SpruceZone, 0)
	doc>>DocG.duplex = (Capabilities & mDuplex) ne 0
    doc>>DocG.FileHost = @(lv(spoolSocket>>EFTPSoc.iQ.head)>>PBI.pup.sPort.net)
    let s = WindowCreateStream(freeFile, ksTypeWriteBeforeRead, charItem, 0, 0, nahSpool)
    // Eftp away, storing into stream
	[
	let str, inPbi = nil, 0
	byteCount = ReceiveEFTPPacket(spoolSocket, InterPupTimeout, lv inPbi)
	switchon byteCount into
	    [
	    default: // >0 (or 0 and not end -- empty packet), got something
		[
		let wordCount = byteCount rshift 1
		let addr = lv inPbi>>PBI.pup.words^1
		if addr!0 eq PrInstPass0 & addr!1 eq PrInstPass1 then
		  if ParsePrintInstanceParams(addr+2,
			inPbi>>PBI.pup.length-pupOvBytes-4, doc)
		  then
		   [
		   ReleasePBI(inPbi)
		   if doc>>DocG.nPages ge freeFile>>SPruceFile.numPages then 
			[
			str = "Sorry, Spruce Spooling Facility Full -- Please Try Again Later."
			numMustPrint = 3
			byteCount = EFTPAbortSent
			docase EFTPServerFailed
			]
		   doc>>DocG.nPages = 0
		   loop
		   ]
		let wordsWrit = WindowWriteBlock(s, addr, wordCount)
		let chr = addr>>Byte^byteCount // in case odd
		ReleasePBI(inPbi)
		if wordCount ne wordsWrit do
			[
			str = PostStr; numMustPrint = 3
			byteCount = EFTPAbortSent
			docase EFTPServerFailed
			]
		if (byteCount&1) ne 0 then Puts(s, chr) // only works if last in file!!!!
		endcase
		]
	    case 0: // EFTPEndReceived (all done) or 0 (empty packet), depending on pbi existence
		test inPbi then docase 1 or break
	    case EFTPTimeout:
		numTimeouts = numTimeouts-1
		if numTimeouts ge 0 &   // if traffic is heavy, quit -- else be more tolerant
		  not spoolSocket>>EFTPSoc.SomeoneElseWaiting endcase // wait a while
		str = "Receiver timed out...."; docase EFTPFailed
	    case EFTPAbortSent: str = "Abort had to be sent from receiver...."; docase EFTPFailed
	    case EFTPAbortReceived: str = "EFTPAbort received while receiving...."; docase EFTPFailed
	    case EFTPResetReceived:
		str = "Reset Request ... expect a restart"
		spoolSocket>>EFTPSoc.SomeoneElseWaiting = true
		docase EFTPFailed
	    case EFTPNotFirstSynch: str = "First Packet Received out of synch"; docase EFTPFailed
	    case EFTPServerFailed:
		SendEFTPAbort(spoolSocket, ExternalReceiverAbort, str) // -- Abort, then Fall Thru --
	    case EFTPFailed:
		unless numMustPrint do numMustPrint = 1
		MoveBlock(lv doc>>DocG.FileStr, str, size DocG.FileStr/16)
		break
	    ]
	] repeat
    let numChars = CurrentPos(s)
    let numUsed =  Endofs(s)? freeFile>>SPruceFile.numPages, WindowNextPage(s) -1
    if not numChars & numUsed then numChars = freeFile>>SPruceFile.pageSize lshift 1
    doc>>DocG.PressFile =
	CreateSpruceSubfile(lv freeFile, 1, numUsed, numChars)
    Closes(s)
    doc>>DocG.reportCode = byteCount
    unless spoolSocket>>EFTPSoc.TransferNotStarted do
	doc>>DocG.FileHost = @(lv spoolSocket>>EFTPSoc.frnPort.net)
    resultis doc
    ]

// ------------------------------------------------------
and PrinterStatus() be // Respond to status requests
// ------------------------------------------------------
//	Listens on socket 21 for "Ears Protocol" status requests. Responds as directed by the protocol.
	[
	Block() repeatwhile statusSocket>>PupSoc.iQ.head eq 0
	let pbi = Dequeue(lv statusSocket>>PupSoc.iQ)
	switchon pbi>>PBI.pup.type into
	   [
	   default: ReleasePBI(pbi); endcase
	   case typePrinterStatusRequest:
		[
		ExchangePorts(pbi) // prepare to respond
		let response = not spooling? 1,
			2+(spoolSocket>>EFTPSoc.TransferNotStarted? 0, 1)
		pbi>>PBI.pup.words^1 = response
		let charPos = 3
		App(pbi,printerName, lv charPos)
		App(pbi," is ",lv charPos)
		App(pbi, selecton response into
		    [
		    case 1: "Unavailable "
		    case 2: "Spooling and waiting"
		    case 3: "Spooling and busy (file transfer in progress)"
		    ]		, lv charPos)
		if response eq 1 then App(pbi,reasonVec,lv charPos)
		App(pbi,"*N",lv charPos)
		CompletePup(pbi, typePrinterStatusReply)
		endcase
		]
		// Install UID stuff here
	   case typePrCapabilityRequest:
		[
		ExchangePorts(pbi) // prepare to respond
		let length = GenPrinterCapabilities(lv pbi>>PBI.pup.bytes)+pupOvBytes
		CompletePup(pbi, typePrCapabilityReply, length)
		endcase
		]
	   case typeJobStatusRequest:
		[
		ExchangePorts(pbi) // prepare to respond
		let length = GenJobStatus(lv pbi>>PBI.pup.bytes)+pupOvBytes
		CompletePup(pbi, typeJobStatusReply, length)
		endcase
		]
	   ]
	] repeat

// ------------------------------------------------------
and InitSpool(spruceCtxq) be
// ------------------------------------------------------
//	Initialize SproullerQ (spool queue), and spoolSocket (thus EFTP and Pup level 1.)
//	Start up the Status-listener context. spruceCtxq is the queue of contexts run in Spruce.
	[
	unless SpoolVec do SpoolVec = FSGetX(maxSpooled, SpruceZone, 0)
	InitializeQueue()	// Spooling queue
	spoolSocket = 0
	InitPupLevel1(SpruceZone, spruceCtxq, 10) // up to 10 buffers -- for now
	InitEFTPPackage()
	spoolSocket = FSGetX(lenEFTPSoc, SpruceZone, 0)
	statusSocket = FSGetX(lenPupSoc)
	OpenLevel1Socket(statusSocket, table [ 0; 0; socketPrinterStatus ])
	Enqueue(spruceCtxq,
		InitializeContext(FSGetX(STATStackSize), STATStackSize, PrinterStatus))
	// The spooler itself runs in the main program context (SproullerMain)
	]

// ------- Spooling utilities -------

// ------------------------------------------------------
and App(pbi, str, pCharPos) be
// ------------------------------------------------------
//	Pup error strings are placed in Pup data, with characters even-byte aligned, and no length.
// This function interfaces with the Pup level 1 utility for setting them up. It maintains a current
// end-of-string count that the utility requires but does not maintain.
	[
	AppendStringToPup(pbi, @pCharPos, str)
	@pCharPos = @pCharPos + str>>STR.length
	]

// compileif false then [
// ------------------------------------------------------
// let PrintAbortPBI(pbi) be
// ------------------------------------------------------
// ~~ PrintAbortPBI(...) is a good idea -- the posting equiv. (from abort case)
	// [
	// Puts(dsp,$*N); Wo(pbi>>PBI.pup.words^1); Ws(" - Abort:  ")
	// for i = 3 to (3 + (pbi>>PBI.pup.length-(pupOvBytes+2)) - 1) do
		// Puts(dsp, pbi>>PBI.pup.bytes^i)
	// ]
// ] // ~~ depending on complexity, could use in Uint post activity

// ------- History . . .

// DCS, July 15, 1977  4:53 PM, derived from SpruceSpool
// July 16, 1977  4:01 PM, tune for real environment
// July 18, 1977  6:41 PM, revisions for use with real main loop
// July 25, 1977  1:25 PM, assign fileCodes to spooled subfiles
// August 1, 1977  10:23 AM, add PrintStatus function
// August 3, 1977  1:42 PM, implement freeFile/spooled files invariants
// August 22, 1977  5:40 PM, fill in names after file arrives
// August 28, 1977  8:10 AM, Spruce->Sprint, Sprouller->Spruce
// September 7, 1977  12:34 PM, add Queue control (numMustPrint) code
// October 25, 1977  10:27 AM, upgrade spool error reporting, queue management
// November 3, 1977  8:26 PM, upgrade stand-alone printing, v4.(2,7)
// December 16, 1977  11:41 AM, post code releases doc after spool error
// December 16, 1977  11:41 AM, report sending host better
// January 6, 1978  5:39 PM, improve cursor reporting
// January 17, 1978  3:32 PM, Zero-length EFTP Data packet is OK
// January 23, 1978  8:28 AM, pressFileIndex wrap-around repaired
// May 15, 1978  9:40 PM, fix numMustPrint bug -- was far too conservative
// August 30, 1978  9:10 AM, massive revision, to use "queue object", clean up spooler
// September 1, 1978  11:04 AM, report full, not spooling reporting to end user
// September 3, 1978  6:55 PM, use static address in subfile creation -- create rel. other subfile
// September 5, 1978  9:56 AM, one more full file bug
// September 20, 1978  12:56 PM, document, reformat
// September 23, 1978  1:58 AM, use printerName instead of "Spruce" in status report
// October 15, 1978  4:38 PM, account for fast files
// April 25, 1979  11:28 AM use Spruce*.d names
// July 18, 1979  1:23 AM PLists for printer capabilities & print instance params
// January 18, 1980  1:47 PM, set DocG.duplex to mDuplex value before PList check
// March 4, 1980 9:41 AM, use static firstDCB to prevent loss of display stream
// March 4, 1980 1:00 PM, if there is a reason for not spooling, send it and echo on screen
// May 1, 1980, 12:46 PM, implement new protocol stuff
// February 3, 1981  2:41 PM, change handling of pressFileIndex

(635)\815b9B539b10B3539b32B83b51B440b11B5931b26B760b66B