%begin
%option "-NOCHECK-NOSTACK-NODIAG-NOLINE"
!* To reduce code size and speed of program
!DAK 5/11/84 David A Kerr
!DAK The first stage towards a genuinely worthwhile NEWUSERS utility.
!DAK At its most primitive it does exactly as the current system version
!DAK does, namely COPY $:UNOS, which means that it is just as fast.
!DAK Also however it has been writen to access other filestores for
!DAK their $:UNOS files. all filestores are accessed to get these files
!DAK before any post processing takes place to tidy up the output
!DAK thus splitting up the program logicaly, and getting rid of the
!DAK ethernet mess quickly.
!DAK As the $:UNOS files are just read into memory, some record could
!DAK be mapped on top to allow easier accessing of the data for post-
!DAK processing
!DAK Parameters available:
!DAK -Alpha    = select filestore 16_14
!DAK -Bravo    = select filestore 16_15
!DAK -Charlie  = select filestore 16_1B
!DAK -BC       = DEFAULT select 16_15 & 16_1B
!DAK -Vax      = select filestore 16_72
!DAK 6/11/84
!DAK Mods made to parameters available, additions:
!DAK -Unos     = dafault $:UNOS
!DAK -BRief    = user names only
!DAK -VBrief   = number of users only
!DAK -Location = user name then full location.
!DAK 7/11/84
!DAK Mods made to parameters available, additions:
!DAK -Names    = Print out name of each user
!DAK -ACtive   = users state of activity
!DAK 8/11/84
!DAK Mods made to defaults and source
!DAK -BC       = Now DEFAULT (as described above)
!DAK Source modified to compile under the new imp compiler
!DAK 9/11/84
!DAK Conversion to use the new APM location database
!DAK Detects whether user privileged (quoted system password)
!DAK Mods so that locations cater for his/her/your room
!DAK New parameter:
!DAK -Where    = User name plus location in an abreviated format
!DAK -Readable = DEFAULT a more readable form of $:UNOS
!DAK 12/11/84
!DAK redundant code replaced with another include file: inc:fsutil.imp
!DAK 05/06/85
!DAK mods so that only prints out "you (???) are at.." when the ether
!DAK station of 'you' is the same as that on 'unos'
!DAK -Full     = now without activity status

%include "inc:util.imp"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "managr:addefs.inc"
%include "managr:admin.inc"  {Administration database}
%include "managr:nsdefs.inc"
%include "managr:ns.inc"     {Name server database}

!* constants below for PAM
%constant %integer maxfstores  = 5, {Alpha, Bravo, Charlie, Vax, Met}
                   long  ns = 2_1000 0000 0000 0000 0000 0000 0000 0000,
                   Unos   F = 2_1000 0000 0000 0000 0000 0000 0000 0000,
                   Brief  F = 2_0100 0000 0000 0000 0000 0000 0000 0000,
                   VeryB  F = 2_0010 0000 0000 0000 0000 0000 0000 0000,
                   Full   F = 2_0001 0000 0000 0000 0000 0000 0000 0000,
                   BC     F = 2_0000 1000 0000 0000 0000 0000 0000 0000,
                   Alpha  F = 2_0000 0100 0000 0000 0000 0000 0000 0000,
                   Bravo  F = 2_0000 0010 0000 0000 0000 0000 0000 0000,
                   CharlieF = 2_0000 0001 0000 0000 0000 0000 0000 0000,
                   Vax    F = 2_0000 0000 1000 0000 0000 0000 0000 0000,
                   Where  F = 2_0000 0000 0100 0000 0000 0000 0000 0000,
                   Name   F = 2_0000 0000 0010 0000 0000 0000 0000 0000,
                   Active F = 2_0000 0000 0001 0000 0000 0000 0000 0000,
                   Loc    F = 2_0000 0000 0000 1000 0000 0000 0000 0000,
                   Read   F = 2_0000 0000 0000 0100 0000 0000 0000 0000

!* next arrays are to contain some filestore specific details
%constant %string(31) %array Fstores (1:maxfstores) = %c
                 "on Alpha:", "on Bravo:", "on Charlie:", "on Vax:", "on Met:"
%constant %integer %array nodenum (1:maxfstores) = %c
                 16_14, 16_15, 16_1B, 16_72, 16_44
%integer %array UnosStart, UnosLength, No Of Users, Readin  (1:maxfstores)
!* array above for location of each filestores $:UNOS in system memory
!* integer below for PAM
%record (admin fm) Afm
%integer Flags=0, xno=-1, priv=0, exist
%string(15) dir
%string(6) myname

!******************************************************************************
!* Following stolen from EFTP source
!* With some minor mods.... routine connect :== integer function fs connect
!*

%predicate gotack(%integer port)
! Wait for ACK and return TRUE.
! Return FALSE if fed up waiting.
%integer bit,deadline
  bit = 1<<port
  deadline = cputime+2000
  %cycle
    %if ack&bit#0 %start
      %trueif nak&bit=0
      nak = nak!!bit
      %false
    %finish
  %repeatuntil cputime>deadline
  %false
%end

%predicate gotdtx(%integer port)
! Wait for DTX and TRUE.  FALSE when fed up
%integer bit,deadline
  bit = 1<<port
  deadline = cputime+2000
  %cycle
    %trueif dtx&bit#0
  %repeatuntil cputime>deadline
  %false
%end

%integerfunction fs connect(%integer port,node)
! Establish a connection between local port PORT
! and network server NODE providing facility 2 (Filestore)
%string(127)reply
%integer i
%byte facility
{printstring("Attempting to connect port "); phex2(port)
{printstring(" to node "); phex2(node); newline
  facility = 2
  etheropen(port,node<<8)
  etherwrite(port,facility,1)
  %unless gotack(port) %start
    printstring("Node "); phex2(node)
    printstring(" not acknowledging connect request")
    etherclose(port)
    newline
    %result = 0
  %finish
  %unless gotdtx(port) %start
    printstring("Node "); phex2(node)
    printstring(" not responding to connect request")
    etherclose(port)
    newline
    %result = 0
  %finish
  length(reply) = etherread(port,charno(reply,1),127)
  i = charno(reply,length(reply))
  %unless i=nl %and length(reply)=2 %and charno(reply,1)>'0' %start
    printstring("Cannot connect to node "); phex2(node)
    printstring(": ".reply)
    etherclose(port)
    newline %unless i=nl
    %result = 0
  %finish
  i = charno(reply,1)-'0'
  etheropen(port,node<<8+i)
{printstring("Local port "); phex2(port); printstring(" connected to node ")
{phex2(node); printstring(" port "); phex2(i); newline
  %result = 1
%end

%routine disconnect(%integer port)
%byte eot = 12
  %onevent 15 %start
    %return
  %finish
{printstring("Attempting to disconnect port "); phex2(port)
{printstring(" from node "); phex2(s_nodeno); newline
  etherwrite(port,eot,1)
  %unless gotack(port) %start
    printstring("Cannot disconnect port "); phex2(port)
    printstring(" - Nak")
    newline
    %return
  %finish
  etherclose(port)
{printstring("Disconnected port "); phex2(port)
{newline
%end
!*
!* Thats all that was stolen from EFTP
!* That is the last of all the stolen stuff
!******************************************************************************

%routine Readin Unos
!* Reads in the $:UNOS file from the filestores requested.
!* No attempt to re-connect if already connected.
!* Assumes VAX is capable of providing $:UNOS if asked (this is
!* not so at the moment)
!* prints out warning if VAX attempted. Does not even
!* bother to think about OLD as there is hardly any point!
!* $:UNOS are connected (read in) to the APM and the start address and
!* lengths are saved in an array (see declarations at to of program)
!* for later processing as wanted by user
  %integer i, currentflag, old uno, old port
  Current Flag = Alpha F
  %for i = 1,1,maxfstores %cycle
    %if Flags&Current Flag # 0 %start
      %if CurrentFlag=VaxF %start
        printstring("VAX cannot provide user info yet.")
        newline
        readin(i)=0
      %finish %else %start
        %if etherstation # nodenum(i) %start
          old uno = user no
          old port = fs port
          user no = 0
          !* only connect to filestore if we are not already connected
          %if fs connect (2,nodenum(i)) # 0 %start
            fs port = 2
            connect file("$:UNOS",0,UnosStart(i),UnosLength(i))
            disconnect(2)
            no of users(i) = (UnosLength(i) // 78) - 1
            readin(i) = 1
          %finish %else Readin(i) = 0
          fs port = old port
          user no = old uno
        %finish %else %start
          connect file("$:UNOS",0,UnosStart(i),UnosLength(i))
          no of users(i) = (UnosLength(i) // 78) - 1
          Readin(i) = 1
        %finish
      %finish
    %finish %else Readin(i) = 0
    Current Flag = Current Flag >> 1
  %repeat
%end

%integer %function get hex (%integer f,t)
!* take a string starting at F and ending at T (system memory addr) and
!* convert it from hex into decimal variable
  %integer i, j, k
  i = 0;
  %for j = f,1,t %cycle
    k = byteinteger(j) - '0'
    k = k - 7 %if k > 9
    k = 0 %if k < 0
    i = i * 16 + k
  %repeat
  %result = i
%end

%string(80) %function get string(%integer f,t)
!* take system memory from F and ending at T and convert it into a string
  %string(80) s
  %integer i
  s = ""
  s = s.tostring(byteinteger(i)) %for i = f,1,t
  %result = s
%end

%string(80)%function Active Line (%integer j)
!* prints out a suitable message depending on the users state
!* of activity
!* gets users activity from last read/last write time in $:UNOS
  %const %string (31) %array Comments (0:7) = %c
                             "",             " beginning to yawn",
                             " drowsing",    " dropping off",
                             " asleep",      " snoring gently",
                             " fast asleep", " dead to the world"
  %integer i, d1, d2
  %string(8) date1, date2, today
  %string(5) time1, time2, now
  today = date; now = time
  now = substring(now,1,2).substring(now,4,5)
  date1=""; date2=""; time1=""; time2=""
  date1 = get string(j+47,j+54)
  time1 = get string(j+56,j+60)
  time1 = substring(time1,1,2).substring(time1,4,5)
  date2 = get string(j+63,j+70)
  time2 = get string(j+72,j+76)
  time2 = substring(time2,1,2).substring(time2,4,5)
  %if today # date1 %start
    %if stoi(substring(today,1,2))-stoi(substring(date1,1,2))>1 %then d1=5000 %c
      %else d1 = 2400 - (stoi(time1) - stoi(now))
  %finish %else d1 = stoi(now) - stoi(time1)
  %if today # date2 %start
    %if stoi(substring(today,1,2))-stoi(substring(date2,1,2))>1 %then d2=5000 %c
      %else d2 = 2400 - (stoi(time2) - stoi(now))
  %finish %else d2 = stoi(now) - stoi(time2)
  !* above gives offset as 'decimalized time'!!!
  %if d1 > d2 %then i = d2 %else i = d1
  i = rem(i,100) + (i//100)*60
  !* now converted into correct minutes
  i = i // 10
  i = 0 %if i < 0         ;! ???
  i = 7 %if i > 7
  %result = comments(i)
%end

%string(80)%function Name Line (%string(6) un)
!* prints out the users full name as found from the
!* "managr:admin.dat" data base. because of the load put on the
!* ethernet this routine is rather slow!
  %string(255) s
  %if search db (un,Afm) %then exist = -1 %else exist = 0
  %if exist # 0 %start
    s = Afm_description
    %if charno (s,1) = '!' %start
      %if length(s) >= 2 %then s = substring(s,3,length(s))
    %finish %else s = afm_prenames." ".afm_surname
  %finish %else s = "Someone"
  %result = s
%end

%string(80)%function Location Line (%string(6) un, %integer j)
!* print out the location (and in what directory) a user is
!* as known by the "managr.ns.dat" database
!* ether address is at unosstart(i)+9 
  %record(ns lfm) lf
  %integer l, k
  %string(4) rmn
  %string(15) how, rm, oi
  %string(80) lo, flo, A, B
  how = ""
  lo = ""
  %if un # dir %then dir = " (in ".dir.")" %else dir = ""
  %if xno > 0 %start
    l = read ns db(xno, gethex(j+9,j+10)!Long ns, addr(lf))
    %if l > 0 %start
      %if (Flags&NameF # 0) %and un = myname %then how =  " are" %else how = " is"
      rmn = ""
      %for k = 1,1,4 %cycle
        rmn = rmn.tostring(lf_add(k)) %if lf_add(k) > ' '
      %repeat
      %if lf_inon = 'I' %then oi = " in " %c
      %else %if lf_inon = 'O' %then oi = " on " %c
      %else %if lf_inon = 'A' %then oi = " at " %c
      %else oi = " "
      %if lf_room = 'T' %then oi = oi."the " %and rm = "" %c
      %else %if lf_room = 'R' %then rm = "'s room" %c
      %else rm = ""
      lf_room = 31
      lf_room = lf_room-1 %while lf_room > 0 %and lf_lname(lf_room) <= ' '
      flo = string(addr(lf_room))
      %if Flags&NameF # 0 %start
        %if flo -> A. (Afm_prenames." ".Afm_surname) .B %start
          rm = ""
          %if un # myname %start
            %if Afm_Group&16_1000 # 0 %then flo = "her room" %c
                                      %else flo = "his room"
          %finish %else flo = "your room"
        %finish
      %finish
      lo = Active Line(j) %if Flags&ActiveF # 0
      %if '0' <= charno(rmn,1) <= '9' %then rmn = " (".rmn.")" %else rmn = ""
      lo = lo.oi.flo.rm.rmn
    %finish %else lo = "is somewhere near Alpha Centauri"
  %finish %else lo = "** Database error **"
  %result = dir.how.lo
%end

%string(80)%function Where Line (%string(6) un, %integer j)
!* print out the location (and in what directory) a user is
!* as known by the "managr.ns.dat" database
!* only print out the brief (and therefore fast) format
!* ether address is at unosstart(i)+9 
  %bytearray data(0:8)
  %integer l
  %string(80) s, act
  %string(8) lo, how
  act = ""
  %if un # dir %then dir = " (".dir.")" %else dir = ""
  %if xno > 0 %start
    data(0) = read ns db(xno, gethex(j+9,j+10), addr(data(1)))
    data(0) = data(0)-1 %while data(0) # 0 %and data(data(0)) <= ' '
    lo = string(addr(data(0)))
    %if (Flags&NameF # 0) %and un = myname %then how = " are" %else how = " is"
    %if Flags&ActiveF # 0 %start
      act = Active Line(j)
      act = how.act %if act # ""
    %finish
    %if charno(lo,1) = '@' %then lo = act." ".lo %c
                           %else lo = act." @".lo
  %finish %else lo = "DB ERROR"
  %result = dir.lo
%end

%routine Fancy Unos (%integer i, mode)
!* Fancy output, mode selects format as for Flags at top of program
  %integer j, k, l
  %string(80) s
  %string(6) un
  %if no of users(i) > 0 %start
    j = unosstart(i)+78 {78 gets rid of ANON}
    %for k = 1,1,no of users(i) %cycle
      exist = 0
      un = ""
      dir = ""
      %for l = j+15,1,j+21 %cycle
        un = un.tostring(byteinteger(l)) %if byteinteger(l) # ' '
        dir = dir.tostring(byteinteger(l+8)) %if byteinteger(l+8) # ' '
      %repeat
      %if un # "" %start
        %if charno(un, length(un)) = '!' %start
          length(un) = length(un)-1 
          priv = -1
        %finish %else priv=0
        %if (mode&(WhereF!LocF) # 0) %and (mode&NameF # 0) %start
          !* Both names and location wanted
          !* Becomes -FULL if activity also wanted
          %if un = my name %and etherstation = gethex(j+9,j+10) %then %c
            printstring("You") %else printstring(Name Line (un))
          printstring(" (".un)
          printsymbol('!') %if priv # 0
          printsymbol(')')
          %if mode&WhereF # 0 %then printstring(Where Line (un,j)) %c
                              %else printstring(Location Line (un,j))
        %finish %else %if mode&(LocF!WhereF) # 0 %start
          !* location only wanted
          printstring(" ".un)
          printsymbol('!') %if priv # 0
          printsymbol(' ') %for l = length(un),1,8+priv
          %if mode&WhereF # 0 %then printstring(Where Line (un,j)) %c
                              %else printstring(Location Line (un,j))
        %finish %else %if mode&NameF # 0 %start
          !* name only wanted
          printstring(un)
          printsymbol('!') %if priv # 0
          %if mode&ActiveF = 0 %start
            printsymbol(' ') %for l = length(un),1,8+priv
          %finish %else printsymbol(' ')
          printstring(Name Line(un))
          %if mode&ActiveF # 0 %start
            s = Active Line(j)
            printstring(" is".s)
            printstring(" active") %if s = ""
          %finish
        %finish %else %if mode&ActiveF # 0 %start
          !* activity only wanted
          printstring(" ".un)
          printsymbol('!') %if priv # 0
          s = Active Line(j)
          printstring(" is".s)
          printstring(" active") %if s = ""
        %finish
      %finish %else %start
        printsymbol(byteinteger(l)) %for l = j,1,j+76
      %finish
      newline
      j = j + 78
    %repeat
  %finish
%end

%routine Unos Unos (%integer i)
!* the most primitive (and therefore fast) method of outputing who
!* is logged on... simply dumps the $:UNOS files as read in with no
!* tidying up at all
  %integer j
  printsymbol(byteinteger(j)) %for j=unosstart(i),1,unosstart(i)+unoslength(i)-1
%end

%routine Brief Unos (%integer i)
!* brief output is faster than above because there is less output
!* to the VDU, but of course less information is given.
  %integer j, k, l
  %if no of users(i) > 0 %start
    j = unosstart(i)+15+78 {78 gets rid of ANON}
    %for k = 1,1,no of users(i) %cycle
      printsymbol(byteinteger(l)) %for l = j,1,j+6
      printstring("  ")
      newline %if rem(k,8) = 0 %or k = no of users(i)
      j = j + 78
    %repeat
  %finish
%end

%routine Readable Unos (%integer i)
  %integer j, k, l
  %string(8) date0, date1, date2, today, un
  today = date
  j = unosstart(i)
  %for k = 1,1,no of users(i)+1 %cycle
    un = ""
    dir = ""
    %for l = j+15,1,j+21 %cycle
      un = un.tostring(byteinteger(l)) %if byteinteger(l) # ' '
      dir = dir.tostring(byteinteger(l+8)) %if byteinteger(l+8) # ' '
    %repeat
    %if charno(un, length(un)) = '!' %start
      length(un) = length(un)-1
      priv = -1
    %finish %else priv = 0
    date0 = get string(j+31,j+38)
    date1 = get string(j+47,j+54)
    date2 = get string(j+63,j+70)
    date0 = "   today" %if date0 = today
    date1 = "   today" %if date1 = today
    date2 = "   today" %if date2 = today
    printsymbol(byteinteger(l)) %for l = j,1,j+14
    printstring("  ".un)
    printsymbol('!') %if priv # 0
    printsymbol(' ') %for l = length(un),1,8+priv
    %if un # dir %start
      printstring(dir)
      printsymbol(' ') %for l = length(dir),1,7
    %finish %else printstring("        ")
    printstring(date0.get string(j+39,j+44)."  ")
    printstring(date1.get string(j+55,j+60)."  ")
    printstring(date2.get string(j+71,j+76))
    newline
    j = j + 78
  %repeat
%end

%routine Print Unos
!* cycles through all filestores and calls the apropriate routine
!* (as determined by parameters) to print out the result.
  %integer i
  open admin db %if Flags&NameF # 0
  xno = open ns db %if Flags&(WhereF!LocF) # 0
  %for i = 1,1,maxfstores %cycle
    %if readin(i) # 0 %start
      Write(no of users(i),0)
      printstring(" User")
      printsymbol('s') %if no of users(i) # 1
      printstring(" ".fstores(i)); newline
      %if Flags&ReadF # 0 %then Readable Unos (i) %c
      %else %if Flags&UnosF # 0 %then Unos Unos (i) %c
      %else %if Flags&VeryBF # 0 %then printstring("") %c
      %else %if Flags&BriefF # 0 %then Brief Unos (i) %c
      %else %if Flags&(FullF!LocF!NameF!ActiveF!WhereF) # 0 %then Fancy Unos (i,Flags)
    %finish
  %repeat
  close db %if Flags&NameF # 0
  close ns db(xno) %if Flags&(WhereF!LocF) # 0
%end

!******************************************************************************
!* Main program block
!*
define Boolean Params ("Unos,BRief,VBrief,Full,BC,Alpha,Bravo,Charlie,". %c
                       "Vax,Where,Names,ACtive,Location,Readable", Flags,0)

Process Parameters (CLI Param)

!* If no format specified then -READABLE option
Flags=Flags!ReadF %if Flags&(UnosF!BriefF!VeryBF!FullF!LocF!NameF!ActiveF!WhereF)=0 

!* If no filestore specified then -BC option
Flags=Flags!BCF %if Flags&(AlphaF!BravoF!CharlieF!VaxF)=0

!* If -BC option then set to -BRAVO-CHARLIE
Flags=Flags!(BravoF!CharlieF) %if Flags&BC F#0

!* If -FULL option then set to -LOCATION-NAMES
%if Flags&FullF # 0 %then Flags = Flags!LocF!NameF

myname = current user
length(myname) = length(myname)-1 %if charno(myname, length(myname)) = '!'
Readin Unos
Print Unos

%end %of %program