// IfsPressSend.bcpl -- Background process that sends Press files
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified April 9, 1982  12:45 PM by Taft

get wordItem, ST, par1 from "Streams.d"
get "IfsPress.decl"
get "PupEFTP.decl"
get "IfsRs.decl"
get "IfsName.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"

external
[
// outgoing procedures
InitPress; EnablePress; PressSendCtx; EnumeratePressQueue;

// incoming procedures
GenPrintInstance; GetPrinterCapabilities; PressEvent
LookupIFSFile; LookupFD; NextFD; LockDirFD; UnlockDirFD; DestroyFD
IFSOpenFile; OpenIFSStream; CloseIFSStream; DeleteFileFromFD
TransferLeaderPage; GetBufferForFD; CloseIFSFile
DestroyJob; DeclarePupSoc; CreateEvent; JobOK
Gets; Resets; Endofs; Closes; ReadBlock; WriteBlock; CleanupDiskStream
FilePos; SetFilePos; FileLength; KsBufferAddress; LnPageSize; PositionPtr
EnumeratePupAddresses
OpenEFTPSoc; CloseEFTPSoc; SendEFTPBlock; SendEFTPEnd; GetEFTPAbort
ExtractSubstring; DoubleDifference; DoubleIncrement; DoubleUsc; DoubleSubtract
MultEq; SetTimer; TimerHasExpired; Dismiss
SysAllocate; SysAllocateZero; SysFree; Zero; MoveBlock; ReadCalendar; Usc

// outgoing statics
@pps

// incoming statics
CtxRunning; system
]

static [ @pps ]

// The Press printing queue is represented as files whose names are
// of the form <System>Press>hostname, where hostname is the name of
// the printing server.  Each file contains one or more Press Queue Entries
// (PQE) describing a Press file to be printed.  Queueing up a new Press file
// consists simply of appending a new PQE to the end of the queue file
// for the destination printing host.

// The background Press file sender context reads through the queue files.
// For each PQE marked pending, it attempts to send the Press file named
// in the PQE to the designated printer.  Upon success or permanent
// failure, it marks the PQE as having been completed.  If the printing
// host is not responding, the PQE is left for a later retry.
// When all PQEs in a queue file have been processed, the file is deleted.

// At present only one version of a queue file for a particular server
// is permitted to exist, and no information is left behind after a
// printing request has been completed.  Possible improvements on this
// scheme are obvious.

//----------------------------------------------------------------------------
let InitPress() be
//----------------------------------------------------------------------------
[
pps = SysAllocateZero(lenPPS)
CreateEvent(PressEvent, 6000)
]

//----------------------------------------------------------------------------
and EnablePress(value) be pps>>PPS.enable = value
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and PressSendCtx(ctx) be
//----------------------------------------------------------------------------
// This is the context woken up to do the work.  It self-destructs when done.
[ // repeat
CtxRunning>>RSCtx.userInfo = system
pps>>PPS.somethingToDo = false
pps>>PPS.timer = retryInterval/pressCheckInterval
let serverDown = nil

EnumeratePressQueue(PressWantFile, PressSendFile, lv serverDown)

unless pps>>PPS.somethingToDo do pps>>PPS.timer = 32767
if pps>>PPS.timer ne 0 then
   [ pps>>PPS.ctx = 0; DestroyJob() ]
] repeat

//----------------------------------------------------------------------------
and PressWantFile(qfd, lvServerDown) = valof
//----------------------------------------------------------------------------
[
@lvServerDown = false
pps>>PPS.somethingToDo = true
unless JobOK(jobTypePress) resultis false

// Process this queue file only if
// (1) it was written more recently than last read, meaning new items
//     have been appended to it, or
// (2) it was last read more than retryInterval seconds ago.
let buf = GetBufferForFD(qfd)
TransferLeaderPage(qfd, buf)
let now = vec 2; ReadCalendar(now)
let wantFile = DoubleUsc(lv buf>>ILD.written, lv buf>>ILD.read) ge 0 %
 DoubleDifference(now, lv buf>>ILD.read) ge retryInterval
SysFree(buf)
resultis wantFile
]

//----------------------------------------------------------------------------
and PressSendFile(pqe, serverName, lvServerDown) = valof
//----------------------------------------------------------------------------
// Attempts to send the press file described by pqe to the specified server.
// Returns true if the request is completed or otherwise disposed of
//  and false if unable to contact the printing server.
// Updates the pqe.status in the true case.
[
let now = vec 1; ReadCalendar(now)
DoubleSubtract(now, table [ 0; discardTimeout ])
if DoubleUsc(lv pqe>>PQE.time, now) ls 0 then
   [ pqe>>PQE.status = ecPQETimedOut; resultis true ]
if @lvServerDown % pqe>>PQE.status ne ecPQEPending resultis false

let ec = nil
let stream = IFSOpenFile(pqe+pqe>>PQE.fileName, lv ec)
if stream eq 0 then  // file seems to have gone away
   [ pqe>>PQE.status = ec; resultis true ]

// Compute file length in 256-word records
let fileLength = vec 1; FileLength(stream, fileLength)
let nRecords = fileLength!0 lshift 7 + fileLength!1 rshift 9

// Convert the server name to a port
let port = vec lenPort
ec = EnumeratePupAddresses(serverName, 0, port)
if ec ne 0 then
   [
   Closes(stream)
   switchon ec into
      [
      case ecCantGetThere:
      case ecNoServerResponded:
         @lvServerDown = true; resultis false  // transient failure, retry
      default:
         pqe>>PQE.status = ec; resultis true  // permanent failure
      ]
   ]
if port>>Port.socket↑1 eq 0 & port>>Port.socket↑2 eq 0 then
   port>>Port.socket↑2 = socketEFTPReceive

// Check printer capabilities if Spruce 11 format required.
if pqe>>PQE.spruce11 then
   // GetPrinterCapabilities will adjust the Spruce 11 requests in
   // the pqe according to the capabilities of the server.  If no 
   // capability reply is received, then the print request will be
   // issued without any Spruce 11 features.  If the server returns
   // a printer busy or not available status, then @lvServerDown will
   // be set so that the request can be retried later.
   switchon GetPrinterCapabilities(port, pqe) into
      [
      case psGotCapabilities:
         endcase;
      case psNotSpooling:
      case psSpoolingAndBusy:
         @lvServerDown = true;
         Closes(stream); resultis false;
      default:
         pqe>>PQE.spruce11 = false;
         endcase;
      ]

// Open an EFTP socket and begin the transfer
let soc = vec lenEFTPSoc
OpenEFTPSoc(soc, 0, port)
DeclarePupSoc(soc)

// SendPressFile (cont'd)

// Main loop of transfer
let recNum, ptr = 0, nil
let timer = nil; SetTimer(lv timer, 100*deadTimeout)

   [ // repeat
   if recNum eq 0 then
      [
      Resets(stream); ptr = 0
      if pqe>>PQE.spruce11 then
         [
         let buf = SysAllocate(256);
         let nBytes = GenPrintInstance(buf, pqe);
         ec = SendEFTPBlock(soc, buf, nBytes, 100*deadTimeout);
         SysFree(buf);
         ]
      ]
   let rec = KsBufferAddress(stream) + ptr rshift 1
   if recNum eq nRecords-1 then
      [  // have document directory in the buffer now
      MoveBlock(lv rec>>DDV.FileStr, pqe+pqe>>PQE.fileName,
       size DDV.FileStr/16)
      MoveBlock(lv rec>>DDV.CreatStr, pqe+pqe>>PQE.requestorName,
       size DDV.CreatStr/16)
      rec>>DDV.fCopy = 1; rec>>DDV.lCopy = pqe>>PQE.copies
      rec>>DDV.fPage = -1; rec>>DDV.lPage = -1
      ]

   // Send record, or End if all records now sent
   unless ec ls 0 do  // This check is for the errors in the Spruce11 case.
    ec = recNum ls nRecords? SendEFTPBlock(soc, rec, 512, 100*deadTimeout),
     (SendEFTPEnd(soc, 100*deadTimeout)? 0, EFTPTimeout)
   if ec ls 0 then
      switchon ec into
         [
         case EFTPAbortReceived:
            switchon GetEFTPAbort(soc)>>PBI.pup.words↑1 into
               [
               default:  // abandon this attempt, retry later
                  break
               case FileRejectAbort:
                  // Change this to discard the printing request when (if?)
                  // Spruce is modified to generate this error only in
                  // appropriate circumstances.
               case ReceiverBusyAbort:  // restart after 1-second wait
                  Dismiss(100)
               case OutOfSynchAbort:  // restart immediately
                  // fall thru
               ]
         case EFTPAbortSent:  // restart immediately
            soc>>EFTPSoc.SeqNum = 0
            recNum = 0; loop
         //case EFTPTimeout:  // abandon this attempt, retry later
         default: break
         ]
   if recNum eq nRecords then  // file sent successfully
      [ pqe>>PQE.status = ecPQECompleted; break ]

   // advance to next record
   SetTimer(lv timer, 100*deadTimeout)  // making progress, reset timer
   recNum = recNum+1; ptr = ptr+512
   PositionPtr(stream, ptr, false)  // will stop at eof
   if ptr eq 2 lshift LnPageSize(stream) then
      [ ptr = 0; CleanupDiskStream(stream) ] // advance to next page
   ] repeatuntil TimerHasExpired(lv timer)

CloseEFTPSoc(soc)
DeclarePupSoc(0)
Closes(stream)

if ec ne 0 then @lvServerDown = true
resultis ec eq 0
]

//----------------------------------------------------------------------------
and EnumeratePressQueue(WantFile, HandlePQE, arg) be
//----------------------------------------------------------------------------
// Enumerates the Press printing queue.
// For each queue file (i.e., each printing server with pending requests),
// calls WantFile(fd, arg) with the directory locked.
// If WantFile returns true, the file is processed; if false, skipped over.
// Then, for each PQE in the file, calls HandlePQE(pqe, serverName, arg).
// If HandlePQE returns true, the PQE is rewritten into the file.
// Finally, if the file contains no PQEs with status = pending, deletes
// the file.
// Note: caller must have privileges to open Press queue files for writing.
[
let qfd = LookupIFSFile("<System>Press>**", lcVAll+lcMultiple)
if qfd eq 0 return

   [ // repeat -- for each file
   let wantThis = LookupFD(qfd, lockRead) eq 0? WantFile(qfd, arg), false
   UnlockDirFD(qfd)
   unless wantThis do loop

   // Remember the FP of this file -- so we can detect whether or not
   // the file has been deleted and recreated during subsequent opens.
   let qFP = vec lFP
   MoveBlock(qFP, lv qfd>>FD.dr>>DR.fp, lFP)

   // Call HandlePQE(pqe, serverName) for each entry in the file.
   // n.b. do not keep file open while we are doing this, since
   // HandlePQE might take arbitrarily long.
   let serverName = ExtractSubstring(lv qfd>>FD.dr>>DR.pathName,
    qfd>>FD.lenSubDirString+1, qfd>>FD.lenBodyString-1)
   let pqe = vec maxLenPQE
   let pos = vec 1; Zero(pos, 2)
   let rewriteLast = false
   let foundPending = false
   let busyCount = 0

      [ // repeat -- for each PQE
      let ec = nil
      let stream = OpenIFSStream(qfd, lv ec, modeReadWrite, wordItem)
      if stream eq 0 then
         [
         if ec ne ecFileBusy % busyCount gr 10 then break
         busyCount = busyCount+1
         Dismiss(100)
         loop
         ]
      unless MultEq(lv qfd>>FD.dr>>DR.fp, qFP, lFP) do
         [ CloseIFSStream(stream); break ]  // not the same file as before

// EnumeratePressQueue (cont'd)

      // Here have file open.  Process next entry.
      SetFilePos(stream, pos)
      if rewriteLast then WriteBlock(stream, pqe, pqe!0)
      rewriteLast = false
      FilePos(stream, pos)

      if Endofs(stream) then
         [
         // If no pending entries, delete file.  To prevent races,
         // pass open file to DeleteFileFromFD.
         CloseIFSStream(stream, not foundPending)
         unless foundPending do
            if DeleteFileFromFD(qfd, false, true) ne 0 then CloseIFSFile(qfd)
         break
         ]

      let pqeOK = valof
         [
         pqe!0 = Gets(stream)
         if Usc(pqe!0, maxLenPQE) gr 0 resultis false
         resultis ReadBlock(stream, pqe+1, pqe!0-1) eq pqe!0-1
         ]
      CloseIFSStream(stream)
      unless pqeOK break

      rewriteLast = HandlePQE(pqe, serverName, arg)
      unless rewriteLast do DoubleIncrement(pos, pqe!0 lshift 1)
      foundPending = foundPending % (pqe>>PQE.status eq ecPQEPending)
      ] repeat

   SysFree(serverName)
   ] repeatwhile NextFD(qfd)

DestroyFD(qfd)
]