!***********************************************************************
!*
!* Program to make a complete copy of a file index
!*
!* Copyright R.D. Eager University of Kent MCMLXXXIII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger maxfiles = 512
constantinteger set = 1
constantinteger setownp = 0,seteep = 1,addtoflist = 2,addtoilist = 6
constantinteger getflist = 4,getilist = 8,setieep = 11
constantstring (19)array nogo(1:3) = c
"UNAVAilable set","has WRCONN set","has generations"
constantinteger unava = 1
constantinteger wrconn = 1
constantinteger offer = 2
constantinteger newge = 2
constantinteger tempfi = 4
constantinteger oldge = 4
constantinteger vtemp = 8
constantinteger chersh = 16
constantinteger privat = 32
constantinteger violat = 64
constantinteger noarch = 128
constantstring (6) dummy user = "DUM999"
constantinteger topsfi = 44
constantbyteintegerarray xfer(0:topsfi) = c
1,1,1,1,0,1,0,1,0,0,1,1,1,0,1,1,1,1,1,1,
1,0,0,1,0,1,1,1,0,1,0,0,1,1,0,1,1,1,1,1,0,1,1,1,1
constantstring (1) snl = "
"
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat dfinfof(integer nkb,rup,eep,apf,use,arch,fsys,
conseg,cct,codes,byteinteger sp1,dayno,pool,
codes2,integer ssbyte,string (6) tran)
recordformat oinff(string (11) name,integer sp12,nkb,
byteinteger arch,codes,cct,ownp,eep,use,codes2,
ssbyte,flags,pool,dayno,sp31)
recordformat indivf(string (6) user,byteinteger uprm)
recordformat retf(integer bytes,ownp,eep,spare,
record (indivf)array indiv(0:15))
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalintegerfunctionspec ddeluser(string (6) user,integer fsys)
externalstringfunctionspec derrs(integer n)
externalintegerfunctionspec dfilenames(string (6) user,
record (oinff)arrayname inf,
integername fileno,maxrec,
nfiles,integer fsys,type)
externalintegerfunctionspec dfinfo(string (6) user,string (11) file,
integer fsys,adr)
externalintegerfunctionspec dfstatus(string (6) user,string (11) file,
integer fsys,act,value)
externalintegerfunctionspec dnewuser(string (6) user,integer fsys,nkb)
externalintegerfunctionspec doffer(string (6) user,offerto,
string (11) file,integer fsys)
externalroutinespec doper(integer cnsl,string (255) s)
externalintegerfunctionspec dpermission(string (6) owner,user,
string (8) date,
string (11) file,
integer fsys,type,adrprm)
externalintegerfunctionspec drenameindex(string (6) oldname,newname,
integer fsys)
externalintegerfunctionspec dsfi(string (6) user,integer fsys,type,
set,adr)
externalintegerfunctionspec dtransfer(string (6) user1,user2,
string (11) file,newname,
integer fsys1,fsys2,type)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemstringfunctionspec failuremessage(integer mess)
systemstringfunctionspec itos(integer n)
systemintegerfunctionspec parmap
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
routine fail(integer n)
printstring(snl."XINDEX fails -".failuremessage(n))
set return code(n)
stop
end ; ! of fail
!
!
routine abandon
printstring("XINDEX abandoned".snl)
set return code(1000)
stop
end ; ! of abandon
!
!
routine error(string (31) info,integer flag)
printstring(info." flag =".derrs(flag).snl)
abandon
end ; ! of error
!
!
routine file error(string (31) mes,string (11) file,integer flag)
printstring(mes." ".file." fails, flag =".derrs(flag).snl)
end ; ! of file error
!
!
routine dfstat(string (6) newuser,integer act,val,fsys,
string (31) file)
integer flag
!
flag = dfstatus(newuser,file,fsys,act,val)
if flag # 0 then start
error("DFSTATUS ".itos(act)." on ".file,flag)
finish
end ; ! of dfstat
!
!
routine transfer file(string (6) user,newuser,string (11) file,
integer oldfsys,newfsys)
integer flag
!
flag = dtransfer(user,newuser,file,file,oldfsys,newfsys,3)
if flag # 0 then file error("Transfer",file,flag)
end ; ! of transfer file
!
!
routine copy index(string (6) olduser,newuser,integer oldfsys,newfsys)
integer i,flag,codes,codes2,arch,n,x,fromrec,ngiven
integer good,bad,pt,use,condition,save maxfile
string (31) file
integerarray inf(0:15)
record (retf) p
record (dfinfof) dfr
record (oinff)array flist(0:maxfiles-1)
routinespec dpermi(string (6) olduser,touser,integer act,ad,
string (31) file)
!
fromrec = 0
ngiven = maxfiles
save maxfile = -1; ! To hold user's MAXFILE until after the transfer
!
for i = 0,1,maxfiles-1 cycle
flist(i) = 0
repeat
!
flag = dfilenames(olduser,flist,fromrec,ngiven,n,oldfsys,0)
if flag # 0 then error("DFILENAMES",flag)
if n > ngiven then printstring("Too many files!".snl)
printstring("Number of files = ".itos(ngiven).snl)
!
bad = 0
i = 0
while i < n cycle
file = flist(i)_name
codes = flist(i)_codes
codes2 = flist(i)_codes2
use = flist(i)_use
condition = 0
if codes&unava # 0 then condition = 1
if codes2&wrconn # 0 then condition = 2
if codes2 & (oldge!newge) # 0 then condition = 3
if condition # 0 then start
printstring(file." ".nogo(condition).snl)
bad = bad + 1
finish
i = i + 1
repeat
if bad # 0 then start
printstring("Cannot copy ".itos(bad)." file")
if bad # 1 then printsymbol('s')
newline
finish else printstring("Files OK".snl)
abandon if bad # 0
!
! Move SFI information
!
for i = 0,1,topsfi cycle
if xfer(i) # 0 then start
flag = dsfi(olduser,oldfsys,i,0,addr(inf(0)))
if flag # 0 then error("DSFI ".itos(i)." (get)",flag)
! Temporarily save user's MAXFILE and set the field "very large"
! in case there are files about exceeding his current MAXFILE.
if i = 12 then start
save maxfile = inf(0)
inf(0) = 200*1024
finish
flag = dsfi(newuser,newfsys,i,1,addr(inf(0)))
if flag # 0 then error("DSFI ".itos(i)." (set)",flag)
finish
repeat
!
! Move whole-index permissions
!
dpermi(olduser,"",getilist,addr(p),"")
i = 0
pt = 16
while pt < p_bytes cycle
dpermi(newuser,p_indiv(i)_user,addtoilist,p_indiv(i)_uprm,"")
i = i + 1
pt = pt + 8
repeat
dpermi(newuser,"",setieep,p_eep,"")
printstring("SFI information moved OK".snl)
!
! Now transfer the files
!
good = 0
bad = 0
x = 0
while x < ngiven cycle ; ! All the files
file = flist(x)_name
codes = flist(x)_codes
if codes & (tempfi!vtemp!violat) # 0 then start
x = x + 1; ! Ignore
continue
finish
flag = dfinfo(olduser,file,oldfsys,addr(dfr))
if flag # 0 then error("DFINFO",flag)
if codes & offer # 0 then start ; ! Remember and throw away "offers"
flag = doffer(olduser,"",file,oldfsys)
if flag # 0 then error("DOFFER (1)",flag)
finish
p = 0
dpermi(olduser,"",getflist,addr(p),file)
transfer file(olduser,newuser,file,oldfsys,newfsys)
good = good + 1
codes2 = flist(x)_codes2
arch = flist(x)_arch
if codes & chersh # 0 then start
dfstat(newuser,1,0,newfsys,file)
finish
dfstat(newuser,9,dfr_cct,newfsys,file)
dfstat(newuser,21,dfr_dayno,newfsys,file)
dfstat(newuser,18,dfr_ssbyte,newfsys,file)
if codes & privat # 0 then start
dfstat(newuser,8,0,newfsys,file)
finish
if codes & noarch # 0 then start
dfstat(newuser,17,0,newfsys,file)
finish
!
! Now the file permissions
!
i = 0
pt = 16
while pt < p_bytes cycle
dpermi(olduser,p_indiv(i)_user,addtoflist,p_indiv(i)_uprm,file)
i = i + i
pt = pt + 8
repeat
if codes & offer # 0 then start
flag = doffer(newuser,dfr_tran,file,newfsys)
if flag # 0 then error("DOFFER (2)",flag)
flag = doffer(olduser,dfr_tran,file,oldfsys)
if flag # 0 then error("DOFFER (3)",flag)
finish
!
! And the OWNP, EEP and ARCH bytes
!
dpermi(olduser,"",setownp,p_ownp,file)
dpermi(olduser,"",seteep,p_eep,file)
dfstat(newuser,13,arch,newfsys,file)
x = x + 1
repeat ; ! All the files
!
printstring(itos(good)." files transferred".snl)
if bad # 0 then start
printstring(itos(bad)." files failed to transfer".snl)
finish
!
! Reset the user's MAXFILE
!
inf(0) = save maxfile
flag = dsfi(newuser,newfsys,12,set,addr(inf(0)))
if flag # 0 then error("DSFI 12 (set)",flag)
!
!
routine dpermi(string (6) fromuser,touser,integer act,adr or perm,
string (31) file)
integer fsys,flag
string (6) owner
!
if act = getilist or act = getflist then start
owner = fromuser
fsys = oldfsys
finish else start
owner = newuser
fsys = newfsys
finish
flag = dpermission(owner,touser,"",file,fsys,act,adr or perm)
if flag # 0 then error("DPERMISSION ".itos(act),flag)
end ; ! of dpermi
end ; ! of copy index
!
!
!***********************************************************************
!*
!* X I N D E X
!*
!***********************************************************************
!
externalroutine xindex(string (255) parms)
integer oldfsys,newfsys,flag
string (6) olduser,newuser
integerarray inf(0:11)
!
set return code(1000); ! In case of catastrophic failure
!
! Get details of old user
!
setpar(parms)
if parmap # 15 then fail(263); ! Wrong number of parameters
olduser = spar(1)
oldfsys = pstoi(spar(2))
unless 0 <= oldfsys <= 99 then start
setfname(spar(2))
fail(202); ! Invalid parameter
finish
!
! First report old index size
!
flag = dsfi(olduser,oldfsys,4,0,addr(inf(0)))
if flag # 0 then error("DSFI 4",flag)
printstring("Index size is ".itos(inf(3))."Kb".snl)
!
! Get details of new user, and delete it if it already exists
!
newuser = spar(3)
newfsys = pstoi(spar(4))
unless 0 <= newfsys <= 99 then start
setfname(spar(4))
fail(202); ! Invalid parameter
finish
flag = ddeluser(newuser,newfsys); ! Ignore flag
flag = ddeluser(dummy user,newfsys); ! Ignore flag
inf(3) = inf(3) + 1 if inf(3) & 1 # 0
flag = dnewuser(dummy user,newfsys,inf(3))
! Use same index size
if flag # 0 then error("DNEWUSER",flag)
!
copy index(olduser,dummy user,oldfsys,newfsys)
flag = drenameindex(dummy user,newuser,newfsys)
if flag # 0 then error("DRENAMEINDEX",flag)
!
printstring("XINDEX completed OK".snl)
doper(0,"User ".olduser." done")
set return code(0)
end ; ! of xindex
endoffile