include  "ERCC10.MULTIspecs"

record  format  parmf(integer  dest, srce, p1, p2, p3, p4, p5, p6)
recordformat  rf(integer  conad,filetype,datastart,dataend)
systemroutinespec  connect(string (31) file, integer  mode,hole,protect,
 record (rf)name  r, integername  flag)
systemroutinespec  disconnect(string (31) file, integername  flag)
external  routine  spec  mprintp(record  (parmf) p)
external  routine  spec  give monitoring(string  name  tim, integer  name  secs, nbytes)
system  string  fn  spec  itos(integer  i)
external  integer  fn  spec  bin(string  (255) s)
system  routine  spec  uctranslate(integer  adr, len)


externalintegerfnspec  dexecmess(string (6) user,integer  sact,len,addr)

routine  uctran(string  name  s)
   uctranslate(addr(s)+1, length(s))
end  {uctran}
constbyteinteger  not used = 255
constinteger  oper display size = 22
constinteger  max consoles = 127

constbyteinteger  info = 0
constbyteinteger  activity permitted = 1
constbyteinteger  manager = 2

constbyteinteger  not logged on = 0
constbyteinteger  logged on ok = 1



const  string  (1) snl="
"
conststring (31) manager only = "Manager console access only."


conststringname  date = x'80C0003F'
conststringname  time = x'80C0004B'

owninteger  already connected = 0

owninteger  qs = 256
owninteger  strms = 256
owninteger  rmts = 256


own  integer  array  consoles(0:127)=255(128)

recordformat  connectionf (string (15) name, string (63) it connection,
    integer  display type, which display, which page, source, string (10) specific user,
  byteinteger  status,type, disabled)

own  record (connectionf)array  connections(0 : max consoles)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!We now have the declarations wholesale from spoolr.

conststring  (7) array  stream type(0 : 3) =         c 
"Output",
"Input",
"Job",
"Process"
conststring  (17) array  stream status type(0 : 8) =  c 
"Unallocated",
"Allocated",
"Active",
"Connecting",
"Disconnecting",
"Aborting",
"Suspending",
"Deallocating",
"Aborted"
conststring  (11) array  remote status type(0 : 5) =  c 
"Closed",
"Open",
"Logging On",
"Logged On",
"Switching",
"Logging Off"
constinteger  n modes = 2
conststring  (3) array  modes(0 : n modes) =         c 
"ISO", "EBC", "BIN"
conststring  (15) array  doc state(0 : 6) =  c 
"Deleted",
"Queued",
"Sending",
"Running",
"Receiving",
"Processing",
"Transferring"

constinteger  n priorities = 5
conststring  (5) array  priorities(1 : n priorities) =       c 
"VLOW",
"LOW",
"STD",
"HIGH",
"VHIGH"

constbyteintegerarray  connect retry times (0 : 10) = c 
0,5,10,10,15,25,40,60,60,60,60
conststring  (2) array  ocp type(0 : 15) =         c 
"??", "50", "60", "70", "80", "72", "72", "??", "??", "??", "??", "??", "??", "??",
"??", "??"
conststring  (2) array  device type(0 : 15) =      c 
"NA", "PP", "PR", "CP", "CR", "MT", "LP", "GP", "OP", "MP", "DO",
"NA", "CT", "SU", "FE", "NA"
constinteger  on = 1
constinteger  off = 0
constinteger  no = 0
constinteger  yes = 1
constinteger  locked = 2

conststring  (12) array  header type(1 : 3) =     c 
"Line Printer", "Paper Tape", "Card Punch"
constintegerarray  prtys(1 : n priorities) =     c 
1, 1000001, 2000001, 3000001, 4000001
constinteger  max fsys = 99
constinteger  no route = 0
constinteger  p station = 0
constinteger  max documents = 1000;     !MAX DOCUMENT DESCRIPTORS ON EACH FILE SYSTEM
constinteger  document entry size = 256;!SIZE IN BYTES OF A DOCUMENT DESCRIPTOR
constinteger  info size = 256;          !SIZE IN BYTES OF INFO RETURNED TO USERS
constinteger  max priority = 10000;      !PRIORITY ADDED TO BASE PRIORITY IF RESOURCE = 0
constinteger  small weight = 4;         !THIS SHOULD BE INCREASED TO FAVOUR SMALL JOBS
constinteger  requested = 255
constinteger  ok = 0;                   !GENERAL SUCCESSFUL REPLY FLAG
constinteger  rejected = 3
constinteger  unused = 0;               !DESCRIPTOR STATUS
constinteger  queued = 1;               !DITTO
constinteger  sending = 2;              !DITTO
constinteger  running = 3;              !DITTO
constinteger  receiving = 4;            !DITTO
constinteger  processing = 5;           !DITTO
constinteger  transferring = 6;  !FTP file transfer activity
constinteger  closed = 0;               !REMOTE STATUS
constinteger  open = 1;                 !DITTO
constinteger  logging on = 2;           !DITTO
constinteger  logged on = 3;            !DITTO
constinteger  switching = 4;            !DITTO
constinteger  logging off = 5;          !DITTO
constinteger  unallocated = 0;          !STREAM STATUS
constinteger  allocated = 1;            !DITTO
constinteger  active = 2;               !DITTO
constinteger  connecting = 3;           !DITTO
constinteger  disconnecting = 4;        !DITTO
constinteger  aborting = 5;             !DITTO
constinteger  suspending = 6;           !DITTO
constinteger  deallocating = 7;         !DITTO
constinteger  aborted = 8;   !used by ftp line only
constinteger  all queues = 1;           !WHICH DISPLAY TYPE
constinteger  all streams = 2;          !DITTO
constinteger  individual queue = 3;     !DITTO
constinteger  individual stream = 4;    !DITTO
constinteger  non empty queues = 5;     !DITTO
constinteger  active streams = 6;       !DITTO
constinteger  individual document = 7;  !DITTO
constinteger  full individual queue = 8;!DITTO
constinteger  all remotes = 9;          !DITTO
constinteger  logged on remotes = 10;   !DITTO
constinteger  individual remote = 11;   !DITTO
constinteger  file header size = 32;    !SS STANDARD FILE HEADER SIZE
constinteger  r = b'00000001';          !READ PERMITION
constinteger  w = b'00000010';          !WRITE PERMITION
constinteger  s = b'00001000'
constinteger  zerod = b'00000100';      !ZERO FILE ON CREATION
constinteger  tempfi = b'00000001';     !TEMP FILE ON CREATION
constinteger  list size = 1000;         !SIZE OF QUEUE CELLS LIST
constinteger  max fep = 7;              !MAXIMUM FEPS SUPPORTED
constinteger  last q per stream = 15;   !NUMBER OF QUEUES BEING SERVED BY ONE STREAM
constinteger  last stream per q = 15;   !NUMBER OF LAST STREAM SERVING EACH Q
constinteger  queue dest = 1
constinteger  file dest = 2
constinteger  newfile dest = 3
constinteger  null dest = 4
!
constinteger  output = 0;               !serviceINE STREAM TYPE
constinteger  input = 1;                !DITTO
constinteger  job = 2;                  !DITTO
constinteger  process = 3;              !DITTO

!Now the document property identifers.
constbyteinteger  dap batch flag = x'01'
constbyteinteger  media hold = x'01'
constbyteinteger  dap hold   = x'02'
constbyteinteger  not media  = x'fe'
constbyteinteger  not dap    = x'fd'
constinteger  prelogon tied = 2;     !INDICATES TYPE OF PRELOGGED ON STATE OF A REMOTE.
constinteger  prelogon untied = 1
constinteger  unknown type = 0
constinteger  NSI type = 1
constinteger  X25 type = 2

!*

recordformat  pe(integer  dest, srce, p1, p2, p3, p4, p5, p6)

recordformat  pointers f(integer  queues, queue entry size, queue displ,
    queue name displ, streams, stream entry size, stream displ,
    stream name displ, remotes, remote entry size, remote displ,
    remote name displ, ftp stations, station entry size,
    ftp station displ)

recordformat  document descriptorf(byteinteger  state,
   string (6) user,
   string (15) dest,
   integer  date and time received,
            date and time started,
            halfinteger  dap mins, dap c exec time,
            integer  date and time deleted,
            start after date and time, priority, data start, data length,
            integer  time, output limit,
   halfinteger  mode of access,
   byteinteger  priority requested, forms, mode, copies, order,
                rerun, decks, drives, fails, outdev,
                srce, output, delivery, name,
   (byteintegerarray  vol label(1:8) or  byteintegerarray  ftp spares(1:8)),
   byteinteger  external user, external password, external name,
                ftp alias, storage codename, device type, device qualifier,
                data type, text storage,
                ftp user flags, ftp file password,
                sp1,sp2,sp3,sp4,sp5,
   byteinteger  properties,
   byteinteger  try emas to emas, ftp retry level,
   (byteinteger  string ptr or  string (148) string space))

!*

recordformat  queuef(string (15) name,
   (halfintegerarray  streams(0 : 15) or  halfintegerarray  lines(0 : 15)),
   string  (7) default user,
   string  (31) default delivery,
   integer  default start, default priority, default time,
   default output limit, default forms, default mode, default copies,
   default rerun, length, head, max length, maxacr,
   halfinteger  q by, general access, integer  resource limit,
   amount)
!*
recordformat  remotef(string  (15) name,
  integer  status, lowest stream, highest stream, fep, old fep,
  prelog fep, prelog, timeout, polling, command lock,
  byteinteger  unused1, unused2, network address type,
  (byteinteger  network address len, byteintegerarray  network add(0 : 63) c 
   or  string (64) x25 address),  byteintegerarray  fep route value(0:max fep),
  string (31) description,  string (7) password)
!*
!*
!Note that the stream tables (and FTP line tables) are in two sections.
!The first gives basic information used on stream 'scans', ie in
!response to a QUEUE user command for active documents. The first section
!will fit in a single page. The second sections contains the meaty bits.
!
recordformat  details f(string (15) name, string (7) user)

recordformat  stream f(string (15) name, string (7) unit name,
  integer  q no, halfintegerarray  queues(0 : 15),
  integer  status, bytes sent, bytes to go, block, part blocks,
           document, string (6) barred user, byteinteger  spare1, integer  spare3,
  byteinteger  service, user abort, unit size, fep,
  integer  remote, abort retry count, offset,
           (integer  in comms stream or  integer  comms stream),
           integer  out comms stream,
           (integer  in stream ident or  integer  ident),
           integer  out stream ident,
 (integer  limit, account,
  byteinteger  device type, device no, forms, lowest priority,
               header type, header number, batch enable, invoc,
  string (55) unused or  integer  transfer status, tcc subtype,
           in block addr, out block addr,
  byteinteger  activity, station type, station ptr, suspend,
               in stream status, out stream status,
               timer, output buffer status, output transfer pending, sp1,sp2,sp3,
  integer  aux document, pre abort status, bytes transferred,
  record (pe) output transfer record))
!*
!*
recordformat  lcf(integer  document, priority, size,
  (byteinteger  station ptr,ftp timer,ftp flags,gen flags or  integer  flags),
   integer  link,string (7) user)
!*
recordformat  fhf(integer  end, start, size, type, free hole,
   datetime, spare1, spare2)

recordformat  message f(string (15) remote name, string (63) message)
!*

stringfn  doc string(record (document descriptor f)name  document,
  byteintegername  ptr)
  if  ptr = 0 then  result  = "" else  c 
   result  = string(addr(document_string space) + ptr)
end 


integerfn  s to i(string (255) s)
string  (255) p, ns1, ns2
integer  total, sign, ad, i, j, hex
   hex = 0;  total = 0;  sign = 1
   ad = addr(p)
a: if  s ->ns1.(" ").ns2 and  ns1="" then  s=ns2 and  -> a; !CHOP LEADING SPACES
   if  s ->ns1.("-").ns2 and  ns1="" then  s=ns2 and  sign = -1
   if  s ->ns1.("X").ns2 and  ns1="" then  s=ns2 and  hex = 1 and  -> a
   p = s
   unless  s -> p.(" ").s then  s = ""
   i = 1
   while  i <= byteinteger(ad) cycle 
      j = byte integer(i+ad)
      -> fault unless  '0' <= j <= '9' or  (hex # 0 c 
         and  'A' <= j <= 'F')
      if  hex = 0 then  total = 10*total c 
         else  total = total<<4+9*j>>6
      total = total+j&15;  i = i+1
   repeat 
   if  hex # 0 and  i > 9 then  -> fault
   if  i > 1 then  result  = sign*total
fault:

   s = p.s
   result  = x'80808080'
end ;                                   !OF INTEGERFN S TO I




!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!The main entry points now follow


external  routine  m initialise(string (63) user,pass,it connection,integer  console)

record (remote f)arrayformat  rarf (1 : rmts)
record (remote f)arrayname  remotes

record (connectionf)name  connection
record (pointers f)name  pointers
record (rf)re
STRING (63) CALL
integer  i, entry, flag
   entry = -1
   for  i = 0,1,max consoles cycle 
     if  consoles(i) = not used then  entry = i and  exit 
   repeat 
   if  entry = -1 start 
     !All consoles in use.
     iprintstring("Sorry, busy"); inewline
     ilogoff(console)
     return 
   finish 
   cycle 
    if  pass # "" and  (charno(pass,length(pass)) = 13 or  charno(pass,length(pass)) = nl) c 
      then  length(pass) = length(pass) - 1 else  exit 
   repeat 

   connect("SPOOLR.CFILEPTRS",r!s,0,0,re,flag)
   if  flag # 0 and  flag # 34 start 
     iprintstring( "CFILEPTRS conn fail ".itos(flag).snl)
     ilogoff(console)
     return 
   finish 
   pointers == record(re_conad+file header size)
   if  qs = 256 start 
     !this is the first time in.
     qs = pointers_queues
     strms = pointers_streams
     rmts = pointers_remotes
   finish 
   connection == connections(entry)
   consoles(entry) = console

   connection = 0
   connect("SPOOLR.CFILE",r!s,0,0,re,flag)
   if  flag # 0 and  flag # 34 start 
    iprintstring("CFILE conn fails ".itos(flag).snl)
     ilogoff(console)
    return 
   finish 
   remotes == array(re_conad+pointers_remote displ,rarf)
   if  user -> ("REMOTE ").user start 
     cycle 
       exit  unless  user -> (" ").user
     repeat 
     if  user = "MANAGER" then  user = "LOCAL"
     cycle  i = 1,1,rmts
       if  remotes(i)_name = user then  connection_source = i and  exit 
     repeat 
     if  connection_source = 0 then  iprintstring(user." not known".snl) and  c 
      ilogoff(console) and  return 
     connection_type = activity permitted
     unless  pass -> ("X25").pass or  pass -> ("TS").pass then  iprintstring("Invalid pass".snl) c 
      and  ilogoff(console) and  return 
     call = "OPER(".user.")CHECKPASS:".itos(connection_source)."/". c 
      itos(entry)."/".pass
     flag = dexecmess("SPOOLR",1,length(call),addr(call)+1)
     if  flag # 0 then  iprintstring("SPOOLER unavailable".snl) and  ilogoff(console) and  return 
     if  user = "LOCAL" then  user = "MANAGER" and  connection_source = 0
     connection_name = user
     connection_disabled = locked
   finish  else  iprintstring("User name: 'REMOTE <name>'".snl) and  c 
     ilogoff(console) and  return 
  IPROMPT("<> ")
end  {m initialise}


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
external  routine  m input(string  (255) call, integer  console)

string  (255) aaa, bbb, tim
integer  i, n, secs, nbytes, j, unass, entry, found, flag
!*
! R E C O R D A R R A Y F O R M A T S
! - - - - - - - - - - - - - - - - - -
record (lcf)arrayformat  list cells af(1 : list size)
record (details f)arrayformat  qnaf(1 : qs)
record (queuef)arrayformat  qarf(1 : qs)
record (details f)arrayformat  rnaf(1 : rmts)
record (remotef)arrayformat  rarf(1 : rmts)
record (details f)arrayformat  snaf(1 : strms)
record (streamf)arrayformat  sarf(1 : strms)
!*
!*
! R E C O R D A R R A Y N A M E S
! - - - - - - - - - - - - - - - -
record (lcf)arrayname  list cells
record (details f)arrayname  queue names
record (queuef)arrayname  queues
record (details f)arrayname  remote names
record (remotef)arrayname  remotes
record (details f)arrayname  stream details
record (streamf)arrayname  streams
!*
!*
! R E C O R D S

record (connectionf)name  connection
record (pointers f)name  pointers
record (rf)re

stringfnspec  ident to s(integer  ident)
stringfnspec  i to ss(integer  i, l)
stringfnspec  unpack date(integer  datetime)
stringfnspec  unpack time(integer  datetime)
integerfnspec  pack date and time(string  (8) date, time)
string (15)fnspec  hms(integer  secs)
routinespec  interpret command
   uctran(call)
   length(call)=length(call)-1 if  call#"" and  charno(call, length(call))=nl
   if  call="?" or  call="HELP" start 
iprintstring("HELP information will be available soon (ish)".snl)
iterminate
!      iprintstring("and user-level commands are:")
!      inewline
!      iprintstring("   PRINT <n>,  USERS, SETLOGOUTDELAY<secs>, GETMON,  CONSOLES,  <n> : <text>")
!      inewline
!      iprintstring( %c
!         "The latter is a means of sending text to another console (from list given by CONSOLES)")
!      inewline
!      iprintstring("And PRINT <n>  is a test routine to send n characters to this terminal")
!     INEWLINE
   finish  else  if  call="CONSOLES" start 
      iprintstring("Logged-on consoles: ".SNL)
      n=0
      for  i=0, 1, 127 cycle 
         if  consoles(i)#255 then  n=n+1 and  iprintstring("Console ".itos(consoles(i))." : ".CONNECTIONS(I)_NAME.snl)
      repeat 
   finish  else  if  call->aaa.("PRINT").bbb start 
      n=bin(bbb)
      if  0<n<=x'b00' start 
         i=0
         cycle 
            aaa=itos(i)
            aaa="0".aaa while  length(aaa)<4
            aaa=" ".aaa
            if  ioutpos>60 then  aaa=aaa.snl
            iprintstring(aaa)
            i=i+length(aaa)
            exit  if  i>n
         repeat 
      finish 
   finish  else  if  call="GETMON" start 
      give monitoring(tim, secs, nbytes)
      iprintstring(itos(nbytes)." bytes at ".tim." term after ".itos(secs))
   finish  else  if  call->aaa.("SETLOGOUTDELAY").bbb start 
      i=bin(bbb)
      if  0<=i<=60*60 {1hr} then  iset logout delay(i) else  iprintstring("Invalid value")
   finish  else  if  call="UNASS" start 
      j=unass
   finish  else  if  length(call)>2 and  call->aaa.(":").bbb and  length(aaa)>0 start 
      ! Try for inter-console communication: aaa should be a console number
      i=bin(aaa)
      if  0<i<=127 start 
         found=0
         for  j=0, 1, 127 cycle 
            if  consoles(j)=i then  connection == connections(j) and  found=1
         repeat 
         if  found=0 then  iprintstring("Console ".itos(i)." not connected") else  start 
            iselect output(i)
            iprintstring(snl."From ".itos(console)." (".CONNECTION_NAME. C 
") ".": ".bbb.SNL)
         finish 
      finish  else  iprintstring("Invalid console number")
   finish  else  start 

     !******************** This is the REMOTE user service entry point.

     cycle  i = 0,1,maxconsoles
      if  consoles(i) = console then  connection == connections(i) and  entry = i and  exit 
      if  i = max consoles start 
        iprintstring("Console match fail..disaster".snl)
         return 
      finish 
     repeat 

    if  already connected = no start 
      connect("SPOOLR.CFILEPTRS",r!s,0,0,re,flag)
      if  flag # 0 and  flag # 34 start 
        iprintstring("CFILEPTRS conn fail ".itos(flag).snl)
        return 
      finish 
      pointers == record(re_conad+file header size)
      connect("SPOOLR.CFILE",r!s,0,0,re,flag)
      if  flag # 0 and  flag # 34 start 
        iprintstring("CFILE conn fail ".itos(flag).snl)
        return 
      finish 
      streams == array(re_conad+pointers_stream displ,sarf)
      already connected = yes
    finish 
    interpret command
    iprompt("<> ")
    
    return 

   finish 



routine  interpret command
!***********************************************************************
!*                                                                     *
!*                                                                     *
!***********************************************************************
constinteger  command limit = 67
switch  swt(1 : command limit)
integer  i, j, k, l, strm, rmt, flag, q no, id, op no
integer  seg, gap, new q no, new id, fsys, command length, link
integer  flags, next, after, source
byteintegerarray  net address(0 : 63)
record  (streamf)name  ftp line

record (fhf)name  file header
record (streamf)name  stream
record (queuef)name  queue
record (remotef)name  remote
record (document descriptorf)name  document
record  (pe)p
string  (15) q, name, ident,  recieving queue, user
string (15) original queue
string (10) specific user
string  (63) param1, param2
string (63) reply, param, ns1
string (63) array  words(1:15)
string (255) command
integerfnspec  find remote(string  (255) r)
integerfnspec  find queue(string  (255) q)
integerfnspec  find stream(string  (255) strm)

routinespec  display queues(integer  page,full)
routinespec  display remotes(integer  page,full)
routinespec  display streams(integer  page,full)
routinespec  display queue(integer  q no,page,full,string (10) specific user)
routinespec  display document(integer  line,ident)
routinespec  display stream(integer  strm)
routinespec  display remote(integer  r)
routinespec  update oper(integer  display type,which display,which page,string (10) specific user)
conststring  (15) array  comm(1 : command limit) =     c 
"FE", "LAST", "NEXT", "LOGON", "LOGOFF", "WINDUP",
"OPEN", "CLOSE", "TIE", "SWITCH", "POLL", "BROADCAST",
"EOF", "START", "STOP", "ATTACH", "DETACH", "ABORT",
"BATCHSTREAMS", "RUN", "SELECT", "TIDY", "PRINT", "MON",
"PROMPT", "CONFIG", "CHOP", "FEPUP", "FEPDOWN", "STREAM",
"S", "STREAMS", "SS", "QUEUE", "Q", "QUEUES",
"QS", "DISPLAY", "BATCH", "REMOTES", "RS", "REMOTE",
"R", "PRIORITY", "LIMIT", "FORMS", "RUSH", "HOLD",
"RELEASE", "DELETE", "MOVE", "COPY", "OFFER", "WITHDRAW",
"MSG", "ENABLE", "DISABLE", "CONNECTFE", "A:", "",
"","","","","","AUTODAP",
"BAR"

!The following array of words are param checking flags used as follows:
! x00nnnnnn  no checking to be done
! x01nnnnnn  do checks
! xnn00nnnn  Main oper command only
! xnn01nnnn  Main oper and RJE command
! xnn10nnnn  RJE command only
! xnn11nnnn  Informative command, not checked for RJE access permissions.
! xnnnnllnn  minimum number of params
! xnnnnnnll  maximum number of params (FF implies any number)


constintegerarray  comm flags(1 : command limit) = c 
x'01000000', x'01000000', x'01000000', x'01000103', x'01010001', x'01010001',
x'01000101', x'01000101', x'01000101', x'01000303', x'01000000', x'01000101',
x'01000101', x'01000101', x'01000001', x'01000303', x'01000303', x'01010101',
x'01000102', x'01000202', x'01000101', x'01000101', x'01000001', x'01000101',
x'01000101', x'01000002', x'01000101', x'01000101', x'01000101', x'01110101',
x'01110101', x'01110001', x'01110001', x'01110103', x'01110103', x'01110001',
x'01110001', x'01110101', x'01110000', x'01110001', x'01110001', x'01110101',
x'01110101', x'01010202', x'01010202', x'01010202', x'01010101', x'01010101',
x'01010101', x'01010102', x'01010304', x'01010303', x'01010101', x'01010101',
x'010101FF', x'01100101', x'01100000', x'01000101', x'011100FF', x'01000102',
x'01000001', x'01000001', x'01110002', x'01000102', x'01000102', x'01000102',
x'01010102'


   integerfn  find document( c 
      string  (15) srce, q, name, id,
      string  (6) user, integername  q no, ident)
!***********************************************************************
!*                                                                     *
!*  ATTEMPTS TO FIND THE SPECIFIED DOCUMENT. ANY OR MANY OF THE PARAMS *
!*  MAY NOT BE SPECIFIED.                                              *
!*                                                                     *
!***********************************************************************
   integer  next
      cycle  q no = 1, 1, qs
         if  q = "" or  q = queue names(q no)_name start 
                                        !THIS Q?
            next = queues(q no)_head;   !FIND FIRST DOCUMENT IN Q
            while  next # 0 cycle ;     !SCAN DOWN QUEUE
               ident = list cells(next)_document
                                        !PICK UP DOCUMENT IDENTIFIER
                     result  = 0 if  id = "" or  id =  c 
                        ident to s(ident)
!THIS IDENT?
               next = list cells(next)_link
            repeat 
         finish 
      repeat 
      result  = 1
   end ;                                !OF INTEGERFN FIND DOCUMENT

integerfn  check params (string (255) c  
param, stringname  q, name, user, ident)
!***********************************************************************
!*                                                                     *
!*                                                                     *
!***********************************************************************
integer  i, id, afsys
   q = "";  name = "";  user = "";  ident = ""
   if  param -> q.(" ").param start ;   !Q THE 
      if  1 <= length(q) <= 15 start ;  !RIGHT LT 
         if  param -> user.(" ").name start 
            result  = 0 if  length(user) = 6 c 
               and  1 <= length(name) <= 15
         finish 
      finish  else  result  = 1
   finish 
   if  length(param) = 6 start 
      afsys = 0
      cycle  i = 1, 1, 2
         result  = 1 unless  '0' <= charno(param, i) <= '9'
         afsys = afsys*10+charno(param, i)-'0'
      repeat 
      result  = 1 unless  0 <= afsys <= max fsys
      id = 0
      cycle  i = 3, 1, 6
         result  = 1 unless  '0' <= charno(param, i) <= '9'
         id = id*10+charno(param, i)-'0'
      repeat 
      result  = 1 unless  1 <= id <= max documents
      ident = param
      result  = 0
   finish 
   result  = 1
end ;                                   !OF ROUTINE CHECK PARAM

   integerfn  get document(string (31) param)
!***********************************************************************
!*                                                                     *
!*                                                                     *
!***********************************************************************
  record (fhf)name  file header
      result  = 1 if  check params(param, q, name, user, ident) # 0
      result  = 2 if  find document(connection_name, q, name, ident, user,q no, id) # 0
      i = (id&x'ff000000')>>24
      connect("SPOOLR.SPOOLLIST".itos(i),r!s,0,x'00000080'!(i<<8),re,flag)
      if  flag # 0 and  flag # 34 start 
        iprintstring("SPOOLLIST".itos(i)." conn fails ".itos(flag).snl)
        result  = 3
      finish 
      file header == record(re_conad)
      i = re_conad+file header_start+(id&x'ffffff'-1)* c 
         document entry size
      document == record(i)
      result  = 0
   end ;                                !OF INTEGERFN GET DOCUMENT


   integerfn  map document(integer  param)
!***********************************************************************
!*                                                                     *
!*                                                                     *
!***********************************************************************
  record (fhf)name  file header
      i = (param&x'ff000000')>>24
      connect("SPOOLR.SPOOLLIST".itos(i),r!s,0,x'00000080'!(i<<8),re,flag)
      if  flag # 0 and  flag # 34 start 
        iprintstring("SPOOLLIST".itos(i)." conn fails ".itos(flag).snl)
        result  = 3
      finish 
      file header == record(re_conad)
      i = re_conad+file header_start+(param&x'ffffff'-1)* c 
         document entry size
      document == record(i)
      result  = 0
   end ;                                !OF INTEGERFN map DOCUMENT


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!GENERAL ROUTINES FOR THE COMMAND SET INTERPRETATION.

integerfn  permission(integer  type)
  !THIS CHECKS PERMISSION OF THE FOLLOWING TYPES:
  !  1:  PERMISSION ON AN INDIVIDUAL DOCUMENT
  !  2:  PERMISSION ON A STREAM
  !  3:  PERMISSION ON A QUEUE
  integer  i, j
  !
{do the info/activity/managr checks here}
  result  = 0 if  connection_name = "MANAGER"
  if  type = 1 start 
    !DOCUMENT CHECK
    if  doc string(document,document_srce) # "" start 
      !IT WAS GENERATED BY A REMOTE.
      cycle  i = remotes(source)_lowest stream, 1, remotes(source)_highest stream
        if  stream details(i)_name = doc string(document,document_srce) then  result  = 0
      repeat 
    finish 
    !OK, SO CHECK WETHER DOCUMENT IS IN A QUEUE SERVED(OWNED) BY
    !THE CALLING REMOTE.
    cycle  i = remotes(source)_lowest stream, 1, remotes(source)_highest stream
      stream == streams(i)
      cycle  j = 0, 1, last q per stream
        exit  if  stream_queues(j) = 0
        if  queues(stream_queues(j))_name = document_dest then  c 
          result  = 0
      repeat 
    repeat 
    !WELL WE TRIED DIDN'T WE !!
    result  = 1
  finish 
  if  type = 2 start 
    !STREAM PERMISSION CHECK
    result  = 0 if  remotes(source)_lowest stream <= strm <= c 
      remotes(source)_highest stream
    result  = 1
  finish 
  if  type = 3 start 
    !A QUEUE PERMISSION CHECK.
    cycle  i = remotes(source)_lowest stream, 1, remotes(source)_highest stream
      stream == streams(i)
      cycle  j = 0, 1, last q per stream
        exit  if  stream_queues(j) = 0
        result  = 0 if  q no = stream_queues(j)
      repeat 
    repeat 
    result  = 1
  finish 
  !
  end 

integerfn  resolve command
  integer  elements; string (127) word
  !
  elements = 0
  command = call
  cycle 
    command -> (" ").command while  length(command)>0 and  charno(command,1)=' '
    exit  if  command = ""
    elements = elements + 1
    exit  if  elements = 16
    if  command -> word.(" ").command then  start 
      if  length(word)>63 then  length(word)=63
      words(elements) = word
      continue 
    finish 
    length(command) = 63 if  length(command) > 63
    words(elements) = command
    exit 
  repeat 
  result  = elements
  !
  end 

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!DO THE INITIAL CHECKS AGAINST THE ATRIBUTES WORD

  source = connection_source
  reply = ""
  command length = resolve command
  return  if  command length = 0
  link = 0
  cycle  i = 1, 1, command limit
    if  words(1) = comm(i) then  link = i and  exit 
  repeat 
  if  link = 0 start 
    if  call = "QUIT" start 
      connection_source = 0
      connection_name = ""
      return 
    finish 
    reply = "INVALID COMMAND ".words(1)
    -> error
  finish 
  flags = comm flags(link)
  -> skip if  flags >> 24 = 0
  !IE DO NOT DO INITIAL CHECKS.
  unless  (flags<<16)>>24 <= (command length - 1) <= flags&x'FF' start 
    reply = "NUMBER OF PARAMS ?"
    -> error
  finish 

skip:
!now connect the spoolr files we will require.
  connect("SPOOLR.CFILEPTRS",r!s,0,0,re,flag)
  if  flag  #0 and  flag # 34  then  reply = "CFILEPTRS conn fail ".itos(flag) and  -> error
  pointers == record(re_conad+file header size)
  connect("SPOOLR.CFILE",r!s,0,0,re,flag)
  if  flag # 0 and  flag # 34  then  reply = "CFILE conn fail ".itos(flag) and  -> error
  queue names == array(re_conad+pointers_queue name displ, qnaf)
  queues == array(re_conad+pointers_queue displ, qarf)
  stream details == array(re_conad+pointers_stream name displ,snaf)
  streams == array(re_conad+pointers_stream displ, sarf)
  remote names == array(re_conad+pointers_remote name displ, rnaf)
  remotes == array(re_conad+pointers_remote displ, rarf)
  qs = pointers_queues
  strms = pointers_streams
  rmts = pointers_remotes
  disconnect("SPOOLR.CFILEPTRS",flag)
  connect("SPOOLR.SPOOLLINK",r!s,0,0,re,flag)
  if  flag # 0  and  flag # 34 then  reply = "SPOOLLINK conn fail ".itos(flag) and  -> error
  list cells == array(re_conad,list cells af)
  if  connection_disabled = yes and  link # 56 c 
   then  iprintstring("Your terminal is locked out.".snl) and  return 
  -> swt(link)
!
!
swt(7):
swt(8):
swt(11):
swt(21):
swt(23):
swt(24):
swt(27):
swt(28):
swt(29):
swt(58):
swt(61):
swt(62):
swt(64):
swt(65):
swt(66):

-> call spooler
swt(*):
iprintstring("No".snl)
return 



!***************************************************

!DISPLAY A SPECIFIED (DEFAULT 0) PAGE OF THE QUEUES.

swt(36):
swt(37):

   if  command length = 2 start 
      j = stoi(words(2))
      param = "PAGE NO." and  -> parameter if  j < 0 or  j > 255
   finish  else  j = 0
   if  link = 36 then  i = all queues else  i = non empty queues
   connection_display type = i
   connection_which display = 0
   connection_which page = j
    connection_specific user=""
   -> up oper

!*****************************
!DISPLAY A SPECIFIED DOCUMENT.

swt(38):

   param = "DOCUMENT"
   if  length(words(2)) = 6 start 
      cycle  i = 1, 1, 6
         -> parameter unless  '0' <= charno(words(2), i) <= '9'
      repeat 
      i = (charno(words(2), 1)-'0')*10+charno(words(2), 2)-'0'
      j = (charno(words(2), 3)-'0')*1000+(charno(words(2), 4)-'0')*100 c 
         +(charno(words(2), 5)-'0')*10+charno(words(2), 6)-'0'
         -> parameter unless   1 <= j <= max documents
      connection_display type = individual document
      connection_which page = 0
      connection_which display = i<<24!j
       connection_specific user=""
      -> up oper
   finish  else  -> parameter

!**********************************************************
!RUSH:   PUT A JOB AT MAX PRIORITY WITHIN ITS OWN PRIORITY

swt(47):

   param = "DOCUMENT"
  flag = get document(words(2))
   reply = "DOCUMENT access fails ".i to s(flag) and  -> error if  flag # 0
    -> violation if  permission(1) # 0
   -> call spooler


!*************************************
!RELEASE A HELD DOCUMENT

swt(49):

   param = "DOCUMENT"
   flag = get document(words(2))
   reply = "DOCUMENT access fails ".i to s(flag) and  -> error if  flag # 0
   -> violation if  permission(1) # 0
   -> call spooler

!****************
!HOLD A DOCUMENT.

swt(48):

   param = "DOCUMENT"
   flag = get document(words(2))
   reply = "DOCUMENT access fails ".itos(flag) and  -> error if  flag # 0
   -> violation if  permission(1) # 0
   ->call spooler

!*************************************************
!DELETE A DOCUMENT OR THE DOCUMENTS INDICATED BY
!SUBSEQUENT PARAMETERS.

swt(50):

   specific user = ""; q no = 0
   if  words(2) -> words(2).(".ALL") start 
     if  command length = 3 then  start 
       !IE DELETE ALL A USER'S DOCS IN A PARTICULAR QUEUE.
       q no = find queue(words(3))
       param = "QUEUE" and  -> parameter if  q no = 0
       specific user = words(2)
       param = "USER" and  -> parameter if  length(specific user) # 6
     finish  else  start 
       q no = find queue(words(2))
       param = "QUEUE" and  -> parameter if  q no = 0
     finish 
   finish  else  start 
     !DELETE A SINGLE DOCUMENT.
     flag = get document(words(2))
     reply = "DOCUMENT access fails ".itos(flag) and  -> error if  flag # 0
     -> violation if  permission(1) # 0
     -> call spooler
   finish 
   !COMPLETE THE MULTIPLE DELETE.
   -> violation if  permission(3) # 0
   !IE NO ACCESS TO THAT QUEUE.
   -> call spooler

!*************************************************
!MOVE A DOCUMENT OR THE DOCUMENTS INDICATED BY
!SUBSEQUENT PARAMETERS.

swt(51):

   specific user = ""; q no = 0; recieving queue = ""
   original queue = ""; new q no = 0
   if  command length = 5 start 
     !A USER'S DOCS IN A QUEUE TO BE MOVED.
     param = "WORDING" and  -> parameter unless  words(4) = "TO" c 
       and  words(2) -> specific user.(".ALL")
     param = "USER" and  -> parameter unless  length(specific user) = 6
     q no = find queue(words(5))
     param = "RECIEVING QUEUE" and  -> parameter if  q no = 0
     -> violation unless  permission(3) = 0 or  queues(q no)_general access = open
     recieving queue = words(5)
     new q no = q no
     q no = find queue(words(3))
     original queue = words(3)
     param = "ORIGINAL QUEUE" and  -> parameter if  q no = 0
     -> violation if  permission(3) # 0
   finish  else  start 
     !USER NOT SPECIFIED, MUST BE EITHER SINGLE DOC OR A WHOLE QUEUE.
     q no = find queue(words(4))
     param = "RECIEVING QUEUE" and  -> parameter if  q no = 0
     -> violation unless  permission(3) = 0 or  queues(q no)_general access = open
     recieving queue = words(4)
     new q no = q no
     unless  words(2) -> words(2).(".ALL") start 
       !IT IS A SINGLE DOC MOVE.
       flag = get document(words(2))
       param = "DOCUMENT access fails ".itos(flag) and  -> parameter if  flag # 0
       original queue = document_dest
       -> violation if  permission(1) # 0
       -> call spooler
     finish 
     !FULL QUEUE MOVE.
     q no = find queue(words(2))
     original queue = words(2)
     param = "ORIGINAL QUEUE " and  -> parameter if  q no = 0
     -> violation if  permission(3) # 0
   finish 
   !DO THE MOVES.
   queue == queues(q no)
   reply = "NOT TO SAME QUEUE !" and  -> error if  recieving queue c 
    = original queue
   -> call spooler

!*************************************************
!CHANGE THE PRIORITY OF A STREAMS OR OF A DOCUMENT

swt(44):

   i = 0
   cycle  j = 1, 1, n priorities
      if  words(3) = priorities(j) start 
         i = j
         exit 
      finish 
   repeat 
   param = "PRIORITY" and  -> parameter if  i = 0
   strm = find stream(words(2))
   if  strm = 0 then  start 
     !MUST THEREFORE BE A DOCUMENT
     if  get document(words(2)) # 0 then  param = "STREAM/DOCUMENT" and  c 
       -> parameter
     -> violation if  permission(1) # 0
     -> call spooler
   finish 
   !A STREAM PRIORITY CHANGE.
   -> violation unless  permission(2) = 0
   -> call spooler

!***************************************************
!COPY A DOCUMENT TO ANOTHER QUEUE.

swt(52):

   q no = find queue(words(4))
   param = "QUEUE" and  -> parameter if  q no = 0
   -> violation unless  permission(3) = 0 or  queues(q no)_general access = open
   new q no = q no
   flag = get document(words(2))
   param = "DOCUMENT access fails ".itos(flag) and  -> parameter if  flag # 0
   -> violation unless  permission(1) = 0
   -> call spooler
!******************************************************
!WINDUP ACTIVITY ON STREAMS FOR SPECIFIED REMOTE. (ALL)

swt(6):

   if  command length > 1 and  words(2) = ".ALL" start 
     -> violation if  source # 0
     -> call spooler
   finish  else  start 
     if  command length = 1 then  words(2) = connection_name
     rmt = find remote(words(2))
     param = "REMOTE" and  -> parameter if  rmt = 0
     -> call spooler
   finish 
   return 


!******************************************************
!ABORT ONE OR ALL STREAMS.

swt(18):

   if  words(2) = ".ALL" start 
     -> violation unless  source = 0
     -> call spooler
   finish  else  start 
      strm = find stream(words(2))
     param = "STREAM" and  -> parameter if  strm = 0
     -> violation unless  permission(2) = 0
      reply = "NOT REQUIRED" and  -> error if  streams(strm)_status < allocated
       -> call spooler
   finish 
   return 

!*********************************************************
!START A STREAM (IE REMOVE STOP AND KICK) , OR ALL STREAMS.

swt(14):

   if  words(2) = ".ALL" start ;           !START ALL STREAMS
     -> call spooler
   finish  else  start 
      strm = find stream(words(2))
      param = "STREAM" and  -> parameter if  strm = 0
     -> call spooler
   finish 
   return 

!*********************************************************
!DISPLAY PAGE OF ALL STREAMS       OR     ACTIVE STREAMS

swt(32):
swt(33):

   if  command length > 1 start 
      j = s to i(words(2))
      param = "PAGE" and  -> parameter if  j < 0 or  j > 255
   finish  else  j = 0
   if  i = 32 then  i = all streams else  i = active streams
   connection_display type = i
   connection_which display = 0
   connection_which page = j
    connection_specific user=""
   -> up oper

!********************************************************
!DISPLAY DETAILED PAGE OF QUEUE  OR  SIMPLE PAGE OF QUEUE

swt(34):
swt(35):

   j=0; connection_specific user=""
  if  command length = 2 start 
    q no = find queue(words(2))
    param = "QUEUE" and  -> parameter if  q no = 0
  finish  else  start 
    if  words(2) -> words(2).(".ALL") start 
      param = "USER" and  -> parameter unless  length(words(2)) = 6 c 
       or  (words(2) -> reply.("DAP") and  (length(reply) = 0 or  length(reply) = 7))
      connection_specific user = words(2)
      q no = find queue(words(3))
      param = "QUEUE" and  -> parameter if  q no = 0
      if  command length = 4 start 
        j = s to i(words(4))
        param = "PAGE" and  -> parameter unless  0 <= j <= 255
      finish 
    finish  else  start 
      q no = find queue(words(2))
      j = s to i(words(3))
      if  q no = 0 start 
        if  0<=j<=255 start 
          param = "QUEUE"
          -> parameter
        finish  else  start 
          reply = "<USER>.ALL ?"
          -> error
        finish 
      finish 
      param = "PAGE" and  ->parameter unless  0 <= j <= 255
    finish 
  finish 
  if  link = 34 then  i = full individual queue c 
     else  i = individual queue
  connection_display type = i
  connection_which display = q no
  connection_which page = j
   connection_specific user = ""
  -> up oper

!***********************************************
!REPORT ON STREAM STATUS FULLY   OR   PARTIALLY

swt(30):
swt(31):

  strm = find stream(words(2))
  param = "STREAM" and  -> parameter if  strm = 0
  connection_display type = individual stream
  connection_which display = strm
  connection_which page = 0
  connection_specific user=""
  -> up oper

!*****************************************************
!SET A STREAM ATTRIBUTE.  FORMS OR LIMIT

swt(46):
swt(45):

   strm = find stream(words(2))
   param = "STREAM" and  -> parameter if  strm = 0
   -> violation unless  permission(2) = 0
   i = s to i(words(3))
   if  link = 45 then  j = 10000 else  j = 255
   param = "VALUE" and  -> parameter unless  0<=i<=j
   -> call spooler

!********************************************************************
!Bar (or release) a stream from outputing(and only output streams)
!for a particular user.

swt(67):

  strm = find stream(words(2))
  param = "STREAM" and  -> parameter if  strm = 0
  -> violation unless  permission(2) = 0
   -> call spooler

!**************************************************
!ATTACH A STREAM TO A PARTICULAR QUEUE

swt(16):

   reply = "<STRM> TO <Q> ?" and  ->error unless  words(3) = "TO"
   strm = find stream(words(2))
   param = "STREAM" and  ->parameter if  strm = 0
   q no = find queue(words(4))
   param = "QUEUE" and  -> parameter if  q no = 0
   stream == streams(strm)
   queue == queues(q no)
   if  stream_service # input start ; !NOT INPUT STREAMS
      cycle  i = 0, 1, last q per stream
         unless  stream_queues(i) = q no start 
            if  stream_queues(i) = 0 start 
               cycle  j = 0, 1, last stream per q
                  unless  queue_streams(j) = strm start 
                     if  queue_streams(j) = 0 start 
                         -> call spooler
                     finish 
                  finish  else  start 
                     reply = words(2)." ALREADY ATTACHED"
                     -> error
                  finish 
               repeat 
               reply = words(4)."HAS TOO MANY STREAMS"
               -> error
            finish 
         finish  else  start 
            reply = words(2)." ALREADY ATTACHED"
            -> error
         finish 
      repeat 
      reply = words(2)." ATTACHED TO TOO MANY QUEUES"
      -> error
   finish  else  start ;                !INPUT STREAMS
      if  stream_queues(0) # 0 start 
         reply = words(2)." ALREADY ATTACHED TO ".queue names(stream_ c 
            queues(0))_name
         -> error
      finish 
     -> call spooler
   finish 

!************************************************
!DETACH A STREAM FROM A QUEUE.

swt(17):

   reply = "<STRM> FROM <Q> ?" and  -> error unless  words(3) = "FROM"
   strm = find stream(words(2))
   param = "STREAM" and  -> parameter if  strm = 0
   q no = find queue(words(4))
   param = "QUEUE" and  -> parameter if  q no = 0
   stream == streams(strm)
   queue == queues(q no)
   if  q no=stream_queues(stream_q no) and  c 
    stream_document#0 then  start 
     !THE STREAM IS CURRENTLY SERVING THE QUEUE IN QUESTION.
     reply="DETACH FAILS, ".words(2)." SERVING ".words(4)
     ->error
   finish 
   if  stream_service # input start ; !NOT INPUT STREAMS
      cycle  i = 0, 1, last q per stream
         exit  if  stream_queues(i) = 0
         if  stream_queues(i) = q no start 
            cycle  j = 0, 1, last stream per q
               exit  if  queue_streams(j) = 0
               if  queue_streams(j) = strm then  -> call spooler
            repeat 
            reply = words(2)." ATTACHED TO ".words(4)." WRONGLY"
            -> error
         finish 
      repeat 
      reply = words(2)." NOT ATTACHED TO ".words(4)
      -> error
   finish  else  start 
      if  stream_queues(0) # q no start 
         reply = words(2)." NOT ATTACHED TO ".words(4)
         -> error
      finish  else  -> call spooler
      return 
   finish 

!********************************************************
!DISPLAY A PAGE OF INFORMATION ABOUT REMOTES.

swt(40):
swt(41):

   if  command length = 2 start 
      j = stoi(words(2))
      param = "PAGE" and  -> parameter if  j < 0 or  j > 255
   finish  else  j = 0
   if  link = 40 then  i = all remotes else  i = logged on remotes
   connection_display type = i
   connection_which display = 0
   connection_which page = j
   connection_specific user=""
   -> up oper

!*********************************************
!DISPLAY REMOTE STATUS INFORMATION.

swt(42):
swt(43):

   rmt = find remote(words(2))
   param = "REMOTE" and  -> parameter if  rmt = 0
   connection_display type = individual remote
   connection_which display = rmt
   connection_which page = 0
    connection_specific user=""
   -> up oper

!******************************************
!LOGOFF REMOTE(S) AS SPECIFIED

swt(5):

   words(2) = connection_name and  call = call." ".connection_name if  command length = 1
   if  words(2) = ".ALL" or  find remote(words(2)) # 0 c 
      then  -> call spooler else  param = "REMOTE" and  c 
       -> parameter
   return 

!*******************************************
!DISPLAY LAST PAGE OF CURRENT DISPLAY

swt(2):

   reply = "FIRST PAGE!" and  -> error if  connection_which page = 0
   connection_which page = connection_which page - 1
   -> up oper

!************************************************
!DISPLAY THE NEXT PAGE OF THE CURRENT DISPLAY.

swt(3):

   reply = "LAST PAGE!" and  -> error if  connection_which page = 255
   connection_which page = connection_which page+1
   -> up oper

!************************************************************
!SET THE NUMBER OF BATCH STREAMS (AND LIMIT IF REQUIRED)

swt(19):

   i = s to i(words(2))
   reply = "0-16 STREAMS ONLY !" and  -> error unless  0 <= i <= 16
   -> call spooler

!***********************************************
!FORCE A SPECIFIC BATCH JOB TO START.

swt(20):

   strm = find stream(words(2))
   param = "STREAM" and  -> parameter if  strm = 0
   printstring("Stream already ACTIVE!".snl) and  return  c 
    if  streams(strm)_status > allocated
   flag = get document(words(3))
   param = "DOCUMENT access fails ".itos(flag) and  -> parameter if  flag # 0
    reply = "Not a batch job" and  -> error if  streams(strm)_service # job
   if  document_dap c exec time # 0 then  c 
    reply = "Use SELECT on DAP jobs" and  -> error
   -> call spooler

!*************************************************
!OFFER OR WITHDRAW A GENERAL QUEUE PARAMETER

swt(53):
swt(54):

   q no = find queue(words(2))
   param = "QUEUE" and  -> parameter if  q no = 0
   -> violation unless  permission(3) = 0
   -> call spooler

!**********************************************
!ENABLE OR DISABLE A REMOTE'S COMMAND INPUT

swt(56):
swt(57):

   if  connection_name = "MANAGER" then  name = "LOCAL" else  c 
    name = connection_name
   rmt = find remote(name)
   if  link = 56 start 
     !ENABLE(REQUIRES A PASSWORD)
     unless  words(2) -> ("X25").words(2) or  words(2) -> ("TS").words(2) then  param = "PASS" and  -> parameter
     call = "OPER(".connection_name.")CHECKPASS:".itos(connection_source)."/". c 
      itos(entry)."/".words(2)
     flag = dexecmess("SPOOLR",1,length(call),addr(call)+1)
     if  flag # 0 then  iprintstring("SPOOLER unavailable".snl) and  ilogoff(console)
     return 
   finish 
   if  link = 57 then  connection_disabled = yes
  return 

!******************************************************
!LOGON THE SPECIFIED REMOTE THRU THE SPECIFIED FEP AT
!THE SPECIFIED ADDRESS

swt(4):

    if  connection_name = "MANAGER" then  reply = "NO" and  -> error
    if  words(2) -> param1.(".").param2 start 
      if  length(param1) = 8 then  words(2) = "0000".words(2)
    finish  else  if  length(words(2)) = 8 then  words(2) = "0000".words(2)

    reply = "ALREADY LOGGED ON" and  -> error if  remotes(connection_source)_status > open
    !in the next section the FEP no 0 could,from config stage, be
     !either because it was set to 0 really or NA. Therefore we
     !ignore FE0 as a logon primitive and use FE? (ie choose)
     !when we call spoolr.  If 0 was wanted and is X25 it will be
     !chosen anyway by spooler.
     !NOTE that if the FE is specified by the ops. then this is used.

     call = "LOGON ".connection_name." FE"
     if  command length >= 3 start 
        unless  words(3) -> ("FE").words(3) then  reply = "LOGON <addr> FEn  ?" and  -> error
       i = stoi(words(3))
       unless  0 <= i <= max fep then  reply = "Invalid FEP no." and  -> error
       call = call.words(3)." ".words(2)
       if  command length = 4 then  call = call." TIED"
     finish  else  start 
      if  remotes(connection_source)_prelog fep # 0 then  call = c 
       call.itos(remotes(connection_source)_prelog fep)." ".words(2) c 
       else  call = call."? ".words(2)
     finish 
printstring(call.snl)
     -> call spooler

!****************************************
!TIE DOWN A REMOTE TO ITS CURRENT FEP

swt(9):

   rmt = find remote(words(2))
   param = "REMOTE" and  -> parameter if  rmt = 0 or  c 
    remotes(rmt)_name = "LOCAL"
   if  remotes(rmt)_status = logged on or  remotes(rmt)_status c 
     = switching then  start 
     !OK TO TIE DOWN
     -> call spooler
   finish  else  printstring(remotes(rmt)_name." NOT LOGGED ON.".snl)
   return 

!*************************************************
!SWITCH A REMOTE FROM ONE FEP TO ANOTHER.

swt(10):

   if  words(3) = "TO" start 
     reply = "<RMT> TO FEn" and  -> error unless   c 
      words(4)-> ns1.("FE").words(4) and  ns1="" and  length(words(4)) = 1
     rmt=find remote(words(2))
     param = "REMOTE" and  -> parameter if  rmt = 0
     i = charno(words(4), 1) - '0'
     param = "FEP" and  -> parameter unless  0<= i <= max fep
      if  no route < remotes(rmt)_fep route value(i) < requested c 
      and  remotes(rmt)_status = logged on and  remotes(rmt)_ c 
      prelog < prelogon tied start 
       !OK TO GO AHEAD WITH THE SWITCH.
     -> call spooler
     finish  else  printstring("SWITCH NOT POSSIBLE!!".snl)
     return 
   finish 
   if  words(3) = "FROM" and  words(2)= ".ALL" and  c 
    length(words(4))=3 and  substring(words(4),1,2)="FE" start 
     words(4)->("FE").words(4)
     i = charno(words(4), 1) - '0'
     param = "FEP" and  -> parameter unless  0 <= i <= max fep
     -> call spooler
   finish 
   printstring("<RMT> TO FEn".snl.".ALL FROM FEn".snl)
   return 


up oper:

   update oper(connection_display type,connection_which display, c 
     connection_which page, connection_specific user)
   return 
violation:
   param = "ACCESS"
parameter:

   reply = "INVALID ".param
error:

   iprintstring(reply.snl)
   return 

call spooler:
  call = "OPER(".connection_name.")".call
  flag = dexecmess("SPOOLR",1,length(call),addr(call)+1)
  if  flag # 0 then  iprintstring("SPOOLR call fails ".itos(flag).snl) c 
   else  iprintstring("SPOOLR called".snl)

  return 
!*


!*

   integerfn  find queue(string  (255) q)
!***********************************************************************
!*                                                                     *
!*  RETURNS THE INDEX INTO THE QUEUE ARRAY OF THE SPECIFIED QUEUE      *
!*  RETURNS ZERO IF THE QUEUE IS NOT FOUND                             *
!*                                                                     *
!***********************************************************************
   integer  i
      cycle  i = 1, 1, qs
         result  = i if  queue names(i)_name = q
      repeat 
      reply = "NO SUCH QUEUE ".q
      result  = 0
   end ;                                !OF INTEGERFN FIND QUEUE
!*
!*

   integerfn  find remote(string  (255) r)
!***********************************************************************
!*                                                                     *
!*  RETURNS THE INDEX INTO THE REMOTE ARRAY OF THE SPECIFIED REMOTE    *
!*  RETURNS ZERO IF THE REMOTE IS NOT FOUND                            *
!*                                                                     *
!***********************************************************************
   integer  i
      cycle  i = 1, 1, rmts
         result  = i if  remote names(i)_name = r
      repeat 
      reply = "NO SUCH REMOTE ".r
      result  = 0
   end ;                                !OF INTEGERFN FIND REMOTE
!*
!*

   integerfn  find stream(string  (255) strm)
!***********************************************************************
!*                                                                     *
!*  RETURNS THE INDEX INTO THE STREAM ARRAY OF THE SPECIFIED STREAM    *
!*  RETURNS ZERO IF THE STREAM IN NOT FOUND                            *
!*                                                                     *
!***********************************************************************
   string  (255) rmt
   integer  i
      rmt = "" unless  strm -> rmt.(".").strm
      cycle  i = 1, 1, strms
         result  = i if  stream details(i)_name = strm and  (rmt = "" c 
            or  rmt = remote names(streams(i)_remote)_name)
      repeat 
      strm = rmt.".".strm if  rmt # ""
      reply = "NO SUCH STREAM ".strm
      result  = 0
   end ;                                !OF INTEGERFN FIND STREAM
!*
!*
!*
!*

routine  display queues(integer   page, full)
!***********************************************************************
!*                                                                     *
!*  DISPLAY A SUMMARY OF ALL THE QUEUES STARTING AT THE GIVEN PAGE     *
!*                                                                     *
!***********************************************************************
record (queuef)name  queue
integer  q no, line, count, limit
string  (255) s, t
   s = "Page ".i to s(page)
   s = s." " while  length(s) < 12
   if  full = yes then  s = s."All Queues" else  s = s."Queues"
   iprintstring( s.snl);  !TITLE
   line = 1
   count = 0
   limit = (oper display size-line)*page
   cycle  q no = 1, 1, qs
      queue == queues(q no)
      if  full = yes or  queue_length # 0 start 
         if  count = limit start 
            s = queue_name
            s = s." " while  length(s) < 16
            if  queue_length # 0 start 
               t = i to ss(queue_length, 4)
               if  queue_length # queue_max length start 
                  if  queue_length = 1 then  t = t." Entry  " c 
                     else  t = t." Entries"
               finish  else  t = t." Full   "
               s = s.t
               if  queue_default time <= 0 c 
                  then  t = i to s((queue_amount+1023)>>10). c 
                  "K" else  t = hms(queue_amount)
               t = " ".t while  length(t) < 12
               s = s.t
            finish  else  s = s."     Empty"
            iprintstring( s.snl)
            line = line+1
            exit  if  line = oper display size
         finish  else  count = count+1
      finish 
   repeat 
end ;                                   !OF ROUTINE DISPLAY QUEUES
!*
!*

routine  display remotes(integer   page, full)
!***********************************************************************
!*                                                                     *
!*  DISPLAY A SUMMARY OF ALL THE REMOTES STARTING AT THE GIVEN PAGE    *
!*                                                                     *
!***********************************************************************
record (remotef)name  remote
integer  r, line, count, limit
string  (255) s
   s = "Page ".i to s(page)
   s = s." " while  length(s) < 12
   if  full = yes then  s = s."All Remotes" else  s = s."Remotes"
   iprintstring( s.snl);     !TITLE
   line = 1
   if  full = yes then  count = 2 else  count = 1
   limit = ((oper display size-line)//count)*page
   count = 0
   cycle  r = 1, 1, rmts
      remote == remotes(r)
      if  full = yes or  logging on <= remote_status <= logging off start 
         if  count = limit start 
            s = remote_name
            s = s." " while  length(s) < 16
            s = s.remote status type(remote_status)
            s = s." FE".i to s(remote_fep) c 
               if  remote_network address len > 0
            iprintstring( s.snl)
            line = line+1
           if  full = yes then  iprintstring( "  ".remote_description.snl) c 
            and  line = line + 1
            exit  if  line > oper display size-1
         finish  else  count = count+1
      finish 
   repeat 
end ;                                   !OF ROUTINE DISPLAY REMOTES
!*
!*

routine  display streams(integer   page, full)
!***********************************************************************
!*                                                                     *
!*  DISPLAY A SUMMARY OF ALL THE STREAMS STARTING AT THE GIVEN PAGE    *
!*                                                                     *
!***********************************************************************
record (streamf)name  stream
integer  strm, line, count, limit
string  (255) s
   s = "Page ".i to s(page)
   s = s." " while  length(s) < 12
   if  full = yes then  s = s."All Streams" else  s = s."Streams"
   iprintstring( s.snl);  !TITLE
   line = 1
   count = 0
   limit = (oper display size-line)*page
   cycle  strm = 1, 1, strms
      stream == streams(strm)
      if  (connection_name = "MANAGER" or  connection_name = remotes(stream_remote) c 
         _name) and  (full = yes c 
         or  stream_status > allocated) start 
         if  count = limit start 
            s = stream_name
            s = s." " while  length(s) < 16
            s = s.stream status type(stream_status)
            if  stream_document # 0 start 
              flag = map document(stream_document)
              if  flag # 0 then  iprintstring("DOCUMENT access fails ". c 
                itos(flag).snl) and  return 
               s = s." For ".document_user
               s = s." ".ident to s(stream_document) c 
                  if  stream_status = active
            finish 
            iprintstring( s.snl)
            line = line+1
            exit  if  line = oper display size
         finish  else  count = count+1
      finish 
   repeat 
end ;                                   !OF ROUTINE DISPLAY STREAMS
!*
!*

routine  display queue(integer   q no, page, full, string (10) specific user)
!***********************************************************************
!*                                                                     *
!*  MAKE UP TO DATE THE DISPLAY WHICH HOLDS THE SPECIFIED QUEUE.       *
!*                                                                     *
!***********************************************************************
record (queuef)name  queue
integer  line, next, i, j, limit, user limit,dap special
string  (3) p
string  (255) s, t
   dap special = no
   if  specific user # "" start 
     if  specific user -> specific user.(".DAP") or  specific user -> c 
      specific user.("DAP") then  dap special = yes
   finish 
   s = "Page ".i to s(page)
   s = s." " while  length(s) < 10
   queue == queues(q no);               !MAP THE APPROPRIATE QUEUE
   s = s."Queue ".queue_name
   s = s." Full" if  queue_length = queue_max length
   s = s." Empty" if  queue_length = 0
   iprintstring( s.snl);  !TITLE
   if  queue_length = 0 then  t = " No" c 
      else  t = i to ss(queue_length, 3)
   s = t." Entries"
   t = i to ss(queue_max length, 4)
   s = s.t." Max"
   t = i to ss(queue_maxacr, 3)
   s = s.t." MaxACR"
   if  queue_length > 0 and  dap special = no start 
      if  queue_default time > 0 c 
         then  t = hms(queue_amount) c 
         else  t = i to s((queue_amount+1023)>>10)."K"
      t = " ".t while  length(t) < 11
      s = s.t
   finish 
   if  dap special = yes then  s = s." DAP"
   iprintstring( s.snl)
   if  full = yes start 
      line = 2
      iprintstring( "Defaults:".snl)
      line = line + 1
      iprintstring("USER:     ".queue_default user.snl) if  queue_default user # ""
      line = line + 1
         iprintstring("DELIVERY: ".queue_default delivery) c 
         if  queue_default delivery # ""
      line = line+1
      s = "PRIORITY: ".priorities(queue_default priority)
      s = s." " while  length(s) < 20
      if  queue_default time > 0 c 
         then  s = s."TIME:     ".i to s(queue_default time). c 
         "S" else  start 
         s = s."START:    ".i to s(queue_default start) c 
            if  queue_default start # 0
      finish 
      iprintstring( s.snl)
      line = line+1
      s = "FORMS:    ".i to s(queue_default forms)
      s = s." " while  length(s) < 20
      iprintstring( s."MODE:     ".modes( c 
         queue_default mode).snl)
      line = line+1
      s = "COPIES:   ".i to s(queue_default copies)
      s = s." " while  length(s) < 20
      if  queue_default rerun = no c 
         then  s = s."RERUN:    No" else  s = s."RERUN:    Yes"
      iprintstring( s.snl)
      line = line+1 and  iprintstring("LINES:    ".i to s(queue_default output limit).snl) c 
         if  queue_default output limit > 0
      line = line+1
      iprintstring( "Streams:".snl)
      s = ""
      cycle  i = 0, 1, last stream per q
         if  queue_streams(i) = 0 start 
            line = line+1 and  iprintstring( s.snl) if  s # ""
            exit 
         finish 
         if  i&1 = 0 start 
            line = line+1 and  iprintstring( s.snl) if  s # ""
            s = ""
         finish  else  start 
            s = s." " while  length(s) < 20
         finish 
         if  streams(queue_streams(i))_batch enable = open then  s = s."* " c 
          else  s = s."  "
         s = s.stream details(queue_streams(i))_name." ". c 
            stream status type(streams(queue_streams(i))_ c 
            status)
         line = line+1 and  iprintstring( s.snl) if  i = last stream per q
     repeat 
    finish  else  line = 1
    if  queue_head # 0 start 
      s = "POS  IDENT  USER  NAME         PRTY  "
      IF  QUEUE_DEFAULT TIME <= 0 then  s = s."SIZE" c 
        else  s = s."TIME"
      line = line + 1
      i = 1
      iprintstring(s.snl)
      next = queue_head
      line = line+1
      limit = (oper display size-line)*page
      if  specific user # "" then  start 
        user limit = limit
        limit = 0
      finish  else  user limit = 0
      while  next # 0 and  line < oper display size cycle 
         if  i > limit start 
           if  (dap special = no and  (specific user="" or  c 
            list cells(next)_user=specific user)) or  (dap special = yes and  c 
            list cells(next)_gen flags&dap batch flag # 0 and  ( c 
            specific user = "" or  list cells(next)_user = specific user)) start 
            flag = map document(list cells(next)_document)
                   if  flag # 0 then  iprintstring("DOCUMENT access fails ".itos(flag).snl) and  return 
            unless  full = no and  ((document_start after date and time #0 c 
            and  document_start after date and time > c 
            pack date and time(date, time)) or  (document_dap c exec time # 0 c 
            and  dap special = no)) then  start 
             if  user limit = 0 then  start 
               s = i to ss(i, 3);           !CALCULATE QUEUE POSITION
               s = s." ".ident to s(list cells(next)_document)
               s = s." ".document_user." ".doc string(document,document_name)
               length(s) = 29 if  length(s) > 29
               s = s." " while  length(s) < 30
               if  document_priority < 0 then  s = s."HLD" c 
                  else  start 
                  p = ""
                  cycle  j = n priorities, -1, 1
                     if  document_priority >= prtys(j) start 
                        p <- priorities(j)
                        exit 
                     finish 
                  repeat 
                  s = s.p
               finish 
               if  document_forms # queue_default forms c 
                  then  s = s."F" else  start 
                  if  document_start after date and time # 0 c 
                     and  document_start after date and time >  c 
                     pack date and time(date, time) c 
                     then  s = s."A" else  start 
                     if  document_order # 0 then  s = s."O" c 
                        else  s = s." "
                  finish 
               finish 
               if  document_priority<0 and  document_properties&(media hold!dap hold) #0 start 
                 t=""
                 if  document_drives#0 then  c 
                 t=i to s(document_drives)." EDU"
                 if  document_decks#0 then  start 
                   if  t="" then  t=i to s(document_decks). c 
                    " MTU" else  t="DSPLY"
                  finish 
                  if  document_dap c exec time#0 start 
                    if  dap special = yes c 
                    then  t = itos(document_dap mins)."m" else  c 
                     if  t = "" then  t = "  DAP" else  t = "DSPLY"
                  finish 
               finish  else  start 
                 if  document_time > 0 then  t = i to s(document_ c 
                    time)."S" else  t = i to s((document_ c 
                    data length+1023)>>10)."K"
               finish 
               t = " ".t while  length(t) < 6
               s = s.t
               iprintstring( s.snl)
               line = line+1
              finish  else  user limit = user limit -1
            finish 
           finish 
         finish 
         i = i+1
         next = list cells(next)_link
      repeat 
   finish 
end ;                                   !OF ROUTINE DISPLAY QUEUE
!*
!*

routine  display document(integer   line, ident)
!***********************************************************************
!*                                                                     *
!*  DISPLAY STARTING AT THE GIVEN LINE THE SPECIFIED DOCUMENT          *
!*                                                                     *
!***********************************************************************
integer  i
string  (255) s
   iprintstring( "IDENT:    ".ident to s( c 
      ident).snl)
   flag = map document(ident)
   if  flag # 0 then  iprintstring("DOCUMENT access fails ".itos(flag).snl) and  return 
   line = line+1
   iprintstring( "STATE:    ".doc state( c 
      document_state).snl)
   line = line + 1
   s="ORIGIN:   "
   if  doc string(document,document_srce) = "" then  s=s."USER" else  s=s.doc string(document,document_srce)
   iprintstring( s.snl)
   line = line + 1
   iprintstring( "USER:     ".document_ c 
      user.snl)
   line = line+1
   iprintstring( "NAME:     ". c 
     doc string(document,document_name).snl)
   line = line+1
   iprintstring( "QUEUE:    ".document_ c 
      dest.snl)
   line = line+1
   if  document_outdev > 0 start 
     s="OUT:      "
     if  document_outdev = queue dest then  s=s.doc string(document,document_output) c 
     else  s=s."FILE ".doc string(document,document_output)
     iprintstring( s.snl)
     line = line + 1
   finish 
   iprintstring( "DELIVERY: ". c 
     doc string(document,document_delivery).snl)
   line = line+1
   iprintstring( "RECEIVED: ".unpack date c 
      (document_date and time received)." ".unpack time( c 
      document_date and time received).snl)
   line = line+1 and  iprintstring("AFTER:    ".unpack date(document_ c 
      start after date and time)." ".unpack time(document_ c 
      start after date and time).snl) c 
      if  document_start after date and time # 0
   line = line+1 and  iprintstring("STARTED:  ".unpack date(document_date and time started). c 
      " ".unpack time(document_date and time started).snl) c 
      if  document_date and time started # 0
   line = line+1 and  iprintstring("DELETED:  ".unpack date(document_date and time deleted). c 
      " ".unpack time(document_date and time deleted).snl) c 
      if  document_date and time deleted # 0
   line = line+1
   if  document_time <= 0 and  document_dap c exec time = 0 start 
      s = "SIZE:     ".i to s(document_data length)
      s = s." " while  length(s) < 20
      s = s."START:    ".i to s(document_data start) c 
         if  document_data start # 0
      iprintstring( s.snl)
   finish  else  start 
     if  document_dap c exec time # 0 then  iprintstring( "DAP time : ".itos(document_dap mins)." mins".snl) c 
      else  iprintstring("TIME:     ".itos(document_time)."S".snl)
   finish 
   line = line + 1
   if  document_priority < 0 then  s = "PRIORITY: Held" c 
      else  start 
      cycle  i = n priorities, -1, 1
         if  document_priority >= prtys(i) start 
            s = "PRIORITY: ".priorities(i)
            exit 
         finish 
      repeat 
   finish 
   if  document_forms # 0 start 
      s = s." " while  length(s) < 20
      s = s."FORMS:    ".i to s(document_forms)
   finish 
   iprintstring( s.snl)
   if  document_ftp alias # 0 start 
     !it is an FTP transfer document
     line = line + 1
     s = "NIFTP-80(B) transfer for ".docstring(document,document_ftp alias)
     iprintstring(s.snl)
   finish 
   line = line+1
   s = "MODE:     ".modes(document_mode)
   if  document_copies > 1 start 
      s = s." " while  length(s) < 20
      s = s."COPIES:   ".i to s(document_copies)
   finish 
   iprintstring( s.snl)
   line = line+1
   if  document_rerun = no then  s = "RERUN:    No" c 
      else  s = "RERUN:    Yes"
   if  document_fails # 0 start 
      s = s." " while  length(s) < 14
      s = s."FAIL ".i to s(document_fails)
   finish 
   if  document_order # 0 start 
      s = s." " while  length(s) < 20
      s = s."ORDER:    ".i to s(document_order)
   finish 
   iprintstring( s.snl)
   line = line+1
   if  document_decks = 0 then  s = "" else  start 
      s = "DECKS:    ".i to s(document_decks)
      s = s." " while  length(s) < 20
   finish 
   s = s."DRIVES:    ".i to s(document_drives) c 
      if  document_drives # 0
   s = s."DAP control exec: ".itos(document_dap c exec time)."s" if  c 
     document_dap c exec time # 0
   if  s # "" then  iprintstring( s.snl) else  return 
   line = line + 1
    if  document_decks > 0 then  start 
      s = "TSNS: "
      cycle  i=1, 1, (8 - document_drives )
        if  i=4 or  i=7 start 
          iprintstring( s.snl)
          line = line + 1
          s="      "
        finish 
        exit  if  document_vol label(i)=0
        s=s.doc string(document,document_vol label(i))." "
      repeat 
      iprintstring( s.snl) and  line=line+1 c 
        if  length(s) > 6
      finish 
      if  document_drives > 0 start 
        s="DSNS: "
        cycle  i=1, 1, document_drives
          if  i=4 or  i=7 start 
            iprintstring( s.snl)
            line = line + 1
            s="      "
          finish 
          s=s.doc string(document,document_vol label(9-i))." "
        repeat 
        iprintstring( s.snl) and  line=line+1 c 
         if  length(s) >6
      finish 
end ;                                   !OF ROUTINE DISPLAY DOCUMENT
!*
!*

routine  display stream(integer   strm)
!***********************************************************************
!*                                                                     *
!*  MAKE UP TO DATE THE DISPLAY WHICH HOLDS THE SPECIFIED STREAM.      *
!*                                                                     *
!***********************************************************************
record (streamf)name  stream
string  (255) s
integer  line, i
   stream == streams(strm)
   s = "      ".stream type(stream_service)." Stream ". c 
      stream_name
   iprintstring( s.snl)
   line = 1
   iprintstring( "Queues:".snl)
   s = ""
   cycle  i = 0, 1, last q per stream
      if  stream_queues(i) = 0 start 
         line = line+1 and  iprintstring(s.snl) if  s # ""
         exit 
      finish 
      if  i&1 = 0 start 
         line = line+1 and  iprintstring(s.snl) if  s # ""
         s = ""
      finish  else  start 
         s = s." " while  length(s) < 20
      finish 
      s = s.queue names(stream_queues(i))_name
      s = s." *" if  stream_q no = i c 
         and  stream_service # input
      line = line+1 and  iprintstring( s.snl) c 
         if  i = last q per stream
   repeat 
   line = line+1
   -> end if  line >= 10
   s = "STATUS: ".stream status type(stream_status)
   if  stream_barred user # "" then  s = s."   [ ".stream_barred user." barred]"
   iprintstring( s.snl)
   line = line+1
   -> end if  line >= 10
   s = "REMOTE: ".remotes(stream_remote)_name." ". c 
      remote status type(remotes(stream_remote)_status)
   iprintstring( s.snl)
   if  stream_device type # 0 start 
      line = line+1
      -> end if  line >= 10
      s = "TYPE:   ".device type(stream_device type).i to s( c 
         stream_device no)
      if  stream_ident&x'FFFF' # 0 start 
         s = s." " while  length(s) < 20
         s = s."ADAPTR: ".device type(stream_ident>>24).i to s(( c 
            stream_ident>>16)&255)." ".i to s(stream_ident& c 
            x'FFFF')
      finish 
      iprintstring( s.snl)
   finish 
   line = line+1
   -> end if  line >= 10
   s = "LIMIT :  ".i to s(stream_limit)
   s = s." " while  length(s) < 20
   s = s."FORMS:  ".i to s(stream_forms)
   iprintstring( s.snl)
   line = line+1
   -> end if  line >= 10
   if  stream_service # input c 
      then  s = "PRTY:   ".priorities(stream_lowest priority) c 
      else  s = ""
   if  stream_comms stream # 0 start 
      s = s." " while  length(s) < 20
      s = s."COMMST: ".i to s(stream_comms stream)
   finish 
   iprintstring( s.snl)
   line = line+1
   -> end if  line >= 10
   if  stream_block # 0 start 
      s = "TO GO:  ".i to s(stream_bytes to go)." BYTES" c 
         if  stream_service = output
      s = "RCVD:   ".i to s(stream_bytes to go)." BYTES" c 
         if  stream_service = input
      s = s." " while  length(s) < 20
   finish  else  s = ""
   s = s."HEADER: ".header type(stream_header type) c 
      if  stream_header type # 0
   if  s # "" then  start 
      iprintstring( s.snl)
      line = line + 1
      -> end if  line >= 10
   finish 
   s = "UNITSIZE: ".itos(stream_unitsize)
   if  stream_unit name # "" then  start 
      s = s." " while  length(s) < 20
      s = s."UNIT NAME: ".stream_unit name
   finish 
   iprintstring( s.snl)
end:

   display document(10, stream_document) c 
      if  stream_document # 0 
end ;                                   !OF ROUTINE DISPLAY STREAM
!*
!*

routine  display remote(integer  r)
!***********************************************************************
!*                                                                     *
!*  MAKE UP TO DATE THE DISPLAY WHICH HOLDS THE SPECIFIED REMOTE.      *
!*                                                                     *
!***********************************************************************
record (remotef)name  remote
integer  i, line
string  (255) s
   remote == remotes(r)
   iprintstring( "Remote  ".remote_ c 
      name.snl)
   line = 1
   iprintstring( "        ".remote_description.snl)
   line = 3
   iprintstring( "STATUS:   ". c 
      remote status type(remote_status).snl)
   if  remote_network address len > 0 start 
      line = line+1
      if  remote_status <= open then  s="PRELOGON FEP:      FE". c 
        i to s(remote_prelog fep)  else  s="FEP:      FE". c 
       i to s(remote_fep)
      if  remote_prelog > prelogon untied start 
        s = s." (TIED"
        if  remote_fep=remote_prelog fep then  s = s.")" c 
         else  s = s." TO FE".itos(remote_prelog fep).")"
      finish 
      iprintstring( s.snl)
      s = "NET ADDR: "
      if  remote_network address len > 2 then  s = s.remote_X25 address c 
       else  start 
        cycle  i = 0, 1, remote_network address len-1
           s = s.i to s(remote_network add(i))." "
        repeat 
      finish 
      line = line+1
      iprintstring( s.snl)
   finish 
   line = line+1
   iprintstring( "Streams:".snl)
   cycle  i = remote_lowest stream, 1, remote_highest stream
      if  i&1 = remote_lowest stream&1 then  s = "" else  start 
         s = s." " while  length(s) < 20
      finish 
      s = s.stream details(i)_name." ".stream status type(streams(i)_ c 
         status)
      line = line+1 and  iprintstring( s.snl) c 
         if  i = remote_highest stream or  length(s) > 20
   repeat 
end ;                                   !OF ROUTINE DISPLAY STREAM
!*
!*

routine  update oper(integer   display type, which display, which page, string (10) specific user)
!***********************************************************************
!*                                                                     *
!*  REFRESH THE SELECTED DISPLAY ON THE OPER SPECIFIED EITHER CALLED   *
!*  INTERNALLY OR CALLED ON A CLOCK TICK.                              *
!*                                                                     *
!***********************************************************************
record  (pe)pp
integer  flag
switch  type(1 : 12)
   -> type(display type)
type(all queues):
   display queues( which page, yes)
   -> return
type(non empty queues):
   display queues( which page, no)
   -> return
type(all streams):
   display streams( which page, yes)
   -> return
type(active streams):
   display streams( which page, no)
   -> return
type(individual queue):
   display queue( which display, which page, no,
    specific user)
   -> return
type(full individual queue):
   display queue( which display, which page, yes,
    specific user)
   -> return
type(individual stream):
   display stream( which display)
   -> return
type(individual document):
   display document( 1, which display)
   -> return
type(all remotes):
   display remotes( which page, yes)
   -> return
type(logged on remotes):
   display remotes( which page, no)
   -> return
type(individual remote):
   display remote( which display)
   -> return
return:
end ;                                   !OF ROUTINE UPDATE OPER
!*
!*

!*
!*
!*
!*
end    {of routine interpret command}

stringfn  ident to s(integer  ident)
!***********************************************************************
!*                                                                     *
!*  TURNS A DOCUMENT IDENTIFIER INTO A STRING OF FIXED FORMAT          *
!*                                                                     *
!***********************************************************************
string  (2) fsys
string  (4) rest
   fsys = i to s(ident>>24)
   fsys = "0".fsys if  length(fsys) = 1
   rest = i to s(ident&x'FFFFFF')
   rest = "0".rest while  length(rest) < 4
   result  = fsys.rest
end ;                                   !OF STRINGFN IDENT TO S
   stringfn  i to s s(integer  i, l)
!***********************************************************************
!*                                                                     *
!*  TURNS AN INTEGER INTO A STRING OF THE SPECIFIED LENGTH PADDING     *
!*  WITH LEADING SPACES IF NECESSARY.                                  *
!*                                                                     *
!***********************************************************************
   string  (255) s
      s = i to s(i)
      s = " ".s while  length(s) < l
      result  = s
   end ;                                !OF STRINGFN I TO SS
!***********************************************************************
!*                                                                     *
!* THESE FUNCTIONS ALL USE A PACKED FORMAT OF DATE AND TIME OF THE     *
!* FOLLOWING FORM. BITS ARE NUMBERED FROM 31 (MOST SIGNIFICANT) TO     *
!* 0 (LEAST SIGNIFICANT)                                               *
!* BITS    USE                                                         *
!* 31-26  YEAR-70  (VALID FOR 1970-2033)                               *
!* 25-22  MONTH                                                        *
!* 21-17  DAY                                                          *
!* 16-12  HOUR                                                         *
!* 11- 6  MINUTE                                                       *
!*  5- 0  SECOND                                                       *
!*                                                                     *
!***********************************************************************



stringfn  s2(integer  n)
!THIS FUNCTION RETURNS A TWO DIGIT DECIMAL VALUE FOR N
integer  tens, units
   tens = n//10
   units = n-10*tens
   result  = tostring(tens+'0').tostring(units+'0')
end ;                                   !OF S2



stringfn  unpack date(integer  p)
   result  = s2(p>>17&x'1F')."/".s2(p>>22&x'F')."/".s2((p>>26& c 
      x'3F')+70)
end ;                                   !OF UNPACK DATE



stringfn  unpack time(integer  p)
   result  = s2(p>>12&x'1F').".".s2(p>>6&x'3F').".".s2(p&x'3F')
end ;                                   !OF UNPACK TIME



integerfn  i2(integer  ad)
!AD POINTS TO THE FIRST OF A PAIR OF DECIMAL CHARACTERS. THE RESULT
!IS THE NUMERIC VALUE OF THE CHAS
   result  = 10*(byteinteger(ad)&x'F')+(byteinteger(ad+1)&x'F')
end ;                                   !OF I2



integerfn  pack date(string  (8) date)
integer  ad
   ad = addr(date)
   result  = ((i2(ad+7)-70)<<26)!(i2(ad+4)<<22)!(i2(ad+1)<<17)
end ;                                   !OF PACK DATE



integerfn  pack date and time(string  (8) date, time)
integer  at
   at = addr(time)
   result  = pack date(date)!(i2(at+1)<<12)!(i2(at+4)<<6)!(i2( c 
      at+7))
end ;                                   !OF PACK DATE AND TIME
   string  (15) fn  hms(integer  secs)
!***********************************************************************
!*                                                                     *
!*  RETURNS THE GIVEN NUMBER OF SECONDS IN THE FORMAT HH.MM.SS         *
!*                                                                     *
!***********************************************************************
   integer  hrs, mins, scs, i
   string  (15) s
      hrs = secs//3600
      i = secs-hrs*3600
      mins = i//60
      scs = i-mins*60
      if  hrs > 0 then  s = i to s(hrs)."h " else  s = ""
      s = s.i to s(mins)."m " if  s # "" or  mins > 0
      result  = s.i to s(scs)."s"
   end ;                                !OF STRINGFN HMS
!*
!*




end  {m input}

external  routine  m poff message(record  (parmf) name  p)

record (message f)arrayformat  message af(1:1000)
record (message f)arrayname  messages
record (rf)re
switch  activity (20:40)
integer  remote number, flag, i
string (15) for
string (63) message

   iselect output(0)
   -> activity(p_dest & x'0000ffff')

activity(*):
  return 

activity(30):

    connect("SPOOLR.RJEMESS",r!s,0,0,re,flag)
    if  flag # 0 and  flag # 34 then  monitor 
    messages == array(re_conad+file header size,message af)
    for = messages(p_p2)_remote name
    message = messages(p_p2)_message
    remote number = p_p1
    cycle  i = 0,1,max consoles
      if  connections(i)_name = "MANAGER" or  connections(i)_name = for start 
        iselect output(consoles(i))
         if  connections(i)_name = "MANAGER" then  iprintstring("Message for ".for." (".itos(remote number). c 
         ") ".snl)
        iprintstring(message.snl)
        iprompt("<> ")
        iterminate
      finish 
    repeat 
    return 

activity(31):
    !The reply from the password check by SPOOLR
    iselect output(consoles(P_p2))
    if  p_p1 # 0 start 
       iprintstring("Invalid pass".snl)
      if  connections(P_p2)_disabled = locked then  ilogoff(consoles(P_p2))
      return 
    finish 
    connections(P_p2)_disabled = no
    iprompt("<> ")
    iterminate
    return 
end  {m poff message}

external  routine  m finalise(integer  console)
integer  i
   for  i=0, 1, 127 cycle 
      if  consoles(i)=console then  consoles(i)=255
   repeat 
end  {m finalise}



endoffile