// PupRTPOpenClose.bcpl -- Rendezvous/Termination Protocol
// companion module is PupRTP.bcpl
// This module contains infrequently executed code which can swap
// without affecting performance.
// Copyright Xerox Corporation 1979, 1981

// last modified October 29, 1981  5:20 PM by Taft

get "Pup0.decl"
get "Pup1.decl"
get "PupRTPInternal.decl"

external
[
// outgoing procedures
OpenRTPSocket; CloseRTPSocket; CompleteRTPPup
RTPHandleUncommonPup; RTPFSM; BuildAbort

// incoming procedures
RTPSocketProcess; DefaultOtherPupProc; RTPFilter
CompletePup; AppendStringToPup; MultEq
SetPupDPort; SetPupID
InitializeContext; Block
Enqueue; Unqueue; InsertAfter
ReleasePBI; GetPBI
Zero; Allocate; Free; MoveBlock
DefaultArgs; Noop; SysErr
SetTimer; TimerHasExpired

// outgoing statics
lRTPSoc

// incoming statics
rtpStackSize; pupLevel1Ctx
pupZone; pupCtxQ; defaultTimeout
]

static [ lRTPSoc = lenRTPSoc ]

//----------------------------------------------------------------------------
let OpenRTPSocket(soc, ctxQ, openMode, connID, otherProc, timeout,
 zone; numargs na) = valof
//----------------------------------------------------------------------------
[
let defaultID = vec 1; SetTimer(defaultID, 0); defaultID!1 = soc
DefaultArgs(lv na, -1, pupCtxQ, modeInitAndWait, defaultID,
   DefaultOtherPupProc, defaultTimeout, pupZone)
let ctx = Allocate(zone, rtpStackSize)
InitializeContext(ctx, rtpStackSize, RTPSocketProcess, lenRTPCtxExtra)
ctx>>RTPCtx.socket = soc  // link from context to socket
ctx>>RTPCtx.zone = zone  // zone from which context allocated
ctx>>RTPCtx.ctxQ = ctxQ  // queue on which context placed
test ctxQ eq pupCtxQ  // same queue as PupLevel1's?
   ifso InsertAfter(ctxQ, pupLevel1Ctx, ctx)  // best position
   ifnot Enqueue(ctxQ, ctx)
soc>>RTPSoc.ctx = ctx  // link from socket to context
soc>>RTPSoc.connID^1 = connID!0
soc>>RTPSoc.connID^2 = connID!1
soc>>RTPSoc.rtpStatus = 0
soc>>RTPSoc.rtpOtherPupProc = otherProc
soc>>RTPSoc.rtpOtherTimerProc = Noop
let initState = nil
switchon openMode into
   [
   case modeInitAndWait: case modeInitAndReturn:
      [
      initState = RFCO
      RTPFSM(soc, OPNC)
      if openMode eq modeInitAndReturn then resultis true
      endcase
      ]
   case modeListenAndWait: case modeListenAndReturn:
      [
      initState = LIST; soc>>RTPSoc.wasListening = true
      RTPFSM(soc, OPNL)
      if openMode eq modeListenAndReturn then resultis true
      endcase
      ]
   case modeImmediateOpen:
      [
      RTPFSM(soc, OPNN)
      resultis true
      ]
   ]
let openTimer, state = nil, nil; SetTimer(lv openTimer, timeout)
   [
   Block()
   state = soc>>RTPSoc.state
   ] repeatuntil state ne initState % TimerHasExpired(lv openTimer)
if state eq OPEN % state eq ENDI then resultis true
CloseRTPSocket(soc, 0); resultis false
]

//----------------------------------------------------------------------------
and CloseRTPSocket(soc, timeout; numargs na) = valof
//----------------------------------------------------------------------------
// locally initiated close
[
if na ls 2 then timeout = defaultTimeout
if timeout ne 0 then RTPFSM(soc, CLSN)
let timer, state = nil, nil; SetTimer(lv timer, timeout)
   [
   state = soc>>RTPSoc.state
   test state eq ABOR % TimerHasExpired(lv timer)
      ifso [ RTPFSM(soc, CLST); timeout = 0 ]
      ifnot Block()
   ] repeatuntil state eq CLOS
let ctx = soc>>RTPSoc.ctx
while ctx>>RTPCtx.unclean do Block()
Unqueue(ctx>>RTPCtx.ctxQ, ctx)
Free(ctx>>RTPCtx.zone, ctx)
resultis timeout ne 0
]

//----------------------------------------------------------------------------
and RTPHandleUncommonPup(soc, pbi) = valof
//----------------------------------------------------------------------------
// Called for all Pup known to RTP, namely RFC, End, EndReply, Abort, Error.
// Either releases the supplied PBI and returns true, or leaves it to be
// passed to the higher-level handler and returns false.
[
let event = nil
switchon pbi>>PBI.pup.type into
   [
   case typeRFC:
      if pbi>>PBI.pup.bytes^1 eq 0 then  // default conn port net
         pbi>>PBI.pup.bytes^1 = pbi>>PBI.pup.sPort.net
      test selecton soc>>RTPSoc.state into
         [
         case LIST: RTPFilter(pbi, false, false)
         case RFCO: RTPFilter(pbi, true, true)
         case OPEN:
         case ENDO: RTPFilter(pbi, false, true) &
          MultEq(lv pbi>>PBI.pup.words, lv soc>>RTPSoc.frnPort, 3)
         default: false
         ]
         ifso RTPFSM(soc, RRFC, pbi)
         ifnot
            [
            let npbi = BuildAbort(soc, 0, "RFC refused")
            SetPupID(npbi, lv pbi>>PBI.pup.id)
            SetPupDPort(npbi, lv pbi>>PBI.pup.sPort)
            CompletePup(npbi)
            ]
      endcase

   case typeEnd:
      event = REND; docase -1

   case typeEndReply:
      event = RENR; docase -1

   case typeAbort:
      event = RABT; // docase -1

   case -1: // End, EndReply, Abort common handling
      if RTPFilter(pbi, true, true) then
         [
         RTPFSM(soc, event, pbi)
         unless event eq RENR do
            resultis false  // Ends and Aborts passed on
         ]
      endcase

   case typeError:
      if pbi>>PBI.pup.words^11 eq 2 & RTPFilter(pbi, true, false) then
         RTPFSM(soc, RABT, pbi)  // treat type 2 same as Abort
      resultis false  // Errors passed on
   ]

// if we get here, dispose of the PBI locally
ReleasePBI(pbi)
resultis true  // I did it
]

//----------------------------------------------------------------------------
and RTPFSM(soc, event, pbi) be
//----------------------------------------------------------------------------
// procedure to run the RTP finite state machine
[RTPFSM

structure Entry: [ action byte; nextState byte ]
structure FSM^CLOS,ABOR^OPNC,TIMO: @Entry

let fsm = table  // state x event => action+nextstate
[
// current state:
// CLOS    RFCO       LIST       OPEN       ENDI       ENDO       DALY       ABOR      //event

SRF1+RFCO; LERR+RFCO; LERR+LIST; LERR+OPEN; LERR+ENDI; LERR+ENDO; LERR+DALY; LERR+ABOR //OPNC
NOOP+LIST; LERR+RFCO; LERR+LIST; LERR+OPEN; LERR+ENDI; LERR+ENDO; LERR+DALY; LERR+ABOR //OPNL
NOOP+OPEN; LERR+RFCO; LERR+LIST; LERR+OPEN; LERR+ENDI; LERR+ENDO; LERR+DALY; LERR+ABOR //OPNN
NOOP+CLOS; SABT+CLOS; NOOP+CLOS; SEND+ENDO; SENR+DALY; NOOP+ENDO; NOOP+DALY; NOOP+CLOS //CLSN
NOOP+CLOS; SABT+CLOS; NOOP+CLOS; SABT+CLOS; SABT+CLOS; SABT+CLOS; NOOP+CLOS; NOOP+CLOS //CLST
FERR+CLOS; OPNX+OPEN; SRF2+OPEN; SRF2+OPEN; FERR+ENDI; SRF2+ENDO; FERR+DALY; FERR+ABOR //RRFC
FERR+CLOS; NOOP+ABOR; FERR+LIST; NOOP+ABOR; NOOP+ABOR; NOOP+ABOR; NOOP+ABOR; NOOP+ABOR //RABT
FERR+CLOS; FERR+RFCO; FERR+LIST; NOOP+ENDI; NOOP+ENDI; SENR+DALY; SENR+DALY; FERR+ABOR //REND
FERR+CLOS; FERR+RFCO; FERR+LIST; FERR+OPEN; FERR+ENDI; SENR+CLOS; NOOP+CLOS; FERR+ABOR //RENR
NOOP+CLOS; SRF1+RFCO; NOOP+LIST; NOOP+OPEN; NOOP+ENDI; SEND+ENDO; NOOP+CLOS; NOOP+ABOR //TIMO
]

let timeout = table  // timeout for state being entered
[
32000;     100;       32000;     32000;     32000;     100;       1000;      32000
]

let entry = fsm>>FSM^event^(soc>>RTPSoc.state)
RTPAction(entry<<Entry.action, soc, pbi)
soc>>RTPSoc.state = entry<<Entry.nextState
SetTimer(lv soc>>RTPSoc.rtpTimer, timeout!(soc>>RTPSoc.state))
]RTPFSM

//----------------------------------------------------------------------------
and RTPAction(action, soc, pbi) be
//----------------------------------------------------------------------------
// Actions invoked by the fsm
[
switchon action into
   [
   case SRF1 rshift 8:  // send initiating rfc
      pbi = GetPBI(soc)
      MoveBlock(lv pbi>>PBI.pup.words, lv soc>>RTPSoc.lclPort, lenPort)
      CompleteRTPPup(pbi, typeRFC, pupOvBytes+2*lenPort)
      endcase

   case SRF2 rshift 8:  // send answering rfc
      if soc>>RTPSoc.wasListening then
         [
         if soc>>RTPSoc.state eq LIST then
            [
            MoveBlock(lv soc>>RTPSoc.connID, lv pbi>>PBI.pup.id, 2)
            MoveBlock(lv soc>>RTPSoc.frnPort, lv pbi>>PBI.pup.words, lenPort)
            MoveBlock(lv soc>>RTPSoc.lclPort, lv pbi>>PBI.pup.dPort, lenPort)
            ]
         let npbi = GetPBI(soc)
         SetPupDPort(npbi, lv pbi>>PBI.pup.sPort)
         MoveBlock(lv npbi>>PBI.pup.words, lv soc>>RTPSoc.lclPort, lenPort)
         CompleteRTPPup(npbi, typeRFC, pupOvBytes+2*lenPort)
         ]
      endcase

   case OPNX rshift 8:  // got answer back to our rfc
      MoveBlock(lv soc>>RTPSoc.frnPort, lv pbi>>PBI.pup.words, lenPort)
      endcase

   case SABT rshift 8:  // send abort
      pbi = BuildAbort(soc, 0, (soc>>RTPSoc.state eq RFCO?
         "Connection attempt aborted", "Connection aborted"))
      SetPupID(pbi, lv soc>>RTPSoc.connID)
      CompletePup(pbi)
      endcase

   case SEND rshift 8:  // send end
   case SENR rshift 8:  // send end reply
      pbi = GetPBI(soc)
      // do this in-line to conserve stack space
      SetPupID(pbi, lv pbi>>PBI.socket>>RTPSoc.connID)
      CompletePup(pbi, (action eq SEND rshift 8? typeEnd, typeEndReply),
       pupOvBytes)
      endcase

   case LERR rshift 8:  // local error (my bug)
      SysErr(soc, ecImproperStateForEvent)

   case FERR rshift 8:  // foreign error (his bug)
   ]
]

//----------------------------------------------------------------------------
and BuildAbort(soc, code, string) = valof
//----------------------------------------------------------------------------
[
let pbi = GetPBI(soc)
pbi>>PBI.pup.type = typeAbort
pbi>>PBI.pup.words^1 = code
AppendStringToPup(pbi, 3, string)
resultis pbi
]

//----------------------------------------------------------------------------
and CompleteRTPPup(pbi, type, length) be
//----------------------------------------------------------------------------
[
SetPupID(pbi, lv pbi>>PBI.socket>>RTPSoc.connID)
CompletePup(pbi, type, length)
]