!*********************************************************************** !* !* 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