!***********************************************************************
!*
!* Specialised file index copy program
!*
!* Copyright R.D. Eager University of Kent MCMLXXXIII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger maxfiles = 256
constantinteger set = 1
constantinteger setownp = 0,seteep = 1,addtoflist = 2,addtoilist = 6
constantinteger getflist = 4,getilist = 8
constantstring (19)array nogo(1:2) = "UNAVAilable set","has WRCONN set"
constantinteger unava = 1
constantinteger wrconn = 1
constantinteger offer = 2
constantinteger chersh = 16
constantinteger privat = 32
constantinteger noarch = 128
constantinteger topsfi = 44
constantbyteintegerarray xfer(0:topsfi) = c
1,1,1,1,0,1,0,1,0,0,1,1,1,0,1,1,0,0,1,1,
0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,1,1,0,1,0,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 dconnect(string (6) user,string (15) file,
integer fsys,mode,apf,
integername seg,gap)
externalintegerfunctionspec dcreate(string (6) user,string (15) file,
integer fsys,nkb,type)
externalintegerfunctionspec ddeluser(string (6) user,integer fsys)
externalintegerfunctionspec ddisconnect(string (6) user,
string (11) file,
integer fsys,destroy)
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)
externalintegerfunctionspec dpermission(string (6) owner,user,
string (8) date,
string (11) file,
integer fsys,type,adrprm)
externalintegerfunctionspec dsfi(string (6) user,integer fsys,type,
set,adr)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemstringfunctionspec failuremessage(integer mess)
systemstringfunctionspec itos(integer n)
systemroutinespec move(integer length,from,to)
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)
externalintegerfunctionspec uinfi(integer entry)
externalstringfunctionspec uinfs(integer entry)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
routine fail(integer n)
selectoutput(0)
printstring(snl."CINDEX fails -".failuremessage(n))
set return code(n)
stop
end ; ! of fail
!
!
routine abandon
printstring("CINDEX 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 warn(string (31) info1,info2,integer flag)
printstring("Warning - file ".info2." - ".info1." flag =".derrs(flag))
newline
end ; ! of warn
!
!
routine file error(string (31) mes,string (11) file,integer flag)
printstring(mes." ".file." fails, flag =".derrs(flag).snl)
end ; ! of file error
!
!
integerfunction physical size kb(string (11) user,file,integer fsys)
integer flag
record (dfinfof) r
!
flag = dfinfo(user,file,fsys,addr(r))
if flag # 0 then start
warn("DFINFO",file,flag)
result = 0
finish
result = r_nkb
end ; ! of physical size kb
!
!
routine dfstat(string (6) newuser,integer act,val,fsys,
string (31) file)
integer flag
!
return if file = "#ARCH"
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,seg1,seg2,gap1,gap2,kbytes,connect flag
!
if file = "#ARCH" then return ; ! Leave alone
!
seg1 = 0; gap1 = 0
connect flag = dconnect(user,file,oldfsys,1,0,seg1,gap1)
if 0 # connect flag # 34 then start
file error("Connect old",file,connect flag)
return
finish
kbytes = physical size kb(user,file,oldfsys)
if kbytes = 0 then return ; ! Zero length file??
!
flag = dcreate(newuser,file,newfsys,kbytes,0)
if flag # 0 then start
file error("Create new",file,flag)
return
finish
!
seg2 = 0; gap2 = 0
flag = dconnect(newuser,file,newfsys,3,0,seg2,gap2)
if flag # 0 then start
file error("Connect new",file,flag)
return
finish
!
move(kbytes<<10,seg1<<18,seg2<<18)
!
if connect flag = 0 then start
flag = ddisconnect(user,file,oldfsys,0)
if flag # 0 then file error("Disconnect old",file,flag)
finish
!
flag = ddisconnect(newuser,file,newfsys,0)
if flag # 0 then file error("Disconnect new",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:11)
record (retf) p
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)
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 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)
!
! 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
!
file = ""
dpermi(olduser,"",getilist,addr(p),file)
i = 0
pt = 16
while pt < p_bytes cycle
dpermi(olduser,p_indiv(i)_user,addtoilist,p_indiv(i)_uprm,file)
i = i + 1
pt = pt + 8
repeat
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
if flist(x)_codes&offer#0 then start
! Throw away "offers"
flag = doffer(olduser,"",file,oldfsys)
if flag # 0 then error("DOFFER",flag)
finish
p = 0
dpermi(olduser,"",getflist,addr(p),file)
transfer file(olduser,newuser,file,oldfsys,newfsys)
good = good + 1
codes = flist(x)_codes
codes2 = flist(x)_codes2
arch = flist(x)_arch
if codes & chersh # 0 then start
dfstat(newuser,1,0,newfsys,file)
finish
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
dfstat(newuser,18,flist(x)_ssbyte,newfsys,file)
!
! 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
!
! 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
!
return if file = "#ARCH"
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
!
!
!***********************************************************************
!*
!* C I N D E X
!*
!***********************************************************************
!
externalroutine cindex(string (255) parms)
integer oldfsys,newfsys,flag,removep flag
string (6) olduser,newuser,self
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
inf(3) = inf(3) + 1 if inf(3) & 1 # 0
flag = dnewuser(newuser,newfsys,inf(3))
! Use same index size
if flag # 0 then error("DNEWUSER",flag)
!
! Next remove permission to self. If result is zero, this
! was successful and we do not want to remove the SELF permission
! afterwards. If result is 50 (User not in list) this is OK, and
! we remove SELF when we've finished with the index.
!
self = uinfs(1)
removep flag = dpermission(olduser,self,"","",oldfsys,7,0)
if 0 # removep flag # 50 then start
error("DPERMISSION 7(1)",flag)
finish
flag = dpermission(olduser,self,"","",oldfsys,6,3)
if flag # 0 then error("DPERMISSION 6",flag)
!
copy index(olduser,newuser,oldfsys,newfsys)
!
if removep flag = 50 then start
flag = dpermission(olduser,self,"","",oldfsys,7,0)
if flag # 0 then error("DPERMISSION 7(2)",flag)
finish
!
printstring("CINDEX completed OK".snl)
set return code(0)
end ; ! of cindex
endoffile