// 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
CurPosition
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 = CurPosition(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.
[
// Allocate SpoolVec if it doesnt exist (no files spooled).
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