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