!***********************************************************************
!*
!* Commands for user resource control
!*
!* R.D. Eager University of Kent MCMLXXXII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger open = 0,create = 1,delete = 2,close = 3
constantinteger maxact = 3
constantinteger no = 0, yes = 1, full = 2
constantinteger sscharfiletype = 3
constantinteger maxusers = 4000; ! Maximum number of users
constantinteger maxmasks = 10; ! Max number of masks in an enquiry
constantinteger maxspecialusers = 24; ! Number of special usernames
constantinteger specialusershares = 100000
! Share allocation for special users
constantinteger hdsize = 32; ! Size of a file header
constantinteger rhdsize = 40; ! Size of share register header
constantinteger entrysize = 32; ! Size of a share register entry
constantinteger suffsize = 3; ! Number of digits in a username suffix
constantstring (1) snl = "
"
constantstring (6) empty = ".EMPTY"
constantstring (16) register = "ACCNTS.SREGISTER"; ! Name of share register
constantstring (10) tempregister = "T#REGISTER"; ! Name of temporary copy
constantstring (6)array specialusers(1:maxspecialusers) = c
"JOBR00","JOURNL","MANAGR","SPOOLR","VOLUMS","ENGINR","JOBR01",
"UTILTY","JOBR02","ERCLIB","ACCNTS","CONLIB","EXPORT","PLULIB",
"PUBLIC","PUBSRC","PUBTXT","SUBSYS","UKCLIB","UKCSRC","DAEMON",
"BCPLIB","MANAG1","MAILER"
!
constantstring (11) nrname = "NEWREGISTER"
constantstring (12) lrname = "LISTREGISTER"
constantstring (14) mrname = "MODIFYREGISTER"
constantstring (15) dfname = "DISTRIBUTEFUNDS"
constantstring (14) vrname = "VERIFYREGISTER"
constantstring (10) lsname = "LISTSHARES"
!
!
!***********************************************************************
!*
!* Record formats
!*
!***********************************************************************
!
recordformat hf(integer dataend,datastart,filesize,filetype,
sum,datetime,format,records)
recordformat mf(string (6) user,integer fsys)
recordformat regf(integer holes,users,shares,unitspershare,
string (8) update,uptime,readdate,readtime)
recordformat rf(integer conad,filetype,datastart,dataend)
recordformat sf(string (6) user,holder,lastholder,
byteinteger sp0,sp1,sp2,integer shares,lastreading)
recordformat uf(string (6) user,holder,integer shares)
recordformat usf(string (6) name,byteinteger nkb,integer in)
!
ownrecord (sf)arrayformat saf(1:maxusers)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalintegerfnspec dsfi(string (6) user,integer fsys,type,set,adr)
externalroutinespec getavfsys(integername n,integerarrayname a)
externalintegerfnspec getusnames2(record (usf)arrayname unn,
integername n,integer fsys)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec connect(string (31) file,integer mode,hole,
prot,record (rf)name r,integername flag)
externalstringfnspec date
systemroutinespec destroy(string (31) file,integername flag)
systemroutinespec disconnect(string (31) file,integername flag)
systemstringfnspec failuremessage(integer mess)
systemroutinespec fill(integer length,from,filler)
systemstringfnspec itos(integer n)
systemroutinespec move(integer length,from,to)
systemroutinespec newgen(string (31) file,newfile,integername flag)
systemstringfnspec nexttemp
systemroutinespec outfile(string (31) file,integer size,hole,
prot,integername conad,flag)
externalintegerfnspec outpos
systemintegerfnspec parmap
systemroutinespec permit(string (31) file,string (6) user,
integer mode,integername flag)
externalroutinespec prompt(string (255) s)
systemintegerfnspec pstoi(string (63) s)
systemroutinespec sendfile(string (31) file,string (16) device,
string (11) name,integer copies,forms,
integername flag)
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfnspec spar(integer n)
externalstringfnspec time
!
externalroutinespec cherish(string (255) s)
externalroutinespec clear(string (255) s)
externalroutinespec define(string (255) s)
!
!
!***********************************************************************
!*
!* External references to other management utilities
!*
!***********************************************************************
!
dynamicintegerfnspec derive shares(string (6) user)
dynamicstringfnspec derive group holder(string (6) user)
!
!
!***********************************************************************
!*
!* Site-dependent routines
!*
!***********************************************************************
!
routine sys extra(integer act,string (6) user)
owninteger conad = 0
ownstring (10) file
ownrecord (hf)name r
integer flag,l
string (255) s,t
switch sw(0:maxact)
!
-> sw(act)
!
sw(open): ! Open system-dependent actions
file = "T#".nexttemp
outfile(file,128*1024,0,0,conad,flag)
if flag # 0 then start
conad = 0
return
finish
r == record(conad)
r_filetype = sscharfiletype
s = "//doc dest=file,user=validate,pass=marion,name=ur"
t = date
s = s.substring(t,1,2).substring(t,4,5).substring(t,7,8)
t = time
s = s.substring(t,1,2).substring(t,4,5).substring(t,7,8).snl
l = length(s)
move(l,addr(s)+1,conad+r_dataend)
r_dataend = r_dataend + l
return
!
sw(create): ! System-dependent action on create user
return if conad = 0
s = "C:".user.snl
l = length(s)
if r_dataend + l > r_filesize then return
move(l,addr(s)+1,conad+r_dataend)
r_dataend = r_dataend + l
return
!
sw(delete): ! System-dependent action on delete user
return if conad = 0
s = "D:".user.snl
l = length(s)
if r_dataend + l > r_filesize then return
move(l,addr(s)+1,conad+r_dataend)
r_dataend = r_dataend + l
return
!
sw(close): ! Close system-dependent actions
return if conad = 0
disconnect(file,flag)
! SENDFILE(FILE,"UNIX","",0,0, FLAG)
destroy(file,flag)
return
end ; ! of SYS ACTION
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
stringfn mess(integer n)
switch sw(1000:1001)
!
-> sw(n)
!
sw(1000): result = "Internal error"
sw(1001): result = "No users specified"
end ; ! of MESS
!
!
routine fail(integer n,string (31) op)
string (255) s
!
selectoutput(0)
if n < 1000 then start
s = failuremessage(n)
finish else s = mess(n).snl
printstring(snl.op." fails - ".s)
set return code(0)
stop
end ; ! of FAIL
!
!
routine asort(record (sf)arrayname p,integerarrayname x,integer num)
integer i,j,jg,k,gap
!
return if num <= 0
!
gap = num//2
while gap > 0 cycle
i = gap + 1
while i <= num cycle
j = i - gap
while j > 0 cycle
jg = j + gap
if p(x(j))_user > p(x(jg))_user then start
k = x(j)
x(j) = x(jg)
x(jg) = k
finish
j = j - gap
repeat
i = i + 1
repeat
gap = gap//2
repeat
end ; ! of ASORT
!
!
routine usort(record (mf)arrayname p,integerarrayname x,integer num)
integer i,j,jg,k,gap
!
return if num <= 0
!
for i = 1,1,num cycle
x(i) = i
repeat
!
gap = num//2
while gap > 0 cycle
i = gap + 1
while i <= num cycle
j = i - gap
while j > 0 cycle
jg = j + gap
if p(x(j))_user > p(x(jg))_user then start
k = x(j)
x(j) = x(jg)
x(jg) = k
finish
j = j - gap
repeat
i = i + 1
repeat
gap = gap//2
repeat
end ; ! of USORT
!
!
integerfn hashname(string (6) user)
integer a,b,c,res
!
a = charno(user,1)
b = charno(user,2)
c = charno(user,6)
res = a*b*c
result = res - (res//maxusers*maxusers) + 1
end ; ! of HASHNAME
!
!
integerfn find(string (6) user,record (sf)arrayname s,
integername pos)
integer start,p,emptyhole
record (sf)name curitem
!
start = hashname(user)
p = start
emptyhole = -1
!
cycle
curitem == s(p)
if curitem_user = user then start
pos = p
result = yes
finish
if curitem_user = empty and emptyhole = -1 then start
emptyhole = p
finish
if curitem_user = "" then start ; ! End of list - not found
if emptyhole = -1 then pos = p else pos = emptyhole
result = no
finish
p = p + 1
if p > maxusers then p = 1
if p = start then result = full; ! Share register full
repeat
end ; ! of FIND
!
!
integerfn adduser(integer rconad,string (6) user,holder,
integer shares)
integer pos,base,flag
record (hf)name r
record (regf)name h
record (sf)name curitem
record (sf)arrayname s
!
r == record(rconad)
base = rconad + r_datastart
h == record(base)
s == array(base+rhdsize,saf)
!
flag = find(user,s,pos)
if flag = yes then result = no
if flag = full then result = full
curitem == s(pos)
curitem_user = user
curitem_shares = shares
curitem_holder = holder
h_shares = h_shares + shares
h_users = h_users + 1
result = yes
end ; ! of ADDUSER
!
!
integerfn removeuser(integer rconad,string (6) user)
integer pos,base,flag,oldshares
record (hf)name r
record (regf)name h
record (sf)name curitem,lastitem,nextitem
record (sf)arrayname s
!
r == record(rconad)
base = rconad + r_datastart
h == record(base)
s == array(base+rhdsize,saf)
!
flag = find(user,s,pos)
if flag = no or flag = full then result = no
curitem == s(pos)
oldshares = curitem_shares
curitem = 0; ! Clear out record
pos = pos - 1
if pos = 0 then pos = maxusers; ! Wrap round
lastitem == s(pos)
if lastitem_user # "" then curitem_user = empty; ! Keep chain intact
pos = pos + 1
if pos = maxusers then pos = 1; ! Wrap around
pos = pos + 1
if pos = maxusers then pos = 1; ! Wrap around
nextitem == s(pos)
if nextitem_user # "" then curitem_user = empty
h_users = h_users - 1
h_shares = h_shares - oldshares
result = yes
end ; ! of REMOVEUSER
!
!
routine readline(stringname s)
integer c
!
s = ""
cycle
cycle
readsymbol(c)
exit if c = nl
s <- s.tostring(c)
repeat
while length(s) > 0 cycle
if charno(s,length(s)) = ' ' then start
length(s) = length(s) - 1
finish else exit
repeat
exit unless s = ""
repeat
end ; ! of READLINE
!
!
routine warn(string (255) s)
printstring("*** ".s." ***")
newline
end ; ! of WARN
!
!
integerfn getmasks(stringarrayname masks,integer max)
integer count
string (255) line
!
prompt("User/Group: ")
count = 0
cycle
readline(line)
exit if line = ".END"
if length(line) # 6 then start
warn("Invalid mask """.line."""")
continue
finish
count = count + 1
masks(count) = line
exit if count = max
repeat
result = count
end ; ! of GETMASKS
!
!
integerfn match(stringarrayname masks,stringname user,integer max)
integer i,j,found
stringname m
!
for i = 1,1,max cycle
m == masks(i)
found = yes
for j = 1,1,6 cycle
if charno(m,j) # charno(user,j) and c
charno(m,j) # '?' then start
found = no
exit
finish
repeat
if found = yes then result = yes
repeat
result = no
end ; ! of MATCH
!
!
routine dsfifail(integer flag,string (6) user)
printstring("DSFI on user """.user.""" fails - flag = ".itos(flag).snl)
end ; ! of DSFIFAIL
!
!
routine item(string (31) title,info)
printstring(title)
spaces(15-outpos)
printstring(": ".info.snl)
end ; ! of ITEM
!
!
!***********************************************************************
!*
!* U N I T S P E R S H A R E
!*
!***********************************************************************
!
externalintegerfn unitspershare
integer flag,conad,base
record (rf) rr
record (regf)name h
!
connect(register,1,0,0,rr,flag)
if flag # 0 then result = -1
conad = rr_conad
base = conad + rr_datastart
h == record(base)
!
result = h_unitspershare
end ; ! of UNITSPERSHARE
!
!
!***********************************************************************
!*
!* C R E A T E R E G I S T E R E N T R I E S
!*
!***********************************************************************
!
externalintegerfn createregisterentries(record (uf)arrayname list,
integer nusers)
integer flag,i,iconad,oconad,temp,fails
record (rf) rr
stringname user
record (hf)name ir,or
record (uf)name curitem
!
result = 0 if nusers <= 0
!
connect(register,1,0,0,rr,flag)
if flag # 0 then result = flag
iconad = rr_conad
ir == record(iconad)
!
outfile(tempregister,ir_filesize,0,0,oconad,flag)
if flag # 0 then result = flag
or == record(oconad)
temp = or_datetime; ! Preserve date over copy
move(ir_filesize,iconad,oconad)
or_datetime = temp; ! Restore date
!
fails = 0
sys extra(open, "")
for i = 1,1,nusers cycle
curitem == list(i)
user == curitem_user
flag = adduser(oconad,user,curitem_holder,curitem_shares)
if flag = full then result = 1000
if flag = no then start
fails = fails + 1
finish else start
sys extra(create,user)
finish
repeat
!
sys extra(close,"")
newgen(tempregister,register,flag)
if flag # 0 then result = flag
!
result = -fails
end ; ! of CREATEREGISTERENTRIES
!
!
!***********************************************************************
!*
!* D E L E T E R E G I S T E R E N T R I E S
!*
!***********************************************************************
!
externalintegerfn deleteregisterentries(stringarrayname users,
integer nusers)
integer flag,iconad,oconad,temp,i,fails
stringname user
record (rf) rr
record (hf)name ir,or
!
result = 0 if nusers <= 0
!
connect(register,1,0,0,rr,flag)
if flag # 0 then result = flag
iconad = rr_conad
ir == record(iconad)
!
outfile(tempregister,ir_filesize,0,0,oconad,flag)
if flag # 0 then result = flag
or == record(oconad)
temp = or_datetime; ! Preserve date over copy
move(ir_filesize,iconad,oconad)
or_datetime = temp; ! Restore date
!
sys extra(open,"")
fails = 0
for i = 1,1,nusers cycle
user == users(i)
flag = removeuser(oconad,user)
if flag = no then start
fails = fails + 1
finish else start
sys extra(delete,user)
finish
repeat
!
sys extra(close,"")
newgen(tempregister,register,flag)
if flag # 0 then result = flag
result = -fails
end ; ! of DELETEREGISTERENTRY
!
!
!***********************************************************************
!*
!* N E W R E G I S T E R
!*
!***********************************************************************
!
externalroutine newregister(string (255) parms)
integer flag,conad,size,base
record (rf) rr
record (regf)name h
record (hf)name r
!
set return code(1000); ! In case of catastrophic failure
if parms # "" then fail(263,nrname); ! Wrong number of parameters
connect(register,0,0,0,rr,flag)
if flag = 0 then start
setfname(register)
fail(219,nrname); ! File already exists
finish
if flag # 218 then fail(flag,nrname); ! Some other error
size = hdsize + rhdsize + maxusers*entrysize
outfile(register,size,0,0,conad,flag)
if flag # 0 then fail(flag,nrname)
r == record(conad)
base = conad + r_datastart
r_filetype = 4; ! Data file
r_format = 3; ! Un-structured
r_dataend = r_filesize
h == record(base)
h = 0
h_holes = maxusers
h_unitspershare = 1
fill(maxusers*entrysize,base+rhdsize,0); ! Clear file
disconnect(register,flag)
cherish(register)
permit(register,"",1,flag); ! In read-only mode
if flag # 0 then fail(flag,nrname)
printstring("Share register ".register." created OK".snl)
set return code(0)
end ; ! of NEWREGISTER
!
!
!***********************************************************************
!*
!* L I S T R E G I S T E R
!*
!***********************************************************************
!
externalroutine listregister(string (255) parms)
integer flag,conad,base,nusers,i
integerarray x(1:maxusers)
string (6) user,lastuser
record (rf) rr
record (regf)name h
record (sf)name curitem
record (sf)arrayname s
!
set return code(1000); ! In case of catastrophic failure
connect(register,1,0,0,rr,flag)
if flag # 0 then fail(flag,lrname)
conad = rr_conad
base = conad + rr_datastart
h == record(base)
s == array(base+rhdsize,saf)
!
if parms = "" then parms = ".OUT"
define("1,".parms)
selectoutput(1)
!
nusers = 0
for i = 1,1,maxusers cycle
curitem == s(i)
continue if curitem_user = ""
continue if curitem_user = empty
nusers = nusers + 1
x(nusers) = i
repeat
asort(s,x,nusers)
!
if nusers # 0 then start
newlines(2)
printstring(" Share register on ".date." at ".time.snl.snl)
printstring("Number of users:"); write(h_users,1)
printstring(" Number of empty slots:")
write(h_holes-h_users,1)
newlines(2)
printstring("Total number of shares allocated:")
write(h_shares,1)
newline
printstring("Average number of shares per user:")
print(h_shares/h_users,1,1)
newline
printstring("Current share value: ".itos(h_unitspershare)." unit")
if h_unitspershare # 1 then printsymbol('s')
newlines(3)
printstring(" User Shares/Group Holder".snl.snl)
lastuser = "ZZZZZZ"
for i = 1,1,nusers cycle
curitem == s(x(i))
user = curitem_user
if substring(user,1,6-suffsize) # c
substring(lastuser,1,6-suffsize) then newline
printstring(user)
spaces(3)
if curitem_holder # "" then start
spaces(13)
printstring(curitem_holder)
finish else start
write(curitem_shares,6)
finish
newline
lastuser = user
repeat
printstring(snl.snl."*** End of share register ***".snl.snl)
finish else printstring("Share register is empty".snl)
selectoutput(0)
closestream(1)
clear("1")
set return code(0)
end ; ! of LISTREGISTER
!
!
!***********************************************************************
!*
!* M O D I F Y R E G I S T E R
!*
!***********************************************************************
!
externalroutine modifyregister(string (255) parms)
integer flag,iconad,oconad,temp,base,linecount,i,ok,deletedusers
integer addedusers,changedusers,shares,hpos
string (6) user,holder
string (80) line
string (255) work1,work2
record (rf) rr
record (regf)name h
record (hf)name ir,or
record (sf)arrayname s
!
set return code(1000); ! In case of catastrophic failure
if parms = "" then parms = ".IN"
define("1,".parms)
connect(register,1,0,0,rr,flag)
if flag # 0 then fail(flag,mrname)
iconad = rr_conad
ir == record(iconad)
outfile(tempregister,ir_filesize,0,0,oconad,flag)
if flag # 0 then fail(flag,mrname)
or == record(oconad)
temp = or_datetime; ! Preserve date over copy
move(ir_filesize,iconad,oconad); ! Copy share register
or_datetime = temp; ! Restore date
!
base = oconad + or_datastart
h == record(base)
s == array(base+rhdsize,saf)
selectinput(1)
!
deletedusers = 0
addedusers = 0
changedusers = 0
linecount = 0
prompt("Entry: ")
cycle
readline(line)
while line -> work1.(" ").work2 cycle
line = work1." ".work2; ! Remove multiple spaces
repeat
exit if line = ".END"
linecount = linecount + 1
!
if line -> work2.(".DELETE ").work1 and work2 = "" then start
if length(work1) # 6 then start
warn("Invalid user """.work1.""" on line ".itos(linecount))
continue
finish
user = work1
ok = yes
for i = 1,1,maxusers cycle
if s(i)_holder = user then start
warn("User """.user.""" on line ".itos(linecount).c
" is a group holder")
ok = no
exit
finish
repeat
continue unless ok = yes
flag = removeuser(oconad,user)
if flag = yes then start
printstring(" User """.user.""" removed from share")
printstring(" register".snl)
deletedusers = deletedusers + 1
finish else start
warn("User """.user.""" on line ".itos(linecount)." not in ".c
"share register")
finish
continue
finish
!
unless line -> work1.(" ").work2 then start
warn("Invalid line - number ".itos(linecount).": ".line)
continue
finish
if length(work1) # 6 then start
warn("Invalid user """.work1.""" on line ".itos(linecount))
continue
finish
user = work1
work2 = " " if work2 = ""
if 'A' <= charno(work2,1) <= 'Z' then start
if length(work2) # 6 then start
warn("Invalid group holder """.work2.""" on line ".c
itos(linecount))
continue
finish
holder = work2
shares = 0
finish else start
holder = ""
shares = pstoi(work2)
if shares < 0 then start
warn("Invalid number of shares - """.work2.""" on ".c
"line ".itos(linecount))
continue
finish
finish
!
ok = yes
for i = 1,1,maxspecialusers cycle
if user = specialusers(i) then start
warn("Attempt to put system user """.user.""" into".c
" share register on line ".itos(linecount))
printstring(snl)
ok = no
finish
repeat
continue unless ok = yes
!
if holder # "" then start ; ! Check for holder -> holder
flag = find(holder,s,hpos)
if flag = no then start
warn("Group holder """.holder.""" referenced on line ".c
itos(linecount)." not found in share register")
continue
finish
if s(hpos)_holder # "" then start
warn("Attempt to use group member """.holder.""" as a group".c
" holder on line ".itos(linecount))
continue
finish
!
ok = yes
for i = 1,1,maxusers cycle
if s(i)_holder = user then start
warn("Attempt to use group holder """.user.""" as a ".c
"group member on line ".itos(linecount))
ok = no
exit
finish
repeat
continue unless ok = yes
finish
!
flag = removeuser(oconad,user)
if flag = yes then start
work1 = " replaced in"
changedusers = changedusers + 1
finish else start
work1 = " added to"
addedusers = addedusers + 1
finish
flag = adduser(oconad,user,holder,shares)
if flag = full then start
warn("Share register full - user ".user." on line ".c
itos(linecount)." not added")
continue
finish
printstring(" User ".user.work1." share register".snl)
repeat
!
newgen(tempregister,register,flag)
if flag # 0 then fail(flag,mrname)
selectinput(0)
closestream(1)
clear("1")
newline
item("Users deleted",itos(deletedusers))
item("Users added",itos(addedusers))
item("Users changed",itos(changedusers))
printstring(snl."Finished".snl)
set return code(0)
end ; ! of MODIFYREGISTER
!
!
!***********************************************************************
!*
!* D I S T R I B U T E F U N D S
!*
!***********************************************************************
!
externalroutine distributefunds(string (255) parms)
integer ups,iconad,oconad,base,flag,temp,i,units
string (6) user,holder
record (rf) rr
record (hf)name ir,or
record (regf)name h
record (sf)arrayname s
!
set return code(1000); ! In case of catastrophic failure
connect(register,1,0,0,rr,flag)
if flag # 0 then fail(flag,dfname)
iconad = rr_conad
ir == record(iconad)
base = iconad + ir_datastart
h == record(base)
!
if parms # "" then start
ups = pstoi(parms)
if ups < 0 then start
setfname(parms)
fail(202,dfname); ! Invalid parameter
finish
finish else ups = h_unitspershare
!
outfile(tempregister,ir_filesize,0,0,oconad,flag)
if flag # 0 then fail(flag,dfname)
or == record(oconad)
temp = or_datetime; ! Preserve date over copy
move(ir_filesize,iconad,oconad)
or_datetime = temp; ! Restore date
!
base = oconad + or_datastart
h == record(base)
s == array(base+rhdsize,saf)
!
h_update = date
h_uptime = time
h_unitspershare = ups
!
units = specialusershares*ups*100; ! Director needs hundredths of units
holder = ""
for i = 1,1,maxspecialusers cycle
user = specialusers(i)
flag = dsfi(user,-1,37,1,addr(holder)); ! Set 'no group holder'
if flag # 0 then dsfifail(flag,user) and continue
flag = dsfi(user,-1,33,1,addr(units)); ! Set ration
if flag # 0 then dsfifail(flag,user) and continue
repeat
!
for i = 1,1,maxusers cycle
user = s(i)_user
if "" # user # empty then start
holder = s(i)_holder
units = ups*s(i)_shares*100; ! Director needs hundredths of units
flag = dsfi(user,-1,37,1,addr(holder))
if flag # 0 then dsfifail(flag,user) and continue
flag = dsfi(user,-1,33,1,addr(units))
if flag # 0 then dsfifail(flag,user) and continue
finish
repeat
!
printstring(snl."Funds distributed OK".snl)
newgen(tempregister,register,flag)
if flag # 0 then fail(flag,dfname)
set return code(0)
end ; ! of DISTRIBUTEFUNDS
!
!
!***********************************************************************
!*
!* V E R I F Y R E G I S T E R
!*
!***********************************************************************
!
externalroutine verifyregister(string (255) parms)
integer flag,iconad,oconad,base,nfsys,i,j,k,nusers,fix,temp,pos
integer nmissing
string (6) holder
string (31) fs
string (255) tempstring
integerarray fsys(0:99)
record (rf) rr
record (hf)name ir,or
record (regf)name h
record (sf)name curitem
record (mf)name misitem
integerarray x(1:maxusers)
byteintegerarray found(1:maxusers)
record (usf)array us(0:maxusers-1)
record (mf)array missing(1:maxusers)
record (sf)arrayname s
stringname user
!
set return code(1000); ! In case of catastrophic failure
setpar(parms)
if parmap > 3 then fail(263,vrname); ! Wrong number of parameters
tempstring = spar(1)
fs <- spar(2)
if tempstring = "" then tempstring = ".OUT"
define("1,".tempstring)
selectoutput(1)
if fs # "" then start
if fs # "FIX" then start
setfname(fs)
fail(202,vrname); ! Invalid parameter
finish
fix = yes
finish else fix = no
!
connect(register,1,0,0,rr,flag)
if flag # 0 then fail(flag,vrname)
iconad = rr_conad
ir == record(iconad)
base = iconad + ir_datastart
h == record(base)
s == array(base+rhdsize,saf)
!
if fix = yes then start
outfile(tempregister,ir_filesize,0,0,oconad,flag)
if flag # 0 then fail(flag,vrname)
or == record(oconad)
temp = or_datetime; ! Preserve date over copy
move(ir_filesize,iconad,oconad)
or_datetime = temp; ! Restore date
ir == record(oconad)
base = oconad + or_datastart
h == record(base)
s == array(base+rhdsize,saf)
finish
!
get av fsys(nfsys,fsys)
!
nmissing = 0
for i = 1,1,maxusers cycle
found(i) = no
repeat
!
for i = 0,1,nfsys - 1 cycle
flag = getusnames2(us,nusers,fsys(i))
if flag # 0 then start
warn("Get usernames on fsys ".itos(fsys(i))." fails, flag = ".c
itos(flag))
continue
finish
!
for j = 0,1,nusers - 1 cycle
user == us(j)_name
flag = no
for k = 1,1,maxspecialusers cycle
if user = specialusers(k) then start
flag = yes
exit
finish
repeat
if flag = yes then start
found(pos) = yes
continue
finish
!
flag = find(user,s,pos)
if flag = no or flag = full then start
nmissing = nmissing + 1
misitem == missing(nmissing)
misitem_user = user
misitem_fsys = fsys(i)
finish else found(pos) = yes
!
repeat
repeat
!
if nmissing # 0 then start
usort(missing,x,nmissing)
printstring("Users missing from share register: ")
printstring(itos(nmissing).snl.snl)
printstring(" User Fsys".snl)
tempstring = "??????"; ! Impossible user number
for i = 1,1,nmissing cycle
user == missing(x(i))_user
j = missing(x(i))_fsys
if substring(user,1,6-suffsize) # c
substring(tempstring,1,6-suffsize) then start
newline
tempstring = user
finish
printstring(user." ".itos(j).snl)
repeat
finish
!
if fix = yes and nmissing # 0 then start
printstring(snl."Adding missing users...".snl.snl)
temp = 0
for i = 1,1,nmissing cycle
user == missing(x(i))_user
j = missing(x(i))_fsys
k = derive shares(user)
holder = derive group holder(user)
flag = adduser(oconad,user,holder,k)
if flag = no or flag = full then start
warn("Failed to add user ".user)
if flag = full then start
warn("Share register is full")
exit
finish
finish
printstring(" User ".user." added".snl)
flag = find(user,s,pos)
if flag = no then fail(1000,vrname); ! Should never happen
found(pos) = yes
temp = temp + 1
repeat
newline
item("Users added",itos(temp))
newlines(2)
finish
!
nmissing = 0
for i = 1,1,maxusers cycle
continue if found(i) = yes
curitem == s(i)
user == curitem_user
continue if user = "" or user = empty
nmissing = nmissing + 1
misitem == missing(nmissing)
misitem_user = user
misitem_fsys = -1
repeat
!
if nmissing # 0 then start
usort(missing,x,nmissing)
printstring("Share register entries for non-existent users: ")
printstring(itos(nmissing).snl)
tempstring = "??????"; ! Impossible user number
for i = 1,1,nmissing cycle
user == missing(x(i))_user
if substring(user,1,6-suffsize) # c
substring(tempstring,1,6-suffsize) then start
newline
tempstring = user
finish
printstring(user.snl)
repeat
finish
!
if fix = yes and nmissing # 0 then start
printstring(snl."Deleting surplus users...".snl.snl)
temp = 0
for i = 1,1,nmissing cycle
user == missing(x(i))_user
flag = removeuser(oconad,user)
printstring(" User ".user." deleted".snl)
temp = temp + 1
repeat
newline
item("Users deleted",itos(temp))
newlines(2)
finish
!
selectoutput(0)
closestream(1)
clear("1")
!
if fix = yes then start
newgen(tempregister,register,flag)
if flag # 0 then fail(flag,vrname)
finish
set return code(0)
end ; ! of VERIFYREGISTER
!
!
!***********************************************************************
!*
!* L I S T S H A R E S
!*
!***********************************************************************
!
externalroutine listshares(string (255) parms)
integer flag,count,conad,base,nmasks,i
record (rf) rr
string (6) lastuser
stringname user
record (regf)name h
record (sf)name curitem
record (sf)arrayname s
integerarray x(1:maxusers)
string (6)array masks(1:maxmasks)
!
set return code(1000); ! In case of catastrophic failure
nmasks = getmasks(masks,maxmasks)
if nmasks <= 0 then fail(1001,lsname); ! No users specified
if parms = "" then parms = ".OUT"
define("1,".parms)
selectoutput(1)
!
connect(register,1,0,0,rr,flag)
if flag # 0 then fail(flag,lsname)
conad = rr_conad
base = conad + rr_datastart
h == record(base)
s == array(base+rhdsize,saf)
!
count = 0
for i = 1,1,maxusers cycle
user == s(i)_user
continue if user = ""
continue if user = empty
continue if match(masks,user,nmasks) = no
count = count + 1
x(count) = i
repeat
!
if count # 0 then start
asort(s,x,count)
lastuser = "ZZZZZZ"
newlines(2)
printstring("Extract from share register on ".date." at ".time)
newlines(2)
printstring("Users selected: ".itos(count))
newlines(3)
printstring(" User Shares/Group Holder".snl.snl)
!
for i = 1,1,count cycle
curitem == s(x(i))
user == curitem_user
if substring(user,1,6-suffsize) # c
substring(lastuser,1,6-suffsize) then newline
printstring(user)
spaces(3)
if curitem_holder # "" then start
spaces(13)
printstring(curitem_holder)
finish else start
write(curitem_shares,6)
finish
newline
lastuser = user
repeat
!
printstring(snl.snl."*** End of extract ***".snl)
finish else start
printstring("Selected users not found in share register".snl)
finish
set return code(0)
end ; ! of LISTSHARES
endoffile