!***********************************************************************
!*
!* Utility commands for administration of user numbers
!*
!* R.D. Eager University of Kent MCMLXXXV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger maxf = 200; ! Maximum number of files a user is expected to have
constantstring (1) snl = "
"
constantstring (1) null = "*"
constantstring (31) nullstring = ""
constantintegerarray zeros(0:2) = c
0(3)
constantintegerarray default passwords(0:1) = c
m'....',m'....'
constantstring (4) default password = "...."
!
constantstring (255) intromess = c
"
**** WARNING **** WARNING **** WARNING **** WARNING ****
You should now use the PASSWORD command to alter your FOREGROUND
password - to do this, type:
PASSWORD(F)
and follow the instructions. Your current password is ""....""
"
!
constantstring (10) cuname = "CREATEUSER"
constantstring (11) ccname = "CREATECLASS"
constantstring (10) deluname = "DELETEUSER"
constantstring (11) dcname = "DELETECLASS"
constantstring (17) cdname = "CHANGEUSERDETAILS"
constantstring (16) udname = "PRINTUSERDETAILS"
constantstring (10) daname = "DENYACCESS"
constantstring (11) aaname = "ALLOWACCESS"
constantstring (14) rpname = "RESETPASSWORDS"
!
constantinteger cukeymax = 8
constantstring (11)array cukeys(1:cukeymax) = c
"USER",
"SURNAME",
"DEPARTMENT",
"ADDRESS",
"TELEPHONE",
"DELIVERY",
"FSYS",
"INDEXSIZE"
!
constantinteger cckeymax = 2
constantstring (11)array cckeys(1:cckeymax) = c
"BASE",
"NUSERS"
!
constantinteger dukeymax = 2
constantstring (4)array dukeys(1:dukeymax) = c
"USER",
"ASK"
!
constantinteger dckeymax = 2
constantstring (6)array dckeys(1:dckeymax) = c
"BASE",
"NUSERS"
!
constantinteger cdkeymax = 11
constantstring (12)array cdkeys(1:cdkeymax) = c
"USER",
"SURNAME",
"DEPARTMENT",
"ADDRESS",
"TELEPHONE",
"DELIVERY",
"FILELIMIT",
"SESSIONLIMIT",
"RATION",
"IBT",
"FTP"
constantbyteintegerarray cdsfi(1:cdkeymax) = c
0,0,0,0,0,0,11,32,33,0,0
!
constantinteger pdkeymax = 1
constantstring (4)array pdkeys(1:pdkeymax) = c
"USER"
!
constantinteger dakeymax = 1
constantstring (4)array dakeys(1:dakeymax) = c
"USER"
!
constantinteger aakeymax = 1
constantstring (4)array aakeys(1:aakeymax) = c
"USER"
!
constantinteger rpkeymax = 1
constantstring (4)array rpkeys(1:rpkeymax) = c
"USER"
!
!
!***********************************************************************
!*
!* Record formats
!*
!***********************************************************************
!
recordformat ainff(string (11) name,integer nkb,string (8) date,
string (6) tape,integer chap,flags)
recordformat frf(integer conad,filetype,datastart,dataend,
size,rup,eep,mode,users,arch,string (6) tran,
string (8) date,time,integer count,spare1,spare2)
recordformat inff(string (11) name,integer sp12,kbytes,byteinteger c
arch,codes,cct,ownp,eep,use,codes2,ssbyte,flags,
sp29,sp30,sp31)
recordformat uf(string (6) user,holder,integer shares)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalintegerfunctionspec acreate2(string (6) user,tape,
string (8) fdate,
string (15) file,integer fsys,
nkb,chapter,type)
externalintegerfunctionspec dnewuser(string (6) user,integer fsys,nkb)
externalintegerfunctionspec ddeluser(string (6) user,integer fsys)
externalintegerfunctionspec dmessage2(string (6) user,
integername len,integer act,
invoc,fsys,adr)
externalintegerfunctionspec dsetpassword(string (6)user,integer fsys,
which,string (63) old,new)
externalintegerfunctionspec dsfi(string (6) user,integer fsys,
type,set,adr)
externalintegerfunctionspec dnew arch index(string (6) user,
integer fsys,nkb)
externalintegerfunctionspec dfilenames(string (6) user,
record (ainff)arrayname inf,
integername fileno,maxrec,
nfiles,integer fsys,type)
externalintegerfunctionspec dfsys(string (6) user,integername fsys)
externalroutinespec get av fsys(integername n,integerarrayname a)
externalstringfunctionspec derrs(integer n)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemintegermapspec comreg(integer i)
systemstringfunctionspec failuremessage(integer mess)
systemroutinespec finfo(string (31) file,integer mode,
record (frf)name fr,integername flag)
systemstringfunctionspec itos(integer n)
systemintegerfunctionspec pstoi(string (63) s)
externalroutinespec set return code(integer n)
externalstringfnspec uinfs(integer entry)
!
externalroutinespec prompt(string (255) s)
!
!
!***********************************************************************
!*
!* External references to other management utilities
!*
!***********************************************************************
!
dynamicintegerfunctionspec createregisterentries(c
record (uf)arrayname list,
integer nusers)
dynamicintegerfunctionspec deleteregisterentries(c
stringarrayname users,
integer nusers)
dynamicintegerfunctionspec unitspershare
!
!
!***********************************************************************
!*
!* Site-dependent constants and functions
!*
!***********************************************************************
!
constantinteger nfsys = 6; ! Number of file systems
constantinteger suffsize = 3; ! Number of digits at end of a user name
constantinteger default iprocs = 1
constantinteger default bprocs = 1
constantinteger default tprocs = 2
constantinteger dept length = 15; ! Length of 'department' field
constantinteger address length = 33; ! Length of 'address' field
constantinteger telephone length = 15; ! Length of 'telephone' field
constantinteger default file limit = 32768
! In kilobytes
constantinteger default session limit = 0
! In minutes
constantinteger default index size = 4
! In kilobytes
constantinteger default shares = 5000; ! In share units
constantinteger default ration = 0; ! Scarcity units
constantstring (6) valid classes = "RTULFG"
constantstring (6) classname = "Course";! Surname entry for CREATECLASS
constantstring (6) default group holder = ""
ownstring (18) dummy basefile = "MANAGR.SKELBASE"
!
integerfunction file limit(string (6) user)
integer c
!
result = default file limit if substring(user,1,3) = "CUR" or c
substring(user,1,3) = "RED" or c
substring(user,1,3) = "ADR" or c
substring(user,1,3) = "ERC"
!
c = charno(user,3); ! User type
!
result = 100 if c = 'T'
result = 100 if c = 'U'
result = 100 if c = 'L'
result = 500 if c = 'R'
result = 500 if c = 'F'
result = 500 if c = 'G'
!
result = default file limit; ! For all others
end ; ! of file limit
!
!-----------------------------------------------------------------------
!
integerfunction session limit(string (6) user)
integer c
!
c = charno(user,3); ! User type
!
result = 0
result = 20 if c = 'T'
result = 20 if c = 'U'
!
result = default session limit; ! For all others
end ; ! of session limit
!
!-----------------------------------------------------------------------
!
integerfunction index size(string (6) user)
integer c
!
c = charno(user,3); ! User type
!
result = 4 if c = 'R'
result = 4 if c = 'F'
result = 4 if c = 'G'
!
result = default index size; ! For all others
end ; ! of index size
!
!-----------------------------------------------------------------------
!
integerfunction derive fsys(stringname user)
integer res,i
!
res = 0
for i = 6-suffsize+1,1,6 cycle
res = res*10 + (charno(user,i) - '0')
repeat
result = res - ((res//nfsys) * nfsys)
end ; ! of derive fsys
!
!-----------------------------------------------------------------------
!
integerfunction derive privilege(stringname user)
integer res
!
res = x'1000'; ! Allow all users to alter basefile
if substring(user,1,3) = "CUR" or c
substring(user,1,3) = "RED" or c
substring(user,1,3) = "ADR" or c
substring(user,1,3) = "ERC" then start
res = res!x'8000'; ! Allow use of magnetic tape online
finish
if substring(user,1,3) = "CUR" or c
substring(user,1,3) = "ERC" then start
res = res!x'40'; ! Allow use of external FTP
finish
result = res
end ; ! of derive privilege
!
!-----------------------------------------------------------------------
!
stringfunction group holder(string (6) user)
result = default group holder
end ; ! of group holder
!
!-----------------------------------------------------------------------
!
externalintegerfunction derive shares(string (6) user)
integer c
!
result = default shares if substring(user,1,3) = "CUR"
result = default shares if substring(user,1,3) = "RED"
result = default shares if substring(user,1,3) = "ADR"
result = default shares if substring(user,1,3) = "ERC"
!
c = charno(user,3); ! User type
!
result = 10 if c = 'T'
result = 10 if c = 'U'
result = 10 if c = 'L'
result = 50 if c = 'R'
result = 50 if c = 'F'
result = 50 if c = 'G'
!
result = default shares; ! For all others
end ; ! of derive shares
!
!-----------------------------------------------------------------------
!
externalstringfunction derive group holder(string (6) user)
result = group holder(user)
end ; ! of derive group holder
!
!-----------------------------------------------------------------------
!
integerfunction ration(string (6) user)
integer shares,ups
!
shares = derive shares(user)
ups = unitspershare
if ups <= 0 then ups = 1
result = shares*ups
end ; ! of ration
!
!-----------------------------------------------------------------------
!
integerfunction site validate user(stringname user)
string (1) s
string (11) wk
!
result = yes if substring(user,1,3) = "RED"
! Special case
s = substring(user,3,3)
if valid classes -> wk.(s) then result = yes
result = no
end ; ! of site validate user
!
!
!***********************************************************************
!*
!* Common routines
!*
!***********************************************************************
!
integerfunction matchstrings(stringname a,string (255) b)
integer l
!
l = length(a)
if length(b) < l then result = 0
length(b) = l
if a = b then result = 1 else result = 0
end ; ! of matchstrings
!
!-----------------------------------------------------------------------
!
integerfunction paramdecode(string (255) param,integer pmax,
stringarrayname keys,pars)
integer i,pnum,pn,res,c,parptr,parleng
string (255) wksp
!
integerfunction findkey
integer f,i
!
if length(wksp) = 0 then result = -2; ! Missing keyword
f = 0
for i = 1,1,pmax cycle
if matchstrings(wksp,keys(i)) = 1 then start
unless f = 0 then result = -1
f = i
finish
repeat
result = f
end ; ! of findkey
!
!-----------------------------------------------------------------------
!
integerfunction getpar
integer c,inpr
!
inpr = 0
wksp = ""
!
cycle
parptr = parptr + 1
if parptr > parleng then result = -1
c = charno(param,parptr)
if c = ',' or c = '=' then result = c
wksp = wksp.tostring(c)
repeat
end ; ! of getpar
!
!-----------------------------------------------------------------------
!
for i = 1,1,pmax cycle
pars(i) = ""; ! Initialise
repeat
parptr = 0
pnum = 1
parleng = length(param)
!
cycle
c = getpar
res = 0
if c # '=' then start
pn = pnum
else
pn = findkey
if pn = 0 then res = 322; ! Unknown keyword
if pn = -1 then res = 321; ! Ambiguous keyword
if pn = -2 then res = 325; ! Missing keyword
c = getpar
if c = '=' then res = 320; ! Format error
finish
if pn > pmax then res = 323; ! Too many parameters
if res = 0 then start
if wksp # "" # pars(pn) then res = 324
! Duplicated parameter
pars(pn) = wksp
finish
if res # 0 then result = res
if c = -1 then result = 0; ! Finished, all OK
pnum = pnum + 1
repeat
end ; ! of paramdecode
!
!-----------------------------------------------------------------------
!
routine fail(string (127) mes,string (31) op)
!
selectoutput(0)
printstring(snl.op." fails - ".mes)
set return code(1000)
stop
end ; ! of fail
!
!-----------------------------------------------------------------------
!
routine zderrs(string (30) info,integer n,string (31) op)
!
if n = 0 then return
fail(info." Flag = ".derrs(n).snl,op) if op # ""
end ; ! of zderrs
!
!-----------------------------------------------------------------------
!
integerfunction alpha(integer c)
!
unless 'A' <= c <= 'Z' then result = 0
result = 1
end ; ! of alpha
!
!-----------------------------------------------------------------------
!
integerfunction numeric(integer c)
!
unless '0' <= c <= '9' then result = 0
result = 1
end ; ! of numeric
!
!-----------------------------------------------------------------------
!
stringfunction getsuffix(integer n)
string (6) s
!
s = itos(n)
s = "0".s while length(s) < suffsize
result = s
end ; ! of getsuffix
!
!-----------------------------------------------------------------------
!
routine validate user(stringname user,string (31) op)
integer i
!
return if comreg(26) = -1; ! Trusted user
!
unless length(user) = 6 then start
fail("User number not 6 characters".snl,op)
finish
for i = 1,1,6-suffsize cycle
unless alpha(charno(user,i))=1 then start
fail("First ".itos(6-suffsize)." characters of user number".c
" are not alphabetic".snl,op)
finish
repeat
for i = 6-suffsize+1,1,6 cycle
unless numeric(charno(user,i))=1 then start
fail("Last ".itos(suffsize)." characters of user number".c
" are not numeric".snl,op)
finish
repeat
i = site validate user(user)
if i = no then fail("Invalid user class".snl,op)
end ; ! of validate user
!
!-----------------------------------------------------------------------
!
routine validate fsys(integer fsys,string (31) op)
integer i,ndiscs
integerarray a(0:99)
!
unless 0 <= fsys <= 99 then fail("Illegal fsys number",op)
get av fsys(ndiscs,a)
for i = 0,1,ndiscs-1 cycle
return if a(i) = fsys
repeat
fail("File system ".itos(fsys)." not on line",op)
end ; ! of validate fsys
!
!-----------------------------------------------------------------------
!
routine validate isize(integer isize,string (31) op)
return if isize = 2
if 4 <= isize <= 32 then start
return if (isize//4)*4 = isize
finish
fail("Illegal index size",op)
end ; ! of validate isize
!
!-----------------------------------------------------------------------
!
integerfunction find fsys(stringname user,string (31) op)
integer flag,fsys
!
fsys = -1
flag = dfsys(user,fsys)
if flag = 37 then start ; ! Common fault - no such user
fail("User ".user." does not exist".snl,op)
finish
if flag # 0 then start
fail("DFSYS flag = ".derrs(flag).snl,op)
finish
result = fsys
end ; ! of find fsys
!
!-----------------------------------------------------------------------
!
routine checkprocess(string (6) user,integer fsys,string (31) op)
integer flag
integerarray a(0:1)
!
flag = dsfi(user,fsys,14,1,addr(zeros(0)))
! Set concurrency limits to zero
zderrs("DSFI(RESETCONC)",flag,op)
flag = dsfi(user,fsys,13,0,addr(a(0))); ! Read current process usage
zderrs("DSFI(PROCUSE)",flag,op)
if a(0)!a(1) # 0 then fail("User ".user." has a currently running process",
op)
end ; ! of checkprocess
!
!-----------------------------------------------------------------------
!
routine validate ration(integer n,string (31) op)
if n < 0 then start
fail("Illegal ration value".snl,op)
finish
end ; ! of validate ration
!
!-----------------------------------------------------------------------
!
routine pad(stringname s,integer len)
if length(s) >= len then length(s) = len and return
cycle
s = s." "
exit if length(s) = len
repeat
end ; ! of pad
!
!-----------------------------------------------------------------------
!
routine trim(stringname s)
cycle
return if s = ""
if charno(s,length(s)) = ' ' then start
length(s) = length(s) - 1
finish else exit
repeat
end ; ! of trim
!
!-----------------------------------------------------------------------
!
routine item(string (30) title,string (63) info)
trim(info)
return if info = ""
printstring(title.":")
spaces(25-length(title))
printstring(info.snl)
end ; ! of item
!
!-----------------------------------------------------------------------
!
routine fix name(stringname s)
integer i,l,ch,allupper
string (31) wk,wk2,rest
!
allupper = yes
for i = 1,1,length(s) cycle
if 'a' <= charno(s,i) <= 'z' then start
allupper = no
exit
finish
repeat
return unless allupper = yes; ! Work done by Admin server
!
s = s.wk while s -> s.(" ").wk
!
! Remove any spurious prefix
!
if s -> wk.("MR.").rest and wk = "" then s = rest
if s -> wk.("MISS.").rest and wk = "" then s = rest
if s -> wk.("MS.").rest and wk = "" then s = rest
if s -> wk.("MRS.").rest and wk = "" then s = rest
if s -> wk.("DR.").rest and wk = "" then s = rest
if s -> wk.("PROF.").rest and wk = "" then s = rest
return if s = ""
!
! Separate out the surname part
!
l = length(s)
if charno(s,l) = '.' then start
l = l - 1
length(s) = l; ! Remove any fullstop at end
finish
i = l - 1
while i > 0 cycle
if charno(s,i) = '.' then start
i = i + 1
exit
finish
i = i - 1
repeat
if i = 0 then i = 1
wk = substring(s,i,l)
l = length(wk)
if i > 1 then s = substring(s,1,i - 1) else s = ""
! Isolate any initials
if length(s) > 6 then start
length(s) = 6
while length(s) > 0 and charno(s,length(s)) # '.' cycle
length(s) = length(s) - 1
repeat
finish
!
! Put the surname (except first character) into lower case
!
i = 1
while i < l cycle
i = i + 1
ch = charno(wk,i)
if alpha(ch) = 1 then start
charno(wk,i) = ch ! x'20'
finish
repeat
!
! Handle special cases
!
if wk -> wk2.("Mc").rest and wk2 = "" then charno(wk,3) = charno(wk,3) & (¬x'20')
if wk -> wk2.("Mac").rest and wk2 = "" then charno(wk,4) = charno(wk,4) & (¬x'20')
if wk -> wk2.("O'").rest and wk2 = "" then charno(wk,3) = charno(wk,3) & (¬x'20')
if wk -> wk2.("L'").rest and wk2 = "" then charno(wk,3) = charno(wk,3) & (¬x'20')
if wk -> wk2.("D'").rest and wk2 = "" then charno(wk,3) = charno(wk,3) & (¬x'20')
i = 0
while i < l cycle
i = i + 1
if charno(wk,i) = '-' and i < l then start
i = i + 1
charno(wk,i) = charno(wk,i) & (¬x'20')
finish
repeat
s = s.wk; ! Put it all back together
end ; ! of fix name
!
!-----------------------------------------------------------------------
!
routine set relative(string (6) user,integer fsys,integername value,
integer item,lowlim,hilim,stringname s)
integer flag,oldval,sign
!
if charno(s,1) = '+' then sign = +1 else sign = -1
if length(s) = 1 then start
value = -1; ! Force error
return
finish
s = substring(s,2,length(s))
value = pstoi(s)
return if value < 0
value = value*sign
!
flag = dsfi(user,fsys,cdsfi(item),0,addr(oldval))
zderrs("DSFI(".cdkeys(item).")",flag,cdname)
value = value + oldval
if value < lowlim then start
value = lowlim
printstring("Warning - ".cdkeys(item)." adjustment limited at ".c
itos(value).snl)
finish
if value > hilim then start
value = hilim
printstring("Warning - ".cdkeys(item)." adjustment limited at ".c
itos(value).snl)
finish
end ; ! of set relative
!
!-----------------------------------------------------------------------
!
string (6)function create(string (255) s)
stringname user,surname,fs,delivery,dept,address,telephone,is
integer i,fsys,l,isize,newration
integerarray ibt table(0:2)
string (63) addrtele
string (255)array options(1:cukeymax)
!
set return code(1000)
i = paramdecode(s,cukeymax,cukeys,options)
if i # 0 then fail(failuremessage(i),cuname)
user == options(1)
surname == options(2)
dept == options(3)
address == options(4)
telephone == options(5)
delivery == options(6)
fs == options(7)
is == options(8)
!
for i = 1,1,2 cycle
if options(i) = "" then start
fail("Mandatory parameter ".cukeys(i)." omitted".snl,cuname)
finish
repeat
!
validate user(user,cuname)
!
! Check that user does not already exist on another fsys
!
fsys = -1
i = dfsys(user,fsys)
if i = 0 then start
fail("User """.user.""" already exists, on fsys ".itos(fsys).c
snl,cuname)
finish
unless i = 37 then start
fail("DFSYS flag = ".derrs(i).snl,cuname)
finish
!
if length(surname) > 31 then length(surname) = 31
fix name(surname)
pad(dept,dept length)
pad(address,address length)
pad(telephone,telephone length)
addrtele = dept.address.telephone
trim(addrtele); ! Save space in SFI pool
if delivery = "" then start
delivery = user." ".user." ".user." ".user
finish
if length(delivery) > 31 then length(delivery) = 31
fsys = derive fsys(user)
if fs # "" then fsys = pstoi(fs)
validate fsys(fsys,cuname)
isize = index size(user)
if is # "" then isize = pstoi(is)
validate isize(isize,cuname)
newration = ration(user)
ibt table(0) = default iprocs
ibt table(1) = default bprocs
ibt table(2) = default tprocs
!
i = dnewuser(user,fsys,isize)
zderrs("DNEWUSER",i,cuname)
!
i = dsfi(user,fsys,14,1,addr(ibt table(0)))
zderrs("DSFI(IBT)",i,cuname)
!
l = file limit(user)
i = dsfi(user,fsys,11,1,addr(l))
zderrs("DSFI(FILE LIMIT)",i,cuname)
!
l = session limit(user); ! Allow for inaccuracies in Director
l = l + 3 if l >= 2
i = dsfi(user,fsys,32,1,addr(l))
zderrs("DSFI(SESSION LIMIT)",i,cuname)
!
i = dsfi(user,fsys,18,1,addr(surname))
zderrs("DSFI(SURNAME)",i,cuname)
!
i = dsfi(user,fsys,1,1,addr(delivery))
zderrs("DSFI(DELIVERY)",i,cuname)
!
i = dsfi(user,fsys,3,1,addr(addrtele))
zderrs("DSFI(ADDRTELE)",i,cuname)
!
newration = newration*100; ! Director needs hundredths of units
i = dsfi(user,fsys,33,1,addr(newration))
zderrs("DSFI(RATION)",i,cuname)
!
l = derive privilege(user)
if l # 0 then start
i = dsfi(user,fsys,38,1,addr(l))
zderrs("DSFI(PRIVILEGE)",i,cuname)
finish
!
i = dnew arch index(user,fsys,4)
zderrs("DNEW ARCH INDEX",i,cuname)
!
l = length(intromess)
i = dmessage2(user,l,1,0,fsys,addr(intromess)+1)
i = 0 if i = 61
zderrs("DMESSAGE2",i,cuname)
!
printstring("+++ User """.user.""" created OK +++"); newline
set return code(0)
result = user
end ; ! of create
!
!-----------------------------------------------------------------------
!
string (6)function delete(string (255) s)
stringname user,asks
integer i,fsys,filenum,nfiles,maxrec,asking
stringname ss
record (inff)array inf(0:maxf)
record (ainff)array ainf(0:0)
string (255) work
string (255)array options(1:dukeymax)
!
set return code(1000)
i = paramdecode(s,dukeymax,dukeys,options)
if i # 0 then fail(failuremessage(i),deluname)
user == options(1)
asks == options(2)
!
if options(1) = "" then start
fail("Mandatory parameter ".dukeys(1)." omitted".snl,deluname)
finish
!
asks = "YES" if asks = ""
if asks = "YES" then asking = yes else c
if asks = "NO" then asking = no else start
fail("Invalid value for ".dukeys(2)." parameter".snl,deluname)
finish
!
validate user(user,deluname)
fsys = find fsys(user,deluname)
checkprocess(user,fsys,deluname)
printstring("+++ User ".user." +++".snl)
maxrec = maxf
filenum = 0
i = dfilenames(user,inf,filenum,maxrec,nfiles,fsys,0)
zderrs("DFILENAMES",i,deluname)
if nfiles > maxf then work = "Over ".itos(maxf) else start
filenum = 0
for i = 0,1,nfiles - 1 cycle
ss == inf(i)_name
continue if ss = "#MSG"
continue if ss = "#ARCH"
continue if ss = "SS#DIR"
continue if ss = "SS#OPT"
continue if ss = "SS#JOURNAL"
continue if ss = "M#INBOX"
if length(ss) > 1 then start
continue if substring(ss,1,2) = "T#"
finish
filenum = filenum + 1; ! Increase count of real files
repeat
work = itos(filenum)
finish
item("Number of user files on disc",work)
maxrec = 1
filenum = 0
i = dfilenames(user,ainf,filenum,maxrec,nfiles,fsys,1)
! Necessary due to bug in DSFI 31
zderrs("DFILENAMES",i,"")
item("Number of files on archive",itos(nfiles)) if i = 0
if asking = yes then start
printstring("Delete user """.user.""" on file system ".itos(fsys).";")
newline
prompt("Are you sure? ")
work = ""
while nextsymbol # nl cycle
work <- work.nextitem
skipsymbol
repeat
skipsymbol
work <- work."N"; ! In case of blank line
if 'y' # charno(work,1) # 'Y' then result = ""
finish
!
! Disconnect currently connected #ARCH file (if any)
!
i = acreate2("","","","",0,0,0,0)
!
! Delete the user
!
i = ddeluser(user,fsys)
zderrs("DDELUSER",i,deluname)
printstring("+++ User """.user.""" deleted OK +++".snl)
set return code(0)
result = user
end ; ! of delete
!
!
!***********************************************************************
!*
!* C R E A T E U S E R
!*
!***********************************************************************
!
externalroutine createuser(string (255) s)
integer flag
record (uf)array ctab(1:1)
!
ctab(1)_user = create(s)
ctab(1)_holder = ""
ctab(1)_shares = derive shares(ctab(1)_user)
flag = createregisterentries(ctab,1)
if flag # 0 then start
printstring("Warning - User """.ctab(1)_user.c
""" not added to share register".snl)
printstring("(Flag = ".itos(flag).")".snl)
finish
end ; ! of createuser
!
!-----------------------------------------------------------------------
!
externalroutine cu(string (255) s)
createuser(s)
end ; ! of cu
!
!
!***********************************************************************
!*
!* C R E A T E C L A S S
!*
!***********************************************************************
!
externalroutine createclass(string (255) s)
stringname base,nusers
integer i,n,ibase,max,newration
string (6) prefix,suffix,user
string (255)array options(1:cckeymax)
!
set return code(1000)
i = paramdecode(s,cckeymax,cckeys,options)
if i # 0 then fail(failuremessage(i),ccname)
base == options(1)
nusers == options(2)
!
for i = 1,1,2 cycle
if options(i) = "" then start
fail("Mandatory parameter ".cckeys(i)." omitted".snl,ccname)
finish
repeat
!
max = 10****suffsize - 1
validate user(base,ccname)
prefix = substring(base,1,6-suffsize)
n = pstoi(nusers)
if n <= 0 then start
fail("Illegal value for ".cckeys(2)." parameter".snl,ccname)
finish
ibase = pstoi(substring(base,6-suffsize+1,6))
unless 0 <= ibase <= max then start
fail("Illegal suffix for base user number".snl,ccname)
finish
if ibase + n > max + 1 then start
fail("User suffix would overflow from ".itos(max).snl,ccname)
finish
!
newration = ration(base)
!
for i = ibase,1,ibase + n - 1 cycle
suffix = getsuffix(i)
user = create(prefix.suffix.",".classname)
repeat
!
begin
record (uf)array ctab(1:n)
for i = 1,1,n cycle
suffix = getsuffix(ibase+i-1)
user = prefix.suffix
ctab(i)_user = user
ctab(i)_holder = ""
ctab(i)_shares = derive shares(user)
repeat
i = createregisterentries(ctab,n)
if i # 0 then start
printstring("Warning - user(s) not added to share register".snl)
printstring("(Flag = ".itos(i).")".snl)
finish
end
set return code(0)
end ; ! of createclass
!
!-----------------------------------------------------------------------
!
externalroutine crc(string (255) s)
createclass(s)
end ; ! of crc
!
!
!***********************************************************************
!*
!* D E L E T E U S E R
!*
!***********************************************************************
!
externalroutine deleteuser(string (255) s)
integer flag
string (6)array user(1:1)
!
user(1) = delete(s)
return if user(1) = ""
flag = deleteregisterentries(user,1)
if flag # 0 then start
printstring("Warning - User """.user(1).c
""" was not in share register".snl)
finish
end ; ! of deleteuser
!
!
!***********************************************************************
!*
!* D E L E T E C L A S S
!*
!***********************************************************************
!
externalroutine deleteclass(string (255) s)
stringname base,nusers
integer i,j,n,ibase,max
string (6) prefix,suffix,user
string (255)array options(1:dckeymax)
!
set return code(1000)
i = paramdecode(s,dckeymax,dckeys,options)
if i # 0 then fail(failuremessage(i),dcname)
base == options(1)
nusers == options(2)
!
for i = 1,1,2 cycle
if options(i) = "" then start
fail("Mandatory parameter ".dckeys(i)." omitted".snl,dcname)
finish
repeat
!
max = 10****suffsize - 1
validate user(base,dcname)
prefix = substring(base,1,6-suffsize)
n = pstoi(nusers)
if n <= 0 then start
fail("Illegal value for ".dckeys(2)." parameter".snl,dcname)
finish
ibase = pstoi(substring(base,6-suffsize+1,6))
unless 0 <= ibase <= max then start
fail("Illegal suffix for base user number".snl,dcname)
finish
if ibase + n > max + 1 then start
fail("User suffix would overflow from ".itos(max).snl,dcname)
finish
!
! Disconnect currently connected #ARCH file (if any)
!
i = acreate2("","","","",0,0,0,0)
!
for i = ibase,1,ibase + n - 1 cycle
suffix = getsuffix(i)
user = prefix.suffix
checkprocess(user,-1,dcname)
j = ddeluser(user,-1)
zderrs("DDELUSER on """.prefix.suffix."""",j,dcname)
printstring("+++ User """.prefix.suffix.""" deleted OK +++".snl)
repeat
!
begin
string (6)array users(1:n)
for i = 1,1,n cycle
suffix = getsuffix(ibase+i-1)
users(i) = prefix.suffix
repeat
i = deleteregisterentries(users,n)
if i < 0 then start
printstring("Warning - ".itos(-i)." users were not in share".c
" register".snl)
finish
end
set return code(0)
end ; ! of delete class
!
!
!***********************************************************************
!*
!* C H A N G E U S E R D E T A I L S
!*
!***********************************************************************
!
externalroutine changeuserdetails(string (255) s)
stringname user,surname,dept,address,telephone,delivery,filelimit
stringname session limit,rs,ibt,ftps
integer i,fsys,fl,sl,ration,ibtset,ftpset,ftp,oldpriv
integerarray ibt table(0:2)
string (63) addrtele
string (255)array options(1:cdkeymax)
!
set return code(1000)
i = paramdecode(s,cdkeymax,cdkeys,options)
if i # 0 then fail(failuremessage(i),cdname)
user == options(1)
surname == options(2)
dept == options(3)
address == options(4)
telephone == options(5)
delivery == options(6)
filelimit == options(7)
session limit == options(8)
rs == options(9)
ibt == options(10)
ftps == options(11)
!
if user = "" then start
fail("Mandatory parameter ".cdkeys(1)." omitted".snl,cdname)
finish
!
validate user(user,cdname)
fsys = find fsys(user,cdname)
!
if filelimit # "" then start
if filelimit = null then start
fl = default file limit
else
fl = pstoi(filelimit)
unless '+' # charno(filelimit,1) # '-' then start
set relative(user,fsys,fl,7,50,32768,filelimit)
finish
finish
unless 50 <= fl <= 32768 then start
fail("Illegal value for ".cdkeys(7)." parameter".snl,cdname)
finish
finish else fl = 0
!
if session limit # "" then start
if session limit = null then start
sl = default session limit
else
sl = pstoi(session limit)
unless '+' # charno(session limit,1) # '-' then start
set relative(user,fsys,sl,8,0,360,session limit)
finish
finish
if sl < 0 then start
fail("Illegal value for ".cdkeys(8)." parameter".snl,cdname)
finish
finish else sl = -1
!
if rs # "" then start
if rs = null then start
ration = default ration
else
ration = pstoi(rs)
unless '+' # charno(rs,1) # '-' then start
set relative(user,fsys,ration,9,0,1000000,rs)
finish
finish
validate ration(ration,cdname)
finish else ration = -1
!
if ibt # "" then start
if ibt = null then start
ibt table(0) = default iprocs
ibt table(1) = default bprocs
ibt table(2) = default tprocs
else
if length(ibt) = 5 and charno(ibt,2) = '.' and c
charno(ibt,4) = '.' and numeric(charno(ibt,1)) = 1 and c
numeric(charno(ibt,3)) = 1 and c
numeric(charno(ibt,5)) = 1 then start
ibt table(0) = charno(ibt,1) - '0'
ibt table(1) = charno(ibt,3) - '0'
ibt table(2) = charno(ibt,5) - '0'
else
fail("Invalid value for ".cdkeys(10)." parameter".snl,cdname)
finish
finish
ibtset = yes
finish else ibtset = no
!
if ftps # "" then start
if matchstrings(ftps,"YES") = yes then ftp = yes else c
if matchstrings(ftps,"NO") = yes then ftp = no else start
fail("Invalid value for ".cdkeys(11)." parameter".snl,cdname)
finish
ftpset = yes
finish else ftpset = no
!
if surname # "" then start
if length(surname) > 31 then length(surname) = 31
surname = "" if surname = null
fix name(surname)
i = dsfi(user,fsys,18,1,addr(surname))
zderrs("DSFI(SURNAME)",i,cdname)
finish
!
if dept # "" or address # "" or telephone # "" then start
dept = " " if dept = null
pad(dept,dept length) unless dept = ""
address = " " if address = null
pad(address,address length) unless address = ""
telephone = " " if telephone = null
pad(telephone,telephone length) unless telephone = ""
i = dsfi(user,fsys,3,0,addr(addrtele))
zderrs("DSFI(ADDRTELE)GET",i,cdname)
pad(addrtele,63)
if dept # "" then start
addrtele = dept.substring(addrtele,dept length+1,63)
finish
if address # "" then start
addrtele = substring(addrtele,1,dept length).address.c
substring(addrtele,dept length+address length+1,63)
finish
if telephone # "" then start
addrtele = substring(addrtele,1,dept length+address length).c
telephone
finish
trim(addrtele); ! Save space in SFI pool
i = dsfi(user,fsys,3,1,addr(addrtele))
zderrs("DSFI(ADDRTELE)SET",i,cdname)
finish
!
if delivery # "" then start
if length(delivery) > 31 then length(delivery) = 31
delivery = "" if delivery = null
i = dsfi(user,fsys,1,1,addr(delivery))
zderrs("DSFI(DELIVERY)",i,cdname)
finish
!
if fl > 0 then start
i = dsfi(user,fsys,11,1,addr(fl))
zderrs("DSFI(FILE LIMIT)",i,cdname)
finish
!
if sl >= 0 then start
sl = sl + 3 if sl >= 2; ! Allow for inaccuracies in Director
i = dsfi(user,fsys,32,1,addr(sl))
zderrs("DSFI(SESSION LIMIT)",i,cdname)
finish
!
if ration >= 0 then start
ration = ration*100; ! Director needs hundredths of units
i = dsfi(user,fsys,33,1,addr(ration))
zderrs("DSFI(RATION)",i,cdname)
finish
!
if ibtset = yes then start
i = dsfi(user,fsys,14,1,addr(ibt table(0)))
zderrs("DSFI(IBT)",i,cdname)
finish
!
if ftpset = yes then start
i = dsfi(user,fsys,38,0,addr(oldpriv))
! Get existing privileges
zderrs("DSFI(PRIV) (GET)",i,cdname)
if ftp = yes then oldpriv = oldpriv!x'40' else start
oldpriv = oldpriv & (¬x'40'); ! Alter FTP privilege
finish
i = dsfi(user,fsys,38,1,addr(oldpriv))
! Set new privileges
zderrs("DSFI(PRIV) (SET)",i,cdname)
finish
!
set return code(0)
end ; ! of changeuserdetails
!
!-----------------------------------------------------------------------
!
externalroutine cud(string (255) s)
changeuserdetails(s)
end ; ! of cud
!
!
!***********************************************************************
!*
!* P R I N T U S E R D E T A I L S
!*
!***********************************************************************
!
externalroutine printuserdetails(string (255) s)
stringname user
integer i,fsys,j
string (63) work
integerarray p(0:11)
string (255)array options(1:pdkeymax)
!
set return code(1000)
i = paramdecode(s,pdkeymax,pdkeys,options)
if i # 0 then fail(failuremessage(i),udname)
user == options(1)
!
if options(1) = "" then start
fail("Mandatory parameter ".pdkeys(1)." omitted".snl,udname)
finish
!
validate user(user,udname)
fsys = find fsys(user,udname)
!
printstring(snl."+++ User """.user.""" +++".snl.snl)
i = dsfi(user,fsys,18,0,addr(work))
if i = 0 then item("Name",work)
item("File system",itos(fsys))
i = dsfi(user,fsys,4,0,addr(p(0)))
if i = 0 then item("Index size",itos(p(3))."Kb")
i = dsfi(user,fsys,3,0,addr(work))
if i = 0 then start
if work # "" then start
work = work." " while length(work) < 63
item("Department",substring(work,1,dept length))
item("Address",substring(work,dept length+1,dept length+c
address length))
item("Telephone number",substring(work,dept length+c
address length+1,63))
finish
finish
i = dsfi(user,fsys,1,0,addr(work))
if i = 0 then item("Delivery",work)
i = dsfi(user,fsys,6,0,addr(p(0)))
if i = 0 then start
j = p(0)
work = itos((j >> 17) & x'1F')."/".itos((j >> 22) & x'F')
work = work."/".itos(1970+(j >> 26))." "
work = work.itos((j >> 12) & x'1F').".".itos((j >> 6) & x'3F')
work = work.".".itos(j & x'3F')
item("Last logged on",work)
finish
i = dsfi(user,fsys,11,0,addr(j))
if i = 0 then item("Total file limit",itos(j)."Kb")
i = dsfi(user,fsys,30,0,addr(p(0)))
if i = 0 then item("Current file usage",itos(p(1)-p(5))."Kb")
i = dsfi(user,fsys,14,0,addr(p(0)))
if i = 0 then start
item("Max interactive procs",itos(p(0)))
item("Max batch procs",itos(p(1)))
item("Max total procs",itos(p(2)))
finish
i = dsfi(user,fsys,32,0,addr(j))
if i = 0 then start
unless j = 0 then item("Max session length",itos(j-3)." mins")
finish
i = dsfi(user,fsys,37,0,addr(p(0)))
if i = 0 then start
unless p(0) = 0 then item("Group holder",string(addr(p(0))))
finish
i = dsfi(user,fsys,33,0,addr(j))
if i = 0 then start
j = j//100; ! Director stores hundredths of units
unless j = 0 then item("Scarcity ration",itos(j)." units left")
finish
!
i = dsfi(user,fsys,0,0,addr(work))
if i = 0 then start
if work = dummy basefile then work = "Yes" else work = "No"
item("Access denied",work)
finish
!
i = dsfi(user,fsys,38,0,addr(j))
if i = 0 then start
if j & x'40' # 0 then work = "Yes" else work = "No"
item("External FTP",work)
finish
set return code(0)
end ; ! of printuserdetails
!
!-----------------------------------------------------------------------
!
externalroutine pud(string (255) s)
printuserdetails(s)
end ; ! of pud
!
!
!***********************************************************************
!*
!* D E N Y A C C E S S
!*
!***********************************************************************
!
externalroutine deny access(string (255) s)
stringname user
integer fsys,flag
record (frf)fr
string (255)array options(1:dakeymax)
!
set return code(1000)
flag = paramdecode(s,dakeymax,dakeys,options)
if flag # 0 then fail(failuremessage(flag),daname)
user == options(1)
!
if options(1) = "" then start
fail("Mandatory parameter ".dakeys(1)." omitted".snl,daname)
finish
!
validate user(user,daname)
fsys = find fsys(user,daname)
!
finfo(dummy basefile,0,fr,flag)
if flag # 0 then start
fail(failuremessage(flag),daname)
finish
if substring(dummy basefile,1,6) # uinfs(1) then fr_eep = fr_rup
unless (fr_rup & 5) = 5 & (fr_eep & 5) = 5 then start
fail("Essential file ".dummy basefile." not accessible".snl,daname)
finish
!
flag = dsfi(user,fsys,0,1,addr(dummy basefile))
zderrs("DSFI(BASEFILE)",flag,daname)
!
flag = dsfi(user,fsys,36,1,addr(dummy basefile))
zderrs("DSFI(BATCH BASEFILE)",flag,daname)
printstring("+++ User ".user." denied access +++".snl)
set return code(0)
end ; ! of deny access
!
!-----------------------------------------------------------------------
!
externalroutine dna(string (255) s)
deny access(s)
end ; ! of dna
!
!
!***********************************************************************
!*
!* A L L O W A C C E S S
!*
!***********************************************************************
!
externalroutine allow access(string (255) s)
stringname user
integer fsys,flag
string (255)array options(1:aakeymax)
!
set return code(1000)
flag = paramdecode(s,aakeymax,aakeys,options)
if flag # 0 then fail(failuremessage(flag),aaname)
user == options(1)
!
if options(1) = "" then start
fail("Mandatory parameter ".aakeys(1)." omitted".snl,aaname)
finish
!
validate user(user,aaname)
fsys = find fsys(user,aaname)
!
flag = dsfi(user,fsys,0,1,addr(null string))
zderrs("DSFI(BASEFILE)",flag,aaname)
!
flag = dsfi(user,fsys,36,1,addr(null string))
zderrs("DSFI(BATCH BASEFILE)",flag,aaname)
printstring("+++ User ".user." allowed access +++".snl)
set return code(0)
end ; ! of allow access
!
!-----------------------------------------------------------------------
!
externalroutine ala(string (255) s)
allow access(s)
end ; ! of ala
!
!
!***********************************************************************
!*
!* R E S E T P A S S W O R D
!*
!***********************************************************************
!
externalroutine resetpasswords(string (255) s)
stringname user
integer fsys,flag
string (255)array options(1:rpkeymax)
!
set return code(1000)
flag = paramdecode(s,rpkeymax,rpkeys,options)
if flag # 0 then fail(failuremessage(flag),rpname)
user == options(1)
!
if options(1) = "" then start
fail("Mandatory parameter ".rpkeys(1)." omitted".snl,rpname)
finish
!
validate user(user,rpname)
fsys = find fsys(user,rpname)
!
flag = dsfi(user,fsys,5,1,addr(default passwords(0)))
zderrs("DSFI(PASSWORDS)",flag,rpname)
!
flag = dsetpassword(user,fsys,0,default password,default password)
zderrs("DSETPASSWORD(F)",flag,rpname)
flag = dsetpassword(user,fsys,1,default password,default password)
zderrs("DSETPASSWORD(B)",flag,rpname)
!
printstring("+++ Passwords reset to '....' for user ".user." +++".snl)
set return code(0)
end ; ! of resetpasswords
!
!-----------------------------------------------------------------------
!
externalroutine rpw(string (255) s)
reset passwords(s)
end ; ! of rpw
endoffile