// CopyDiskNet1.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified December 11, 1981  7:35 PM by Boggs

get "Pup.decl"
get "CopyDisk.decl"
get "CopyDiskNet.decl"

external
[
// outgoing procedures
NetCompatible; NetPrintDA; NetCompare
NetReader; NetWriter; NetPrintBlock; PrintPort
GetBlock; PutBlock; PutString

// incoming procedures from OS and packages
BSPReadBlock; BSPWriteBlock; BSPForceOutput
Dequeue; Enqueue; Block; ReadCalendar
Allocate; Free; Zero; MoveBlock; Usc
Gets; Puts; PutTemplate; CopyString
DoubleIncrement; DoubleDifference; Divide32x16

// incoming procedures from CopyDisk
GetBuffer; ReleaseBuffer; FatalError; Wss

// incoming statics
sysZone; CtxRunning; ctxQ
debugFlag; dsp; controlLock; seriousErrors
userName; userPass; connName; connPass
]

//----------------------------------------------------------------------------
let NetCompatible(srcSS, snkSS) =
//----------------------------------------------------------------------------
   ((srcSS>>SS.compatible eq NetCompatible? snkSS, srcSS)>>SS.compatible)(srcSS, snkSS)

//----------------------------------------------------------------------------
and NetPrintDA(stream, ss) be
//----------------------------------------------------------------------------
   (ss>>SS.otherSS>>SS.printDA)(stream, ss>>SS.otherSS)

//----------------------------------------------------------------------------
and NetCompare(ss, buf1, buf2) =
//----------------------------------------------------------------------------
   (ss>>SS.otherSS>>SS.compare)(ss>>SS.otherSS, buf1, buf2)

//----------------------------------------------------------------------------
and PrintPort(stream, port) be
//----------------------------------------------------------------------------
[
Puts(stream, $[)
if port>>Port.net then PutTemplate(stream, "$UO#", port>>Port.net)
PutTemplate(stream, "$UO#", port>>Port.host)
if port>>Port.socket↑1 % port>>Port.socket↑2 then
   PutTemplate(stream, "$EUO", lv port>>Port.socket)
Puts(stream, $])
]

//----------------------------------------------------------------------------
and NetReader(ctx) be  //a context
//----------------------------------------------------------------------------
[
let ss = ctx>>CDCtx.ss

test controlLock eq user
   ifnot PutString(yes, 0, "ready")
   ifso
      [
      PutBlock(ss>>SS.dp, hereAreDiskParams)
      PutBlock(ss>>SS.tp, retrieveDisk)
      unless GetYesNo() eq yes do FatalError()
      ]

let bits = vec 1; Zero(bits, 2)
let start = vec 1; ReadCalendar(start)
   [
   let buffer = GetBuffer(false)
   unless GetBlock(lv buffer>>NetBuffer.length) do FatalError()
   Enqueue(ss>>SS.outputQ, buffer)
   if buffer>>NetBuffer.type ne hereIsDiskPage break
   DoubleIncrement(bits, buffer>>NetBuffer.length lshift 4)
   ] repeat
let stop = vec 1; ReadCalendar(stop)
Divide32x16(bits, DoubleDifference(stop, start))
if debugFlag then PutTemplate(dsp, "*N$EUD bits/sec", bits)

if controlLock eq user then
   [
   PutBlock(table [ 2; sendErrors ])
   if ss>>SS.errors ne 0 then Free(sysZone, ss>>SS.errors)
   ss>>SS.errors = GetBlock()
   ]

ss>>NetSS.doneFlag = true
Block() repeat
]

//----------------------------------------------------------------------------
and NetWriter(ctx) be  //a context
//----------------------------------------------------------------------------
[
let ss = ctx>>CDCtx.ss

test controlLock eq user
   ifnot PutString(yes, 0, "Here it comes")
   ifso
      [
      PutBlock(ss>>SS.dp, hereAreDiskParams)
      PutBlock(ss>>SS.tp, storeDisk)
      unless GetYesNo() eq yes do FatalError()
      ]

let bits = vec 1; Zero(bits, 2)
let start = vec 1; ReadCalendar(start)
   [
   Block() repeatwhile (ss>>SS.inputQ)!0 eq 0
   let buffer = Dequeue(ss>>SS.inputQ)
   unless PutBlock(lv buffer>>NetBuffer.length) do FatalError()
   ReleaseBuffer(buffer)
   if buffer>>NetBuffer.type ne hereIsDiskPage break
   DoubleIncrement(bits, buffer>>NetBuffer.length lshift 4)
   ] repeat
BSPForceOutput(ss>>NetSS.soc)
let stop = vec 1; ReadCalendar(stop)
Divide32x16(bits, DoubleDifference(stop, start))
if debugFlag then PutTemplate(dsp, "*N$EUD bits/sec", bits)

if controlLock eq user then
   [
   PutBlock(table [ 2; sendErrors ])
   if ss>>SS.errors ne 0 then Free(sysZone, ss>>SS.errors)
   ss>>SS.errors = GetBlock()
   ]

ss>>NetSS.doneFlag = true
Block() repeat
]

//----------------------------------------------------------------------------
and GetBlock(cd, complainIfEnd; numargs na) = valof
//----------------------------------------------------------------------------
// Eats comments.
// Uses 'cd' if it is supplied; it better be big enough!
[
if na ls 1 then cd = 0
let callerOwnsCD = cd ne 0
if na ls 2 then complainIfEnd = true
let ss = CtxRunning>>CDCtx.ss
let stream = ss>>NetSS.stream

   [
   let length = Gets(stream) lshift 8
   length = Gets(stream) + length
   if Usc(length, 1500) gr 0 then  //Gets returns -1 if stream has closed
      [
      if complainIfEnd then Wss(dsp, "*N[GetBlock] unreasonable length")
      resultis 0
      ]

   unless callerOwnsCD do cd = Allocate(sysZone, length)
   cd>>CD.length = length
   if BSPReadBlock(stream, cd+1, 0,
    (length-1) lshift 1) ne (length-1) lshift 1 then
      [
      Wss(dsp, "*N[GetBlock] BSPReadBlock failed")
      unless callerOwnsCD do Free(sysZone, cd)
      resultis 0
      ]

   unless cd>>CD.type eq hereIsDiskPage do NetPrintBlock(ss, cd, false)
   if cd>>CD.type eq comment then
      [ unless callerOwnsCD do Free(sysZone, cd); loop ]
   resultis cd
   ] repeat
]

//----------------------------------------------------------------------------
and GetYesNo() = valof
//----------------------------------------------------------------------------
// Call only from NetReader and NetWriter because it calls FatalError.
[
let cd = GetBlock(); if cd eq 0 then FatalError()
let yesNo = cd>>CD.type
Free(sysZone, cd)
if yesNo ne yes & yesNo ne no then
   FatalError("*N[GetYesNo] Unexpected block type $D", yesNo)
resultis yesNo
]

//----------------------------------------------------------------------------
and PutBlock(cd, type; numargs na) = valof
//----------------------------------------------------------------------------
[
let ss = CtxRunning>>CDCtx.ss
if na gr 1 then cd>>CD.type = type
let byteLen = cd>>CD.length lshift 1
if BSPWriteBlock(ss>>NetSS.stream, cd, 0, byteLen) ne byteLen then
   [
   Wss(dsp, "*N[PutBlock] BSPWriteBlock failed")
   resultis false
   ]
unless cd>>CD.type eq hereIsDiskPage do
   [
   BSPForceOutput(ss>>NetSS.soc)
   NetPrintBlock(ss, cd, true)
   ]
resultis true
]

//----------------------------------------------------------------------------
and PutString(type, code, string) be
//----------------------------------------------------------------------------
[
let length = lenCodeString + string>>String.length rshift 1 +1
let cd = Allocate(sysZone, length)
cd>>CD.length = length
cd>>CD.codeString.code = code
CopyString(lv cd>>CD.codeString.string, string)
PutBlock(cd, type, true)
Free(sysZone, cd)
]

//----------------------------------------------------------------------------
and NetPrintBlock(ss, cd, put; numargs na) be
//----------------------------------------------------------------------------
[
let type = cd>>CD.type
if na gr 2 then
   [
   unless debugFlag % (not put & (type eq version %
    type eq comment % type eq no)) return
   Puts(dsp, $*N)
   if debugFlag then PutTemplate(dsp, "$C: ",
    (put? (controlLock eq user? $U, $S), (controlLock eq user? $S, $U)))
   ]
if debugFlag % na ls 2 then put = false
switchon type into
   [
   case version: case no:
      [
      if debugFlag then PutTemplate(dsp, "[$S] <$D> ",
       (type eq version? "Version", "No"), cd>>CD.codeString.code)
      unless put do Wss(dsp, lv cd>>CD.codeString.string)
      if type eq no then seriousErrors = true
      endcase
      ]
   case yes:
      [
      PutTemplate(dsp, "[Yes] <$D> $S",
       cd>>CD.codeString.code, lv cd>>CD.codeString.string)
      endcase
      ]
   case sendDiskParamsR: case sendDiskParamsW:
      [
      PutTemplate(dsp, "[SendDiskParams$C] $S",
       (type eq sendDiskParamsR? $R, $W), lv cd>>CD.string)
      endcase
      ]
   case hereAreDiskParams:
      [ Wss(dsp, "[HereAreDiskParams] "); docase -1 ]
   case storeDisk:
      [ Wss(dsp, "[StoreDisk] "); docase -1 ]
   case retrieveDisk:
      [ Wss(dsp, "[RetrieveDisk] "); docase -1 ]
   case endOfTransfer:
      [ Wss(dsp, "[EndOfTransfer] "); endcase ]
   case sendErrors:
      [ Wss(dsp, "[SendErrors] "); endcase ]
   case hereAreErrors:
      [
      if debugFlag & na gr 2 then Wss(dsp, "[HereAreErrors] ")
      docase -1
      ]
   case comment:
      [
      if debugFlag then Wss(dsp, "[Comment] ")
      unless put do Wss(dsp, lv cd>>CD.string)
      endcase
      ]
   case login:
      [
      Wss(dsp, "[Login] ")
      let p = lv cd>>CD.string
      p = PrintNamePass(p, "uNam")
      p = PrintNamePass(p, "uPsw")
      p = PrintNamePass(p, "cNam")
      p = PrintNamePass(p, "cPsw")
      endcase
      ]
   case -1:
      [
      let otherSS = ss>>SS.otherSS
      if otherSS ne 0 then (otherSS>>SS.printBlock)(otherSS, cd)
      endcase
      ]
   ]
]

//----------------------------------------------------------------------------
and PrintNamePass(p, string) = valof
//----------------------------------------------------------------------------
[
if p>>String.length ne 0 then PutTemplate(dsp, "$S: $S ", string, p)
resultis p + p>>String.length rshift 1 +1
]