! Constant Filenames
%CONSTANT %STRING (20) database = "ECMU24.locfile"
%CONSTANT %STRING (20) update = "ECMU23.upusers"
%CONSTANT %STRING (20) helpfile = "ECMU23.helpfile"
! Stuff Needed For Connect
%RECORD %FORMAT recfor(%INTEGER conad,filetype,datastart,dataend)
%SYSTEM %ROUTINE %SPEC connect(%STRING (31) filename, %INTEGER access,
maxbytes,prot, %RECORD (recfor) %NAME r, %INTEGER %NAME flag)
%SYSTEM %ROUTINE %SPEC disconnect(%STRING (31) filename, %INTEGER %NAME flag)
! Common External Reference Points
%EXTERNAL %ROUTINE %SPEC writeprofile(%STRING (11) key, %NAME blah,
%INTEGER %NAME version,flag)
%EXTERNAL %STRING (255) %FUNCTION %SPEC uinfs(%INTEGER i)
%EXTERNAL %INTEGER %FUNCTION %SPEC uinfi(%INTEGER i)
%EXTERNAL %ROUTINE %SPEC readprofile(%STRING (11) key, %NAME info,
%INTEGER %NAME v,f)
%EXTERNAL %INTEGER %FUNCTION %SPEC dprocedure(%INTEGER number,address)
%EXTERNAL %STRING (255) %FUNCTION %SPEC time
%EXTERNAL %STRING (255) %FUNCTION %SPEC date
! Start of routine STATUS : command whichs tells you of state of process
!
%ROUTINE logged on(%STRING (255) switch)
! The Various Inactive States Of a process
%CONSTANT %STRING (50) %ARRAY status(0:255) = "Yawning"(11),"Dozing"(15),
"Napping"(15),"Sleeping"(20),"Totally Comatose"(15),
"About To Be Logged Off"(30),"Priviledged Not To Have Been Logged Off"(*)
%INTEGER on
! Record Used By Dprocs To Describe each process
%RECORD %FORMAT procf(%STRING (6) user, %BYTE %INTEGER incar,category,wsn,
runq,active, %INTEGER actwo,lstad,lamtx,stack,status)
%EXTERNAL %INTEGER %FUNCTION %SPEC dprocs(%INTEGER %NAME maxprocs,
%INTEGER adr)
%ROUTINE deluxe(%INTEGER maxprocs)
%BYTE %INTEGER %ARRAY proclist(0:32*maxprocs)
%RECORD (procf) %ARRAY procaf(0:maxprocs)
%RECORD (procf) %ARRAY %NAME proca
%INTEGER j,flag
flag = dprocs(maxprocs,addr(proclist(0))) { Get the process list}
write(flag,4) %AND %RETURN %IF flag#0
maxprocs = maxprocs-1
proca == array(addr(proclist(0)),procaf) { Set up Array of processes}
on = 0
%FOR j = 0,1,maxprocs %CYCLE { Start Looking for user}
%IF proca(j)_user=switch %THEN %START { Found Him/Her}
on = 1
print string(switch)
printstring(" is ")
! Look To See If Process Is Inactive
%IF proca(j)_status&16#0 %THEN %C
printstring(status(proca(j)_active)) %ELSE printstring("active")
printstring(" at the moment")
newline
%FINISH
%REPEAT
%IF on=0 %START { If True Then Process Isnt Logged On}
printstring(switch." is not logged on!!")
newline
%FINISH
%END
%INTEGER maxprocs
maxprocs = 255
deluxe(maxprocs)
%RETURN
%END
%EXTERNAL %ROUTINE status(%STRING (255) s)
! Check For Decent Usernumber
%IF length(s)=6 %THEN loggedon(s) %ELSE %C
printstring("Invalid Username") %AND newline
%END
! End Of Routine STATUS
! Start Of Routine RENEW : Enables User To Update Any Location In Database
!
%EXTERNAL %ROUTINE renew(%STRING (255) nowt)
%CONSTANT %INTEGER fieldwidth = 51,maxtcps = 36 { Length Of String In File}
{ Max number of TCPS}
! The Tcps as known
%CONSTANT %STRING (11) %ARRAY tcp(1:maxtcps) = "ATB1","TCPA","TCPC",
"TCPD","TCPM","JCMB","PSSE","TCPS","ATB2","ATB3","CHEM","CSA1",
"CSA2","ENGR","ELIB","FORR","GESQ","POLL","SOCS","SCRI-I",
"WS-COA","GEOG","FCNRS","SIAE","ERSK","BUSH","HFRO","SCRP","GTCP1",
"GTCP2","GTCP3","GTCP4","GTCP5","STCP","STCL-2","IGS"
! The corresponding offset for each tcp in the database
%CONSTANT %INTEGER %ARRAY offset(1:maxtcps) = 0,48,96,144,192,240,288,289,
337,385,433,481,529,577,625,673,721,769,817,865,913,961,1009,1057,1105,
1153,1201,1249,1297,1345,1393,1441,1489,1537,1585,1633
%EXTERNAL %ROUTINE %SPEC prompt(%STRING (255) params)
%EXTERNAL %STRING %FUNCTION %SPEC ucstring(%STRING (255) params)
%SYSTEM %STRING %FUNCTION %SPEC itos(%INTEGER i)
%INTEGER startaddr,i,j,flag,ch,console,loclength,start2
%BYTE %INTEGER %ARRAY %FORMAT loc(0:51)
%BYTE %INTEGER %ARRAY %NAME locname,ptr
%RECORD (recfor) r
%STRING (255) tcpname,str
%ON %EVENT 4 %START
printstring("That Wasn't A Decimal Number?")
newline
readch(ch)
%STOP
%FINISH
prompt("Tcp?:")
tcpname = ""
%CYCLE { Read In the TCPname to be updated}
readch(ch)
tcpname = tcpname.tostring(ch)
%REPEAT %UNTIL nextch=nl
tcpname = ucstring(tcpname) { Bung it to uppercase}
i = 0
%CYCLE { Do i know this TCP ?}
i = i+1
! Obviously Not If this Is True
%IF i>maxtcps %THEN printstring("TCP not known".tostring(nl)) %AND %STOP
%IF tcpname=tcp(i) %START { Found The Tcp}
prompt("Console Number(Dec)?:")
readch(ch) { Get rid of NL character}
read(console) { Read in the console number}
%IF nowt="?" %START
connect(database,10,0,0,r,flag)
startaddr = r_conad+r_datastart
locname == array(startaddr+(offset(i)+console)*fieldwidth,loc)
%FOR j = 1,1,50 %CYCLE
%EXITIF locname(j)='_'
printsymbol(locname(j))
%REPEAT
newline
disconnect(database,flag)
%STOP
%FINISH
prompt("Location?:")
readch(ch) { Get rid of NL character}
connect(database,10,0,0,r,flag) { Connect Up the database}
startaddr = r_conad+r_datastart
{ Find the start Address of file in users VM}
! Map the contents of the Database at required offset into BYTEINTEGERARRAY
locname == array(startaddr+(offset(i)+console)*fieldwidth,loc)
%FOR j = 1,1,50 %CYCLE { Find the length Of the Database String}
%EXIT %IF locname(j)='_'
%REPEAT
loclength = j
j = 1
%CYCLE { Start reading the new location}
readch(ch)
locname(j) = ch { Overwrite The Old Location}
j = j+1
%REPEAT %UNTIL nextch=nl
%IF locname(j)<>'_' %START
locname(flag) = '_' %FOR flag = j,1,
loclength { Stick In Underlines If Necessary}
%FINISH
%EXIT
%FINISH
%REPEAT
printstring("Finished Update") { Tell Ye Olde User You've done it}
newline
disconnect(database,flag) { Disconnect The File}
connect(update,10,0,0,r,flag) { Connect the User Recording File}
start2 = r_conad+r_datastart { Find Start Address OF This One}
%FOR i = 0,1,50 %CYCLE { Find An Unwritten Bit Of File}
locname == array(start2+i*fieldwidth,loc)
%IF locname(0)='_' %START { If Unwritten Then}
! Record Usernumber TCP altered Console alter(dec) where about they did it
str = uinfs(1)." Altered ".tcpname."+".itos(console)." at ".uinfs(14)
ptr == array(addr(str),loc)
%FOR j = 0,1,length(str) %CYCLE { Stick the string into the file}
locname(j) = ptr(j)
%REPEAT
printstring("Name Recorded") { Tell The User Youve Done it again}
newline
%EXIT
%FINISH
%REPEAT
disconnect(update,flag) { Disconnect The File}
%END
! End Of Routine RENEW
! Start Of String Fn LOCATE Which Finds Out A Location For TCP And Console
%STRING %FUNCTION locate(%STRING (15) tcpname, %INTEGER console,startaddr)
%CONSTANT %INTEGER fieldwidth = 51,maxtcps = 36
! The tcps
%CONSTANT %STRING (11) %ARRAY tcp(1:maxtcps) = "ATB1","TCPA","TCPC",
"TCPD","TCPM","JCMB","PSSE","TCPS","ATB2","ATB3","CHEM","CSA1",
"CSA2","ENGR","ELIB","FORR","GESQ","POLL","SOCS","SCRI-I",
"WS-COA","GEOG","FCNRS","SIAE","ERSK","BUSH","HFRO","SCRP","GTCP1",
"GTCP2","GTCP3","GTCP4","GTCP5","STCP","STCL-2","IGS"
! The Offsets
%CONSTANT %INTEGER %ARRAY offset(1:maxtcps) = 0,48,96,144,192,240,288,289,
337,385,433,481,529,577,625,673,721,769,817,865,913,961,1009,1057,1105,
1153,1201,1249,1297,1345,1393,1441,1489,1537,1585,1633
%STRING (50) resultstr
%STRING (50) %NAME location
%INTEGER i,j
%SYSTEM %STRING %FUNCTION %SPEC itos(%INTEGER i)
%FOR i = 1,1,maxtcps %CYCLE { See if i know this TCP}
%IF tcpname=tcp(i) %START { Found it}
! Map contents Of File at calculated offset and stick in string
location == string(startaddr+(offset(i)+console)*fieldwidth)
length(location) = 50
resultstr = location
%FOR j = 1,1,50 %CYCLE { Chop Out The Nasty Bits i.e. _}
%EXIT %IF substring(resultstr,j,j)="_"
%REPEAT
length(resultstr) = j-1
! Return The result
%RESULT = " is at ".resultstr." ".itos(console)
%FINISH
%REPEAT
! If i didnt find the tcp then its probably a network address
%RESULT = " is at network address ".tcpname
%END
! End Of String FN Locate
! Start of Routine APPLY which does a FIND on Everyone
%ROUTINE apply(%ROUTINE use(%STRING (255) s, %STRING (15) tcpname,
%INTEGER console,mode))
%RECORD %FORMAT rf1(%INTEGER n,a)
%RECORD (rf1) r1
! Record Format Used By DPROCEDURE
%RECORD %FORMAT pf(%STRING (6) user, %STRING (15) tcp, %BYTE %INTEGER a,
invoc,b,n,f, %INTEGER logs, %BYTE %INTEGER site,reason,cons1,cons2,
%INTEGER id,proc,g,h,z)
%RECORD (pf) %ARRAY p(1:256)
! Record Format Used In sorting users
%RECORD %FORMAT ustabf(%INTEGER next,status,console, %STRING (15) tcpname,
%STRING (6) name)
%RECORD (ustabf) %ARRAY ustab(0:255)
%INTEGER i,j,flag,nusers,nextfree,start,dummy,adr,k,last
%STRING (255) sout
nusers = 0; nextfree = 0; start = 0; dummy = 0; adr = 0
r1_a = addr(p(1))
flag = dprocedure(1,addr(r1)) { Get the process list table}
! This is just the sorting mechanism :- I didnt write it tis from NEWUSERS
%CYCLE j = 1,1,r1_n
%IF p(j)_user#"" %THEN %START
%IF 1=1 %THEN %START
nusers = nusers+1
ustab(nextfree)_name = p(j)_user
ustab(nextfree)_status = p(j)_reason
ustab(nextfree)_tcpname = p(j)_tcp
%IF '0'<=p(j)_cons1<='9' %START
ustab(nextfree)_console = (p(j)_cons1-48)*16
%IF p(j)_cons2>64 %THEN %C
ustab(nextfree)_console = ustab(nextfree)_console+p(j) %C
_cons2-55 %ELSE %C
ustab(nextfree)_console = ustab(nextfree)_console+p(j) %C
_cons2-48
%FINISH %ELSE ustab(nextfree)_console = -1
%IF nextfree=0 %THEN %C
ustab(nextfree)_next = -1 %AND nextfree = nextfree+1 %ELSE %C
%START
k = start
last = start
%CYCLE
%EXIT %IF ustab(nextfree)_name<ustab(k)_name %OR %C
ustab(k)_next=-1
last = k
k = ustab(k)_next
%REPEAT
%IF k=start %THEN %START
%IF ustab(nextfree)_name>ustab(k)_name %THEN %C
ustab(nextfree)_next = ustab(k)_next %AND %C
ustab(k)_next = nextfree %ELSE %C
ustab(nextfree)_next = k %AND start = nextfree
%FINISH %ELSE %START
%IF ustab(nextfree)_name>ustab(k)_name %THEN %C
ustab(nextfree)_next = ustab(k)_next %AND %C
ustab(k)_next = nextfree %ELSE %START
ustab(nextfree)_next = ustab(last)_next
ustab(last)_next = nextfree
%FINISH
%FINISH
nextfree = nextfree+1
%FINISH
%FINISH
%FINISH
%REPEAT
i = start
sout = ""
j = start
%CYCLE i = 1,1,nextfree
! Call up the outputing Routine
use(ustab(j)_name,ustab(j)_tcpname,ustab(j)_console,ustab(j)_status)
j = ustab(j)_next
%REPEAT
%END; { of apply}
%EXTERNAL %INTEGER %FUNCTION %SPEC outpos
%CONSTANT %INTEGER sys procs = 4; { Number of system processes}
%CONSTANT %INTEGER ocp type = 10
%CONSTANT %INTEGER terminal width = 15
%SYSTEM %STRING (255) %FUNCTION %SPEC username(%STRING (255) user,
%INTEGER machine)
%SYSTEM %INTEGER %FUNCTION stoi(%STRING (255) s)
%INTEGER sym
%IF length(s)>0 %START
%RESULT = -stoi(sub string(s,2,length(s))) %IF %C
charno(s,1)='-' %AND length(s)>1
sym = charno(s,length(s))-'0'
length(s) = length(s)-1
%RESULT = 10*stoi(s)+sym
%FINISH
%RESULT = 0
%END
%CONSTANT %STRING (32) %ARRAY computer scientist(00:99) = "ECSC00 A Ghost",
"ECSC01 Jeff Tansley","ECSC02 Andrew Morton",
"ECSC03 Sidney Michaelson","ECSC04 David Rees",
"ECSC05 Peter Schofield","ECSC06 George Ross","ECSC07 Robin Milner",
"ECSC08 Alex Wight","ECSC09 Nick Shelness","ECSC10 Hamish Dewar",
"ECSC11 Tom Buckley","ECSC12 Kate Duncan","ECSC13 Paul Cockshott",
"ECSC14 Rod Burstall","ECSC15 Peter Lindsay",
"ECSC16 Rosemary Candlin","ECSC17 Gordon Hughes","ECSC18 L. Damas",
"ECSC19 Mike Sanderson","ECSC20 Rob Proctor",
"ECSC21 George McCaskill","ECSC22 Vera Noethe","ECSC23 A Ghost",
"ECSC24 J. Grimison","ECSC25 A Ghost","ECSC26 Kathy Humphry",
"ECSC27 Ian Thomson","ECSC28 Liam Casey","ECSC29 Frank Stacey",
"ECSC30 Luca Cardelli","ECSC31 L. Legrretta",
"ECSC32 Jimmy Johnstone","ECSC33 A Ghost","ECSC34 Andrew Morton",
"ECSC35 Fred King","ECSC36 K. Lutas","ECSC37 M. Hennesey",
"ECSC38 A Ghost","ECSC39 George Cleland","ECSC40 Ken Chisholm",
"ECSC41 Jeff Tansley","ECSC42 Hans Jeanrod","ECSC43 Alan Vernon",
"ECSC44 Pedro Hepp","ECSC45 Steve Holtzman",
"ECSC46 Carl Sturtivant","ECSC47 Lee Dan Smith",
"ECSC48 Paul McLellan","ECSC49 Richard Marshall",
"ECSC50 Irene Buchanan","ECSC51 A. Smailajic","ECSC52 Dixon",
"ECSC53 Malcom Atkinson","ECSC54 Gordon Brebner","ECSC55 J. Cardin",
"ECSC56 Douglas Tudhope","ECSC57 David Brownrigg",
"ECSC58 Clive Davenhall","ECSC59 Mark Jerrum","ECSC60 Walter Scott",
"ECSC61 Krishna Kulkarni","ECSC62 Roderick McLeod",
"ECSC63 Don Sanella","ECSC64 John Gray","ECSC65 G. Owoso",
"ECSC66 Tom Horton","ECSC?? A new CS face"(*)
%ROUTINE find users(%STRING (255) param)
%INTEGER startaddr,flag
%STRING (255) %FUNCTION special(%STRING (255) user)
%CONSTANT %INTEGER max users = 16
%CONSTANT %INTEGER max groups = 39
! Take the mailer names if available
%CONSTANT %STRING (31) %ARRAY users(1:max users) =
"SUBSYS A subsystem hacker","LOADER Some extra system load",
"CONLIB Contributed software","KNTLIB Kent's software store",
"ECSLIB EUCSD's software store","ERCLIB ERCC's software store",
"CHMENG a Chemical Engineer","MANAGR The System Manager",
"SYSMAN The System Manager","SPOOLR The Device Manager",
"JOURNL The Captain's log","DIRECT The Director",
"REMOTE The Queue's Manager","UTILTY an unknown user",
"VOLUMS The Archive Handler","MAILER The Postman"
%CONSTANT %STRING (31) %ARRAY groups(1:max groups) %C
= "EBFR A forestry staff","EBFU A forestry student",
"EBOT A botany user","EDCB A chemical person",
"EDCU A chemistry student","EFDU A maths student",
"EFEU A maths student","EGMU A meteorology student",
"EGNP A physical person","EGNU A physics student",
"EGPU A geophysics student","EHJU A busy studying student",
"EHJV A busy studying student","EJAA An Economical user",
"EJJU A geography student","EJUA A psychological person",
"EJUU A psychological student","ELEU An Elect. Eng. student",
"EMCU A Chem. Eng. student","EMEU A Mech. Eng. student",
"EMFU A Mech. Eng. student","EMTU A Chem. Eng. student",
"ENCU A Civil Eng. student","ECPY An IMPish hacker",
"ECTU A CS2 student","ECXU A CS1 student",
"ECYU A CS1 student","ECZU A CS1 student",
"ECUU An IS1 student","ECMU An A.I. Robot",
"ERFY A Fortran Coarse hacker!","ERCC A nameless ERK!",
"ERCI A micro person","ERCM A talkative person",
"ERCS A compiler person","ERIY A little IMP",
"ERSY S.Paperwasting.S.S. user","JOBR A batch server",
"PLUL A program librarian"
%CONSTANT %STRING (23) %ARRAY places('A':'Z') = " an unknown",
" a St. Andrews"," a Strathclyde"," an unknown",
" an Edinburgh"," a Stirling"," a Glasgow"," a Heriot-Watt",
" an unknown"(3)," an agricultural"," a medical",
" an unknown"(2)," a Leeds"," a Newcastle"," an Essex",
" an Unknown"(2)," a Open University"," an unknown",
" a Cardiff"," an unknown"(*)
%STRING (255) userno,group,name
%INTEGER i
userno = user; length(userno) = 6
group = userno; length(group) = 4
%CYCLE i = 1,1,max users
%RESULT = users(i) %IF users(i)->(userno)
%REPEAT
%CYCLE i = 1,1,max groups
%RESULT = userno.name %IF groups(i)->(group).name
%REPEAT
%IF charno(group,4)='U' %THEN user = " student" %ELSE user = " user"
%RESULT = userno.places(charno(group,1)).user
%END
%CONSTANT %BYTE %INTEGER %ARRAY reason(1:4) = 'b','s','?',' '
%INTEGER machine,fore,back,invoc map,width
%STRING (127) mask,form,invocs
%INTEGER %FUNCTION interesting(%STRING (31) user)
%INTEGER i
%RESULT = 0 %IF mask="??????"
%FOR i = 1,1,6 %CYCLE
%RESULT = -1 %IF charno(mask,i)#'?' %AND charno(user,i)#charno(mask,i)
%REPEAT
%RESULT = 0
%END
! Outputs The Locations Of Each User
%ROUTINE normal output(%STRING (255) user, %STRING (15) tcpname,
%INTEGER console,mode)
%STRING (6) uservar
%STRING (255) s
%INTEGER i
! Over-ride the mailer names for a selected few...
%CONSTANT %INTEGER max over rides = 3
%CONSTANT %STRING (31) %ARRAY overrides(1:max overrides) %C
= "JOBR00 b A batch jobber",
"REMOTE Emas Queue Manipulator","ECMU23 Graham Adamson"
%IF mode=2 %THEN mode = 1 %AND back = back+1 %ELSE %C
mode = 4 %AND fore = fore+1
mode = 2 %IF user="DIRECT" %OR user="VOLUMS" %OR user="SPOOLR" %OR %C
user="MAILER"
%RETURN %IF interesting(user)#0 %OR mode=2
%IF user->("ECSC").s %START
s = computer scientist(stoi(s))
%FINISH %ELSE %START
s = ""
%CYCLE i = 1,1,max overrides
s = overrides(i) %AND %EXIT %IF overrides(i)->(user)
%REPEAT
s = user." ".username(user,machine) %IF s=""
s = special(s) %IF charno(s,length(s))='?'
%FINISH
charno(s,8) = reason(mode) %IF mode#4
uservar <- s
! If there is a console number then there is a location so get it
! If mode is one then Process is Batch Job
! If there is no console number then output name of TCP
! If there is no TCP i.e null Output UNKNOWN msg
%IF console#-1 %THEN %C
printstring(s.locate(tcpname,console,startaddr)) %ELSE %IF %C
mode=1 %THEN printstring(s." Has A Batch Job Running") %ELSE %IF %C
tcpname="null" %THEN printstring(s." is somewhere unknown") %ELSE %C
printstring(s." is at TCP:-".tcpname)
!SPACES (40-LENGTH(S))
!NEWLINE %IF OUTPOS + 40 > WIDTH
newline
%END
%RECORD (recfor) r
connect(database,10,0,0,r,flag) { Connect up databse}
startaddr = r_conad+r_datastart { Get Start Address Of it in VM}
mask = param
form = "N" %UNLESS mask->mask.(",").form
invocs = "FB" %UNLESS form->form.(",").invocs
mask = mask."??????"
length(mask) = 6
length(form) = 1
invoc map = 0
invoc map = invoc map!1 %IF invocs->("B")
invoc map = invoc map!2 %IF invocs->("S")
invoc map = invoc map!4 %IF invocs->("F")
invoc map = 4 %IF invoc map=0
! Establishes default params "??????",NORMAL,F
param = uinfs(ocp type)
machine = '2'
machine = '0' %IF param="2980"
width = uinfi(terminal width)
fore = 0; back = 0
apply(normal output)
newline %IF outpos>1
newline
disconnect(database,flag)
%END
! End Of GLOBAL FIND
%EXTERNAL %INTEGER %FUNCTION %SPEC dfsys(%STRING (6) fileindex,
%INTEGER %NAME fsys)
! Start OF Routine ADDNAME which puts a user and alias into list in ss#profile
%EXTERNAL %ROUTINE addname(%STRING (255) data)
%INTEGER version,flag
%RECORD (%INTEGER index, %STRING (6) %ARRAY usnos(1:25),
%STRING (31) %ARRAY usname(1:25)) rec
%STRING (255) s,t
! Check to see if data is in correct format
%IF (data->s.(",").t) %AND (t<>tostring(nl)) %START
flag = -1
length(s) = 6
version = dfsys(s,flag) { See if user specified Actually Exists}
%IF flag<>-1 %START { If he/she does then add to list}
flag = 0; version = 0
rec_index = 0
readprofile("GWW",rec,version,flag) { GEt Old List}
%IF rec_index<>25 %START { Make sure theres enough space}
rec_index = rec_index+1
%IF length(s)=6 %START
%IF length(t)>25 %START { truncate alias name if too big}
printstring("Name truncated (Max.25)"); newline
length(t) = 25
%FINISH
rec_usname(rec_index) = t
rec_usnos(rec_index) = s
printstring("Number Of Names Inserted =")
write(rec_index,3); newline
writeprofile("GWW",rec,version,flag) { Write in new list}
%FINISH %ELSE printstring("Invalid User") %AND newline
%FINISH %ELSE printstring("Max No.s(25) already allocated") %AND %C
newline
%FINISH %ELSE printstring("User not found in system") %AND newline
%FINISH %ELSE printstring("Invalid Parameter Supplied") %AND newline
%END
! End of routine ADDNAME
! Start Of Command FIND
%ROUTINE print logged on(%STRING (255) switch)
%RECORD %FORMAT rf1(%INTEGER n,a)
%RECORD (rf1) r1
%RECORD %FORMAT pf(%STRING (6) user, %STRING (15) tcp, %BYTE %INTEGER a,
invoc,b,n,f, %INTEGER logs, %BYTE %INTEGER site,reason,cons1,cons2,
%INTEGER id,proc,g,h,z)
%RECORD (pf) %ARRAY p(1:256)
%INTEGER on
%STRING (255) datetime,t
%EXTERNAL %ROUTINE %SPEC readprof(%STRING (11) k, %NAME a,
%INTEGER %NAME v,f, %STRING (6) u)
!
%ROUTINE deluxe
r1_a = addr(p(1))
on = dprocedure(1,addr(r1)) { Get Process list table}
%INTEGER version,flags,index,startaddr,console,j
%RECORD (%INTEGER terminal, %STRING (50) %ARRAY locate(1:5)) rec
%RECORD (%INTEGER quantity, %STRING (6) %ARRAY user number(1:25),
%STRING (31) %ARRAY user name(1:25)) info
%RECORD (recfor) r
connect(database,10,0,0,r,flags) { Access database}
startaddr = r_conad+r_datastart
%IF switch="" %THEN %C
{ If no single User then Read the list in SS#PROFILE} read profile %C
("GWW",info,version,flags) %ELSE %START
%IF length(switch)<>6 %START
printstring("Illegal Process Number"); newline
%RETURN
%FINISH %ELSE %START
info_quantity = 1 { Set Up Record For The Single User}
info_usernumber(1) = switch
info_username(1) = username(switch,1)
%IF info_username(1)="?" %THEN %C
info_username(1) = "Mr Mystery(Unknown User)"
flags = 1
%FINISH
%FINISH
%IF (flags<3) %AND (info_quantity>0) %THEN %START
%FOR index = 1,1,
info_quantity %CYCLE { Start working thru friends list}
on = 0
%FOR j = 1,1,r1_n %CYCLE
{ Start looking for friend in Process list}
! Found User logged on
%IF p(j)_user=info_user number(index) %THEN %START
on = 1
print string(info_user name(index))
! Test to see if process is a batch job
%IF p(j)_reason<>2 %START
! Else work out console number if there is one
%IF '0'<=p(j)_cons1<='9' %START
console = (p(j)_cons1-48)*16
%IF p(j)_cons2>64 %THEN %C
console = console+p(j)_cons2-55 %ELSE %C
console = console+p(j)_cons2-48
printstring(locate(p(j)_tcp,console,startaddr))
! If Not Output Tcp name
%FINISH %ELSE printstring(" Is At Tcp:-".p(j)_tcp)
! Or A Batch Job
%FINISH %ELSE printstring(" Has A Batch Job Running")
newline
%FINISH
%REPEAT
%IF on=0 %START
{ If User is not in process list i.e. Not logged on}
printstring(info_username(index))
! See if theyve left a gone message
readprof("FIND",rec,version,flags,info_usernumber(index))
%IF rec_terminal=-2 %START
datetime = rec_locate(2)
t = rec_locate(1)
printstring(" went ".t." at ".substring(datetime,9,
length(datetime))." on ".substring(datetime,1,8))
! If they havent then just say not on
%FINISH %ELSE printstring(" not logged on")
newline
%FINISH
%REPEAT { Go back and do same for next user}
%FINISH %ELSE %START
{If no single user called andno list in SS#PROFILE then complain}
printstring("No names inserted in ss#profile see HELPME")
newline
%FINISH
disconnect(database,flags)
%END
deluxe
%RETURN
%END
%EXTERNAL %ROUTINE find(%STRING (255) s)
%STRING (255) t
! Call up appropriate routine depending on parameter
%IF s="" %THEN printloggedon("") %ELSE %IF s="*" %THEN findusers("") %ELSE %C
%IF %NOT (s->("?").t) %THEN printloggedon(s) %ELSE findusers(s)
%END
! End of Command FIND
! Start Of Routine Gone
%EXTERNAL %ROUTINE gone(%STRING (255) s)
%INTEGER version,flag
%RECORD (%INTEGER terminal, %STRING (50) %ARRAY locate(1:5)) loc
%EXTERNAL %ROUTINE %SPEC permit(%STRING (255) params)
%EXTERNAL %INTEGER %FUNCTION %SPEC dstop(%INTEGER i)
permit("ss#profile,.all,r") { permit ss#profile to everybody}
readprofile("FIND",loc,version,flag)
loc_terminal = -2
%IF length(s)>50 %THEN length(s) = 50 { Truncate gone msg if necessary}
loc_locate(1) = s
loc_locate(2) = date.time
writeprofile("FIND",loc,version,flag) { Store Gone message}
! print out message on the screen
printstring(uinfs(7)."(".uinfs(1).")"." went ".s." at ".time." on ".date)
newline
flag = dstop(100) { Exit stage left (Cleanly)}
%END
! end of routine GONE
! Start of routine REMOVENAME
%EXTERNAL %ROUTINE removename(%STRING (255) data)
%INTEGER check,i,j,version,flag
%RECORD (%INTEGER index, %STRING (6) %ARRAY usnos(1:25),
%STRING (31) %ARRAY usname(1:25)) rec
check=0
%IF length(data)=6 %START
readprofile("GWW",rec,version,flag) { Read in list of friends}
%IF rec_index<>0 %START
%FOR i = 1,1,rec_index %CYCLE
%IF rec_usnos(i)=data %START { search for appropriate user}
%FOR j = i+1,1,rec_index %CYCLE
{ Move all others users up one in list}
rec_usnos(j-1) = rec_usnos(j)
rec_usname(j-1) = rec_usname(j)
%REPEAT
rec_index = rec_index-1
check = 1
printstring("Number of names inserted =")
write(rec_index,3)
newline
writeprofile("GWW",rec,version,flag) { Write new list}
%EXIT
%FINISH
%REPEAT
! Say if user not in list
%IF check=0 %THEN printstring("User not found") %AND newline
%FINISH %ELSE printstring("No Names Inserted") %AND newline
%FINISH %ELSE printstring("Invalid Username") %AND newline
%END
! End of Routine REMOVENAME
! Start Of Routine HELPME
%EXTERNAL %ROUTINE helpme(%STRING (255) s)
%SYSTEM %ROUTINE %SPEC zview(%STRING (255) s)
zview(helpfile.",1") { Call up the help information file}
%END
%END %OF %FILE { End of everything}