! 25 mar 85:
! apermit becomes archpermit
! cleararchperms introduced
!
! ARCHIVE INDEX UTILITES
!
! SUBSTANTIALLY REWRITTEN FOR NEW INDEX STRUCTURE - CDM 12/NOV/82
!
!-----------------------------------------------------------------------
!
! INDEX FORMATS AND CONSTANTS
!
RECORDFORMAT AFDF(STRING (11)NAME,INTEGER TSN,HALFINTEGER PGS,DATE, C
LAST RESTORE,BYTEINTEGER S0,S1,COUNT,EEP,PHEAD,TYPE,INTEGER CHAP)
OWNRECORD (AFDF)ARRAYFORMAT AFDSF (1:32768)
! ABOVE IS ARCH INDEX FILE DESCRIPTOR
RECORDFORMAT FF(INTEGER SDSTART,PDSTART,FDSTART,SEMA,RESERVE1,RESERVE2, C
SEMANO,RESTORES,STRING (6)OWNER,BYTEINTEGER SIZE,STRING (11)NAME, C
BYTEINTEGER FSYS,FIPHEAD,TEMPFILES,EEP,INTEGER FILES,MAXFILE,MAXKB, C
CHERFILES,CHERKB,TOTKB,TEMPKB,CHKSUM,FILES0,FILES1,AFILES,ATOTKB,ASEMA)
! ABOVE IS ARCH INDEX HEADER
RECORDFORMAT PDF(STRING (6)NAME,BYTEINTEGER PERM,LINK)
OWNRECORD (PDF)ARRAYFORMAT PDSF(1:512)
! ABOVE IS PERMISSION DESCRIPTOR
!
CONSTINTEGER FDSIZE = 32
CONSTINTEGER PDSIZE = 9
!
!
! LOCAL CONSTANTS, FORMATS AND SPECS
!
CONSTINTEGER MAX TYPE=1
CONSTSTRING (1)ARRAY ARCHTYPE(0:1)="A","B"
CONSTSTRING (7)ARRAY FARCHTYPE(0:1)="archive","backup"
CONSTSTRING (40) TYPE MESS="Type is either 0 (archive) or 1 (backup)"
CONSTSTRING (13) PLANT MESS=" or 2 (plant)"
CONSTINTEGER AINFFLEN=40; ! BYTES
CONSTINTEGER PROGMAX=6400; ! MOX NO OF FILES THIS PROG CAN DEAL WITH
!
RECORDFORMAT AINFF(STRING (11) NAME,INTEGER NKB,STRING (8) DATE, C
STRING (6) TAPE,INTEGER CHAP,FLAGS); ! 40 BYTES
OWNRECORD (AINFF)ARRAY F(0:511)
OWNINTEGER FFILENO,FMAXREC,FFSYS
!
RECORDFORMAT OF(STRING (6) USER,BYTEINTEGER UPRM)
RECORDFORMAT PFF(INTEGER BYTES RETURNED,OWNP,EEP,SP,RECORD (OF)ARRAY PRMS(0:15))
!
EXTERNALSTRINGFNSPEC DERRS(INTEGER I)
EXTERNALINTEGERFNSPEC DCONNECT(STRING (6) USER,STRING (15) FILE, C
INTEGER FSYS,MODE,APF,INTEGERNAME SEG,GAP)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6) USER,STRING (15) FILE, C
INTEGER FSYS,DSTRY)
EXTERNALINTEGERFNSPEC DRENAME(STRING (6) USER,STRING (15) OLDNAME,NEWNAME, C
INTEGER FSYS)
EXTERNALINTEGERFNSPEC DNEW ARCH INDEX(STRING (6) USER,INTEGER FSYS,KBYTES)
EXTERNALINTEGERFNSPEC EXIST(STRING ( 255) S)
SYSTEMSTRINGFNSPEC ITOS(INTEGER I)
EXTERNALINTEGERFNSPEC DPERMISSION(STRING (6) OWNER,USER,STRING (8) DATE, C
STRING (15) FILE,INTEGER FSYS,TYPE,ADRPRM)
EXTERNALINTEGERFNSPEC ACREATE2(STRING (6) USER,TAPE,STRING (8) DATE, C
STRING (11)FILE,INTEGER FSYS,NKB,CHAPTER,TYPE)
EXTERNALINTEGERFNSPEC DFILENAMES(STRING (6) USER,RECORD (AINFF)ARRAYNAME INF, C
INTEGERNAME FILENO,MAXREC,NFILES,INTEGER FSYS,TYPE)
EXTERNALINTEGERFNSPEC DDESTROY(STRING (6) USER,STRING (11) FILE, C
STRING (8) DATE,INTEGER FSYS,TYPE)
EXTERNALINTEGERFNSPEC DRESTORE(STRING (6) USER,STRING (11) FILE, C
STRING (8) DATE,INTEGER FSYS,TYPE)
EXTERNALINTEGERFNSPEC DMOD ARCH(STRING (6) USER,STRING (11) FILE, C
STRING (8) DATE,RECORD (AINFF)NAME ENT,INTEGER FSYS,TYPE)
EXTERNALSTRINGFNSPEC UINFS(INTEGER I)
SYSTEMROUTINESPEC DISCONNECT(STRING (31) S,INTEGERNAME FLAG)
EXTERNALROUTINESPEC DUMP(INTEGER ST,FIN,PST,LIM)
EXTERNALINTEGERFNSPEC RDFILEAD(STRING (255) S)
EXTERNALINTEGERFNSPEC NWFILEAD(STRING (31) S,INTEGER EPGS)
EXTERNALROUTINESPEC RDINT(INTEGERNAME I)
EXTERNALROUTINESPEC RSTRG(STRINGNAME S)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
EXTERNALROUTINESPEC DEFINE(STRING (255) S)
SYSTEMROUTINESPEC MOVE(INTEGER L,F,T)
!
ROUTINE UDERRS(INTEGER N)
PRINTSTRING("flag =")
PRINTSTRING(DERRS(N))
NEWLINE
END ; ! UDERRS
!
ROUTINE HEADING1
PRINTSTRING(" 0 1 2 3 4 5
")
END ; ! HEADING1
!
ROUTINE HEADING
PRINTSTRING(" filename date tape nkb chap count
")
END ; ! HEADING
!
ROUTINE PRINT ENTRY(INTEGER REL,J)
! PRINTS ENTRY NO 'J' IN OWNARRAY F
WRITE(REL+J,4); SPACES(2)
PRINTSTRING(F(J)_NAME)
SPACES(11-LENGTH(F(J)_NAME))
SPACES(2)
PRINTSTRING(F(J)_DATE)
SPACES(2)
PRINTSTRING(F(J)_TAPE)
WRITE(F(J)_NKB,5)
WRITE(F(J)_CHAP,4)
WRITE(F(J)_FLAGS,4)
NEWLINE
END ; ! PRINT ENTRY
!
EXTERNALROUTINE ACREATE(STRING (255) S)
!***********************************************************************
! CREATES AN ARBITRARY ARCHIVE OR BACKUP ENTRY
!***********************************************************************
STRING (80) FILE,USER,TAPE,DATE
INTEGER J,NKB,TYPE,CHAP
PRINTSTRING(TYPE MESS)
NEWLINE
PROMPT("Type: ")
RDINT(TYPE)
PROMPT("User: ")
RSTRG(USER)
PROMPT("File: ")
RSTRG(FILE)
PROMPT("Date: ")
RSTRG(DATE)
PROMPT("Tape: ")
RSTRG(TAPE)
PROMPT("Chap: ")
RDINT(CHAP)
PROMPT("NKB: ")
RDINT(NKB)
J=ACREATE2(USER,TAPE,DATE,FILE,-1,NKB,CHAP,TYPE+16); ! POKE INTO DATE ORDER
UDERRS(J)
END ; ! ACREATE
!
EXTERNALROUTINE ADESTROY(STRING (255) S)
!***********************************************************************
! DESTROYS ARCHIVE OR BACKUP ENTRY
!***********************************************************************
INTEGER J,TYPE
STRING (80)USER,FILE,DATE
PRINTSTRING(TYPE MESS)
NEWLINE
PROMPT("Type: ")
RDINT(TYPE)
PROMPT("User: ")
RSTRG(USER)
PROMPT("File: ")
RSTRG(FILE)
PROMPT("Date: ")
RSTRG(DATE)
DATE="" IF DATE=".N" OR DATE=".NULL"
J=DDESTROY(USER,FILE,DATE,-1,TYPE+1)
UDERRS(J)
END ; ! ADESTROY
!
EXTERNALROUTINE AFILES(STRING (255) S)
!***********************************************************************
! PLACES A BATCH OF ENTRIES OF EITHER TYPE INTO OWNARRAY F, SETTING
! FFILENO AND FMAXREC APPROPRIATELY. LIST THEM IN FULL
!***********************************************************************
STRING (255) STYPE,USER
INTEGER J,NFILES,TYPE,FSYS
UNLESS S->USER.(",").STYPE THENC
PRINTSTRING("Form is 'AFILES <user>,A' or 'AFILES <user>,B'
") ANDRETURN
IF USER="" THEN USER=UINFS(1)
IF STYPE->STYPE.(",").S START ; ! NO DEFAULTS
FSYS=255
FINISHELSESTART
FSYS=-1
FFILENO=0
FMAXREC=512
FINISH
TYPE=0
WHILE TYPE<=MAX TYPE CYCLE
IF STYPE=ARCHTYPE(TYPE) THENEXIT
TYPE=TYPE+1
REPEAT
IF TYPE>MAX TYPE THEN PRINTSTRING("Type???
") ANDRETURN
IF FSYS=255 START
PROMPT("Fsys: ")
RDINT(FSYS)
FFSYS=FSYS; ! FOR USE OF 'MOD ARCH' WHICH CALLS THIS
FFILENO=0
PROMPT("From entry: ")
RDINT(FFILENO)
PROMPT("Maxrec(<=512): ")
RDINT(FMAXREC) UNTIL 0<FMAXREC<=512
FINISH
J=DFILENAMES(USER,F,FFILENO,FMAXREC,NFILES,FSYS,TYPE+1)
IF J#0 START
PRINTSTRING("Dfilenames ")
UDERRS(J)
RETURN
FINISH
PRINTSTRING("No of files on ".FARCHTYPE(TYPE)." =")
WRITE(NFILES,1); NEWLINE
HEADING UNLESS NFILES=0
WHILE J<FMAXREC CYCLE
PRINT ENTRY(FFILENO,J)
J=J+1
REPEAT
END ; ! AFILES
!
EXTERNALROUTINE MOVE ARCHIVE INDEX(STRING (255) S)
!***********************************************************************
! MOVES AN ENTIRE ARCHIVE INDEX BY COPYING OUT ALL ENTRIES, RENAMING #ARCH,
! CREATING A NEW ONE AND REINSERTING ENTRIES
!***********************************************************************
INTEGER I,J,FILENO,MAXREC,NFILES,FAD,FSYS,CFAD,TYPE,FLAG
RECORD (AINFF)ARRAYFORMAT FF(0:PROGMAX-1)
RECORD (AINFF)ARRAYNAME F,C
RECORD (AINFF)NAME G
STRING (80) USER
IF EXIST("SS#ARCHOUT")#0 START
PRINTSTRING("File SS#ARCHOUT, to copy the filenames into, already exists.
")
RETURN
FINISH
! Set up a NEW file "SS#ARCHOUT" for all the archive info.
FAD=NWFILEAD("SS#ARCHOUT",64); ! 256K, ENOUGH FOR 6400 FILES!
RETURN IF FAD=0
! Also a new file SS#NEWARCH for comparison after the move
CFAD=NWFILEAD("SS#NEWARCH",64)
RETURN IF CFAD=0
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
! Get the filenames and info. Archive first then backup
NFILES=0
FOR TYPE=1,1,2 CYCLE
FILENO=0
MAXREC=PROGMAX-NFILES
F==ARRAY(FAD+40+NFILES*AINFFLEN,FF)
FLAG=DFILENAMES(USER,F,FILENO,MAXREC,NFILES,FSYS,TYPE)
PRINTSTRING("Dfilenames ")
UDERRS(FLAG)
RETURN IF FLAG#0
PRINTSTRING("Number of ".FARCHTYPE(TYPE-1)." entries=")
WRITE(NFILES,0); NEWLINE
INTEGER(FAD+28+TYPE<<2)=NFILES; ! ie words 1 and 2 after hdr
IF NFILES>MAXREC START
PRINTSTRING("Too many entries for this program to handle.
")
DISCONNECT("SS#ARCHOUT",FLAG)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect SS#ARCHOUT ")
UDERRS(FLAG)
FINISH
RETURN
FINISH
REPEAT
DISCONNECT("SS#ARCHOUT",FLAG)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect SS#ARCHOUT ")
UDERRS(FLAG)
RETURN
FINISH
! DFILENAMES disconnects so we are ready to rename.
FLAG=DRENAME(USER,"#ARCH","COPYARCH",FSYS)
PRINTSTRING("Rename archindex to ""COPYARCH"" ")
UDERRS(FLAG)
RETURN IF FLAG#0
! Re-connnect file of archive info
FAD=RDFILEAD("SS#ARCHOUT")
RETURN IF FAD=0
FLAG=DNEW ARCH INDEX(USER,FSYS,4)
! MINIMUM SIZE. WILL BE EXTENDED AS NEC AT ACREATES BELOW.
PRINTSTRING("Dnew arch index ")
UDERRS(FLAG)
RETURN IF FLAG#0
! Re-enter all the archive info.
NFILES=0
FOR TYPE=1,1,2 CYCLE
F==ARRAY(FAD+40+NFILES*AINFFLEN,FF)
J=INTEGER(FAD+28+TYPE<<2)
NFILES=J
WHILE J>0 CYCLE
J=J-1
G==F(J)
FLAG=ACREATE2(USER,G_TAPE,G_DATE,G_NAME,FSYS,G_NKB,G_CHAP,TYPE-1)
IF FLAG#0 START
PRINTSTRING("Acreate ")
UDERRS(FLAG)
PRINTSTRING("for ".FARCHTYPE(TYPE-1)." file: ")
PRINTSTRING(G_NAME)
NEWLINE
FINISH
REPEAT
REPEAT
! Now verify that new info matches old.
NFILES=0
FOR TYPE=1,1,2 CYCLE
FILENO=0
MAXREC=PROGMAX-NFILES
C==ARRAY(CFAD+40+NFILES*AINFFLEN,FF)
FLAG=DFILENAMES(USER,C,FILENO,MAXREC,NFILES,FSYS,TYPE)
PRINTSTRING("Dfilenames ")
UDERRS(FLAG)
RETURNIF FLAG#0
PRINTSTRING("Number of ".FARCHTYPE(TYPE-1)." entries= ")
WRITE(NFILES,1); NEWLINE
INTEGER(CFAD+28+TYPE<<2)=NFILES
IF NFILES#INTEGER(FAD+28+TYPE<<2) THEN ->ERR
REPEAT
MAXREC=INTEGER(FAD+32)+INTEGER(FAD+36)
F==ARRAY(FAD+40,FF)
C==ARRAY(CFAD+40,FF)
J=0
WHILE J<MAXREC CYCLE
FOR I=0,1,AINFFLEN-5 CYCLE ; ! NOT FLAGS FIELD WHICH IS CREATED ZERO AND UPDATED BY DRESTORE
IF BYTEINTEGER(ADDR(F(J))+I)#BYTEINTEGER(ADDR(C(J))+I) THEN -> ERR
REPEAT
J=J+1
REPEAT
PRINTSTRING("Transfer of arhive index complete.
")
RETURN
ERR:
PRINTSTRING("Comparison of old and new archive indexes fails.
")
END ; ! MOVE ARCHIVE INDEX
!
EXTERNALROUTINE RESTORE ARCHIVE INDEX(STRING (255) S)
!***********************************************************************
! DOES THE SECOND HALF OD 'MOVE ARCHIVE INDEX, PUTTING BACK ALL THE ENTRIES
! INTO EN EXISTING (EMPTY?) #ARCH, FROM AN EXISTING FILE.
!***********************************************************************
INTEGER FLAG
INTEGER I,J,FILENO,MAXREC,NFILES,FAD,FSYS,CFAD,TYPE
RECORD (AINFF)ARRAYFORMAT FF(0:PROGMAX-1)
RECORD (AINFF)ARRAYNAME F,C
RECORD (AINFF)NAME G
STRING (80) USER
IF EXIST("SS=ARCHOUT")#0 START
PRINTSTRING("File SS#ARCHOUT does not exist.
")
RETURN
FINISH
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
! connnect file of archive info
FAD=RDFILEAD("SS#ARCHOUT")
RETURN IF FAD=0
! Also a new file SS#NEWARCH for comparison after the move
CFAD=NWFILEAD("SS#NEWARCH",64)
RETURN IF CFAD=0
! Re-enter all the archive info.
PRINTSTRING("File describes")
WRITE(INTEGER(FAD+32),1)
PRINTSTRING(" archive files and")
WRITE(INTEGER(FAD+36),1)
PRINTSTRING(" backup files.
")
! Reenter
NFILES=0
FOR TYPE=1,1,2 CYCLE
F==ARRAY(FAD+40+NFILES*AINFFLEN,FF)
J=INTEGER(FAD+28+TYPE<<2)
NFILES=J
WHILE J>0 CYCLE
J=J-1
G==F(J)
FLAG=ACREATE2(USER,G_TAPE,G_DATE,G_NAME,FSYS,G_NKB,G_CHAP,TYPE-1)
IF FLAG#0 START
PRINTSTRING("Acreate ")
UDERRS(FLAG)
PRINTSTRING(" for ".FARCHTYPE(TYPE-1)." file: ")
PRINTSTRING(G_NAME)
NEWLINE
FINISH
REPEAT
REPEAT
! Now verify that new info matches old.
NFILES=0
FOR TYPE=1,1,2 CYCLE
FILENO=0
MAXREC=PROGMAX-NFILES
C==ARRAY(CFAD+40+NFILES*AINFFLEN,FF)
FLAG=DFILENAMES(USER,C,FILENO,MAXREC,NFILES,FSYS,TYPE)
PRINTSTRING("Dfilenames ")
UDERRS(FLAG)
RETURNIF FLAG#0
PRINTSTRING("Number of ".FARCHTYPE(TYPE-1)." entries= ")
WRITE(NFILES,1); NEWLINE
INTEGER(CFAD+28+TYPE<<2)=NFILES
IF NFILES#INTEGER(FAD+28+TYPE<<2) THEN ->ERR
REPEAT
MAXREC=INTEGER(FAD+32)+INTEGER(FAD+36)
F==ARRAY(FAD+40,FF)
C==ARRAY(CFAD+40,FF)
J=0
WHILE J<MAXREC CYCLE
FOR I=0,1,AINFFLEN-5 CYCLE ; ! NOT FLAGS FIELD WHICH ARE CREATED ZERO AND UPDATED BY DRESTORE
IF BYTEINTEGER(ADDR(F(J))+I)#BYTEINTEGER(ADDR(C(J))+I) THEN -> ERR
REPEAT
J=J+1
REPEAT
PRINTSTRING("Restore of arhive index complete.
")
RETURN
ERR:
PRINTSTRING("Comparison of old and new archive indexes fails.
")
END ; ! RESTORE ARCHIVE INDEX
!
EXTERNALROUTINE CREATE ARCH INDEX(STRING (255) S)
!***********************************************************************
! CREATES A NEW ONE
!***********************************************************************
INTEGER FSYS,J,KBYTES
STRING (80) USER
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
PROMPT("Kbytes: ")
RDINT(KBYTES) UNTIL KBYTES>=4
KBYTES=((KBYTES+3)>>2)<<2
J=DNEW ARCH INDEX(USER,FSYS,KBYTES)
UDERRS(J)
END ; ! CREATE ARCH INDEX
!
EXTERNALROUTINE MOD ARCH(STRING (255) S)
!***********************************************************************
! MODIFIES AN ENTRY - TAPE, CHAP, NKB OR FLAGS. NOT NAME OR DATE WHICH
! IDENTIFY THE ENTRY. ALSO ALLOWS AN ARBITRARY INTEGER TO BE PLANTED
! ANYWHERE IN THE #ARCH.
!***********************************************************************
SWITCH MOD(-2:5)
INTEGER ENT,J,NKB,ITEM,CHAP,FSYS,TYPE,FLAGS
STRING (80) TAPE,DATE,USER,FILE,WORK
RECORD (AINFF) NEWENT
PROMPT("User: ")
RSTRG(USER)
PRINTSTRING(TYPE MESS.PLANT MESS)
NEWLINE
PROMPT("Type: ")
RDINT(TYPE)
IF TYPE=2 START
PROMPT("Fsys: ")
RDINT(FSYS)
PROMPT("Rel address: ")
RDINT(NKB)
CHAP=0
IF NKB>=0 START
PROMPT("Plant value: ")
RDINT(CHAP)
FINISH
NEWENT=0
NEWENT_NKB=NKB
NEWENT_CHAP=CHAP
J=DMOD ARCH(USER,"","",NEWENT,FSYS,0)
! FILE="" TO GET PLANT OPTION IN DMOD ARCH. DATE AND TYPE ARE IRRELEVANT
UDERRS(J)
RETURN
FINISH
! SO NOT PLANT
IF TYPE=0 THEN WORK=USER.",A," ELSE WORK=USER.",B,"
FILE=""
AFILES(WORK); ! PUTS A BATCH IN F, SETTING FFILENO AND MAXREC, AND DISPLAYS THEM
FSYS=FFSYS; ! ALSO SET BY AFILES
NEXT ENTRY:
PRINTSTRING("Entry number <0 to quit")
NEWLINE
PROMPT("Entry no: ")
RDINT(ENT)
IF ENT<0 THENRETURN
IF FFILENO<=ENT<FFILENO+FMAXREC START
ENT=ENT-FFILENO; ! RELATIVE IN BUFFER
FINISHELSESTART
PRINTSTRING("Must be in range displayed")
NEWLINE
->NEXT ENTRY
FINISH
HEADING
HEADING1
PRINT ENTRY(FFILENO,ENT)
NEWENT=F(ENT)
PRINTSTRING("(-1 terminates & calls dmod arch, -2 for next entry)
")
MORE CHANGES:
PROMPT("Change item no: ")
RDINT(ITEM) UNTIL -2<=ITEM<=5
-> MOD(ITEM)
!
MOD(-2): ! QUIT (NO ACTION)
->NEXT ENTRY
!
MOD(-1): ! CALL DMOD ARCH
FILE=F(ENT)_NAME
DATE=F(ENT)_DATE
J=DMOD ARCH(USER,FILE,DATE,NEWENT,FSYS,TYPE)
UDERRS(J)
->NEXT ENTRY
!
MOD(2): ! TAPE
PROMPT("Tape or ""SKIP"": ")
RSTRG(TAPE)
NEWENT_TAPE=TAPE IF TAPE#"SKIP"
-> MORE CHANGES
!
MOD(3): ! NKB
PROMPT("NKB(or 0 to skip): ")
RDINT(NKB)
NEWENT_NKB=NKB IF NKB#0
-> MORE CHANGES
!
MOD(4): ! CHAP
PROMPT("Chap (or 0 to skip): ")
RDINT(CHAP)
NEWENT_CHAP=CHAP IF CHAP#0
-> MORE CHANGES
!
MOD(5): ! FLAGS
PROMPT("Flags (not 1-127 to skip): ")
RDINT(FLAGS)
NEWENT_FLAGS=FLAGS IF 0<=FLAGS<=127
->MORE CHANGES
!
MOD(1):
MOD(0):
PRINTSTRING("You can't change that !
")
-> MORE CHANGES
END ; ! MOD ARCH
!
EXTERNALROUTINE ARESTORE(STRING (255) S)
!***********************************************************************
! ISSUES A RESTORE REQUEST
!***********************************************************************
STRING (80) FILE,DATE,USER
INTEGER J
PROMPT("User: ")
RSTRG(USER)
PROMPT("File: ")
RSTRG(FILE)
PROMPT("Date: ")
RSTRG(DATE)
DATE="" IF DATE=".N"
J=DRESTORE(USER,FILE,DATE,-1,0)
UDERRS(J)
END ; ! ARESTORE
!
EXTERNALROUTINE ARCHPERMIT(STRING (25) S)
!***********************************************************************
! SETS PERMSSIONS ON AN ENTRY
!***********************************************************************
STRING (80) OWNER,TO USER,DATE,FILE
INTEGER PRM,J,K,TYPE
RECORD (PFF) PF
!
ROUTINE PRINTLIST(INTEGER SYM)
INTEGER J,K,IX
J=PF_BYTES RETURNED
K=16
IX=0
WHILE K<J CYCLE
PRINTSYMBOL('+') IF SYM#0
PRINTSTRING(PF_PRMS(IX)_USER)
WRITE(PF_PRMS(IX)_UPRM,1); NEWLINE
K=K+8
IX=IX+1
REPEAT
END ; ! PRINTLIST
!
DATE=""
PROMPT("Owner: ")
RSTRG(OWNER)
PROMPT("File/.ALL: ")
RSTRG(FILE)
IF FILE#".ALL" START
PROMPT("Date: ")
RSTRG(DATE)
DATE="" IF DATE=".N" OR DATE=".NULL"
FINISH
PROMPT("To user/.ALL: ")
RSTRG(TOUSER)
IF TOUSER=OWNER START
PRINTSTRING("No ownp for archive entries.
")
RETURN
FINISH
IF FILE= ".ALL"=TO USER START
PRINTSTRING("No general whole-indes perm.
")
RETURN
FINISH
PROMPT("Prm,-1=cncl: ")
RDINT(PRM) UNTIL -1<=PRM<=7
IF FILE#".ALL" START
TYPE=2
IF PRM<0 THEN TYPE=3
FINISH ELSE START
TYPE=6
IF PRM<0 THEN TYPE=7
FINISH
IF TO USER=".ALL" THEN TYPE=1
IF PRM<0 START
! WITH DRAW PERMISSION
UNLESS 2<=TYPE<=3 OR 6<=TYPE<=7 START
PRINTSTRING("Cannot have -ve permission except for cncelling.
")
RETURN
FINISH
FINISH
J=DPERMISSION(OWNER,TO USER,DATE,FILE,-1,16+TYPE,PRM)
PRINTSTRING("Dpermission set")
UDERRS(J)
! GET INDEX PERMISSIONS
J=DPERMISSION(OWNER,"","","",-1,16+8,ADDR(PF))
IF J=0 START
PRINTLIST('+')
FINISH ELSE START
PRINTSTRING("Dpermission get index ")
UDERRS(J)
FINISH
! GET FILE-PERMISSIONS (IF RELEVANT)
RETURN IF FILE=".ALL"
J=DPERMISSION(OWNER,"",DATE,FILE,-1,16+4,ADDR(PF))
IF J=0 START
PRINTLIST(0)
FINISH ELSE START
PRINTSTRING("Dpermssion get file ")
UDERRS(J)
FINISH
END ; ! ARCHPERMIT
!
externalroutine clear arch perms(string (255) s)
!***********************************************************************
! clear all individual arch file perms
!***********************************************************************
record (ainff)name ent
integer filenum,maxrec,nfiles,fsys,flag,i,prm
string (80) user
!
prompt("User: ")
rstrg(user)
prompt("On fsys: ")
rdint(fsys)
prm=0
filenum=0
nfiles=1
while filenum<nfiles cycle
maxrec=512
flag=dfilenames(user,f,filenum,maxrec,nfiles,fsys,1)
unless flag=0 start
printstring("Dfilenames ".user." ")
uderrs(flag)
return
finish
if filenum=0 start ; ! first batch only
printstring(itos(nfiles)." archive entries.")
newline
finish
if maxrec=0 thenreturn ; ! none
for i=maxrec-1,-1,0 cycle
ent==f(i)
flag=dpermission(user,"",ent_date,ent_name,fsys,16+5,prm)
if flag=0 then flag=dpermission(user,"",ent_date,ent_name,fsys,16+1,prm)
if flag#0 start
printstring("dpermission ")
uderrs(flag)
printstring("for entry:")
newline
print entry(filenum,i)
finish
repeat
filenum=filenum+maxrec
repeat
!
printstring("Done.")
newline
!
end ; ! end clear arch perms
!
EXTERNALROUTINE PRINT ARCH(STRING (255) S)
!***********************************************************************
! PRINTS ENTIRE CONTENTS AF INDEX
!***********************************************************************
RECORD (FF)NAME AF
RECORD (AFDF)ARRAYNAME AFDS
RECORD (AFDF)NAME AFD
RECORD (PDSF)ARRAYNAME PDS
RECORD (PDSF)NAME PD
INTEGER AINDAD,FLAG,SEG,GAP,NFDS,I,J,FREE,K,FSYS
CONSTSTRING (3)ARRAY TYPES(0:1)="(A)","(B)"
STRING (80)USER
!
ROUTINE WRITEP(BYTEINTEGER P)
! WRITES PERMISIION LIST
CONSTSTRING (1)ARRAY PS(0:2)="R","W","E"
INTEGER I
PRINTSTRING(":")
IF P=0 THEN PRINTSTRING("N") ANDRETURN
FOR I=0,1,2 CYCLE
IF (P>>I)&1#0 THEN PRINTSTRING(PS(I))
REPEAT
SPACE
END ; ! INE WRITEP
!
STRINGFN UNCDT(INTEGER I)
! DECODES DATE
STRING (3) D,M
D=ITOS(I&31)
IF LENGTH(D)=1 THEN D="0".D
M=ITOS((I>>5)&15)
IF LENGTH(M)=1 THEN M="0".M
RESULT =D."/".M."/".ITOS(70+(I>>9)&63)
END ; ! UNCDT
!
STRINGFN I TO TSN(INTEGER TSN)
! DECODES TAPENAME
INTEGER J,CH
LONGINTEGER LTSN,T
STRING (6) S
*LSS_TSN
*LUH_0
*ST_LTSN
FOR J=6,-1,1 CYCLE
T=LTSN//36
CH=SHORTENI(LTSN-36*T)
IF CH<10 THEN CH=CH+'0' ELSE CH=CH+55
CHARNO(S,J)=CH
LTSN=T
REPEAT
LENGTH(S)=6
RESULT =S
END ; ! FN I TO TSN
!
IF S="" THEN S=".OUT"
DEFINE("1,".S)
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
SEG=0
GAP=0
FLAG=DCONNECT(USER,"#ARCH",FSYS,1,0,SEG,GAP)
UNLESS FLAG=0 START
PRINTSTRING("Connect ")
UDERRS(FLAG)
RETURN
FINISH
AINDAD=SEG<<18
AF==RECORD(AINDAD)
SELECTOUTPUT(1)
PRINTSTRING("Print arch of ".USER)
PRINTSTRING("
--------------------
")
PRINTSTRING("Archive entries=")
WRITE(AF_FILES0,0)
PRINTSTRING(" Backup entries=")
WRITE(AF_FILES1,0)
NEWLINES(2)
NFDS=(AF_MAXFILE-AF_FDSTART)//FDSIZE
AFDS==ARRAY(AINDAD+AF_FDSTART,AFDSF)
PDS==ARRAY(AINDAD+AF_PDSTART,PDSF)
J=0
FREE=0
PRINTSTRING("Total fds=")
WRITE(NFDS,0)
NEWLINES(2)
PRINTSTRING(C
" filename date tape eps chap count restored eep perms...
")
PRINTSTRING(C
" -------- ---- ---- --- ---- ----- -------- --- -----
")
FOR I=NFDS,-1,1 CYCLE
AFD==AFDS(I)
IF AFD_NAME="" OR AFD_NAME=".NULL" THEN FREE=FREE+1 ANDCONTINUE
J=J+1
WRITE(J,4); SPACES(2)
PRINTSTRING(TYPES(AFD_TYPE)); SPACE
PRINTSTRING(AFD_NAME); SPACES(13-LENGTH(AFD_NAME))
PRINTSTRING(UNCDT(AFD_DATE)); SPACES(2)
PRINTSTRING(ITOTSN(AFD_TSN))
WRITE(AFD_PGS,5)
WRITE(AFD_CHAP,4)
WRITE(AFD_COUNT,5); SPACE
PRINTSTRING(UNCDT(AFD_LAST RESTORE))
WRITE(AFD_EEP,3); SPACE
K=AFD_PHEAD
WHILE K#0 CYCLE
PD==PDS(K)
PRINTSTRING(PD_NAME)
WRITEP(PD_PERM)
K=PD_LINK
REPEAT
NEWLINE
REPEAT
NEWLINE
PRINTSTRING("Unused fds=")
WRITE(FREE,0)
NEWLINES(2)
SELECTOUTPUT(0)
FLAG=DDISCONNECT(USER,"#ARCH",FSYS,0)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect ")
UDERRS(FLAG)
FINISH
END ; ! PRINT ARCH
!
EXTERNALROUTINE DUMP ARCH(STRING (255) S)
!***********************************************************************
! DUMPS ENTIRE INDEX IN HEX
!***********************************************************************
RECORD (FF)NAME AF
STRING (80) USER
INTEGER SEG,GAP,FSYS,FLAG,AINDAD
IF S="" THEN S=".OUT"
DEFINE("1,".S)
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
SEG=0; GAP=0
FLAG=DCONNECT(USER,"#ARCH",FSYS,1,0,SEG,GAP)
UNLESS FLAG=0 START
PRINTSTRING("Connect ")
UDERRS(FLAG)
RETURN
FINISH
AINDAD=SEG<<18
AF==RECORD(AINDAD)
SELECTOUTPUT(1)
PRINTSTRING("Dump arch of ".USER)
PRINTSTRING("
-------------------
")
DUMP(AINDAD,AINDAD+(AF_MAXFILE),AINDAD,32)
SELECTOUTPUT(0)
FLAG=DDISCONNECT(USER,"#ARCH",FSYS,0)
UNLESS FLAG=0 THEN PRINTSTRING("Disconnect ") AND UDERRS(FLAG)
END ; ! ROUTINE DUMP ARCH
!
EXTERNALROUTINE MERGE ARCH(STRING (255) S)
!***********************************************************************
! MERGES ARCHIVE ENTRIES FROM ONE USER TO ANOTHER.
! THE ORIGINAL USER IS UNAFFECTED.
!***********************************************************************
RECORD (AINFF)NAME ENT
INTEGER FILENUM,MAXREC,NFILES,FROM FSYS,TOFSYS,FLAG,I,TOT
STRING (80) FROM USER, TO USER
!
PROMPT("From user: ")
RSTRG(FROM USER)
PROMPT("On fsys: ")
RDINT(FROM FSYS)
PROMPT("Into user: ")
RSTRG(TO USER)
PROMPT("On fsys: ")
RDINT(TO FSYS)
IF FROM USER=TO USER AND FROM FSYS=TO FSYS START
PRINTSTRING("Not the same user, surely ?")
NEWLINE
RETURN
FINISH
!
TOT=0
FILENUM=0
NFILES=1
WHILE FILENUM<NFILES CYCLE
MAXREC=512
FLAG=DFILENAMES(FROM USER,F,FILENUM,MAXREC,NFILES,FROM FSYS,1)
UNLESS FLAG=0 START
PRINTSTRING("Dfilenames ".FROM USER." ")
UDERRS(FLAG)
RETURN
FINISH
IF FILENUM=0 START ; ! FIRST BATCH ONLY
PRINTSTRING(ITOS(NFILES)." entries to be transferred.")
NEWLINE
FINISH
IF MAXREC=0 THENRETURN ; ! NONE
FOR I=MAXREC-1,-1,0 CYCLE
! SINCE DFILENAMES DELIVERS THEM MOST RECENT FIRST,
! REVERSE ORDER HELPS WHEN THE RECEIVING #ARCH IS EMPTY.
ENT==F(I)
FLAG=ACREATE2(TO USER,ENT_TAPE,ENT_DATE,ENT_NAME,TO FSYS,ENT_NKB,ENT_CHAP,16)
! POKE ENTRY TO MAINTAIN DATE ORDER WITH EXISTING ENTRIES.
IF FLAG#0 START
PRINTSTRING("Acreate ")
UDERRS(FLAG)
PRINTSTRING("for entry:")
NEWLINE
PRINT ENTRY(FILENUM,I)
FINISHELSE TOT=TOT+1
REPEAT
FILENUM=FILENUM+MAXREC
REPEAT
!
PRINTSTRING(ITOS(TOT)." entries successfully transferred.")
NEWLINE
!
END ; ! END MERGE ARCH
!
EXTERNALROUTINE COPYARCHIN(STRING (255) S)
!***********************************************************************
! COPIES ENTIRE INDEX INTO A FILE WITH A STANDARD SS HEADER. IT CAN THEN BE
! #CONNECTED, OR WHACKED DOWN THE WIRE ETC
!***********************************************************************
STRING (80) USER,FILE
INTEGER SEG,GAP,FSYS,FLAG,AINDAD,CAD,PGS,ARCHSIZE
RECORD (FF)NAME AF
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
PROMPT("To file: ")
RSTRG(FILE)
IF EXIST(FILE)#0 START
PRINTSTRING(FILE." already exists")
NEWLINE
RETURN
FINISH
SEG=0
GAP=0
FLAG=DCONNECT(USER,"#ARCH",FSYS,1,0,SEG,GAP)
UNLESS FLAG=0 START
PRINTSTRING("Connect #ARCH")
UDERRS(FLAG)
RETURN
FINISH
AINDAD=SEG<<18
AF==RECORD(AINDAD)
ARCHSIZE=AF_SIZE<<9
PGS=(ARCHSIZE+4095)>>12 +1
CAD=NWFILEAD(FILE,PGS)
->OUT IF CAD=0
INTEGER(CAD)=PGS<<12
INTEGER(CAD+4)=32
INTEGER(CAD+8)=PGS<<12
INTEGER(CAD+12)=3
MOVE(ARCHSIZE,AINDAD,CAD+32)
OUT:
DISCONNECT(FILE,FLAG)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect ".FILE." ")
UDERRS(FLAG)
FINISH
FLAG=DDISCONNECT(USER,"#ARCH",FSYS,0)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect #ARCH ")
UDERRS(FLAG)
FINISH
END ; ! ROUTINE COPYARCHIN
!
EXTERNALROUTINE EXTRACTARCH(STRING (255) S)
!***********************************************************************
! OPPOSITE OF COPYARCHIN
!***********************************************************************
STRING (80) USER,FILE
INTEGER CAD,FSYS,FLAG,ARCHKB,SEG,GAP,AINDAD
RECORD (FF)NAME AF
PROMPT("From file: ")
RSTRG(FILE)
CAD=RDFILEAD(FILE)
RETURNIF CAD=0
AF==RECORD(CAD+32)
ARCHKB=AF_SIZE>>1
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
FLAG=DNEW ARCH INDEX(USER,FSYS,ARCHKB)
UNLESS FLAG=0 START
PRINTSTRING("Dnew arch index ")
UDERRS(FLAG)
->OUT
FINISH
FLAG=ACREATE2("","","","",FSYS,0,0,0); ! DISCONNECT #ARCH
UNLESS FLAG=0 START
PRINTSTRING("Acreate null ")
UDERRS(FLAG)
->OUT
FINISH
SEG=0
GAP=0
FLAG=DCONNECT(USER,"#ARCH",FSYS,3,0,SEG,GAP)
UNLESS FLAG=0 START
PRINTSTRING("Dconnect #ARCH ")
UDERRS(FLAG)
->OUT
FINISH
AINDAD=SEG<<18
MOVE(ARCHKB<<10,CAD+32,AINDAD)
FLAG=DDISCONNECT(USER,"#ARCH",FSYS,0)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect #ARCH ")
UDERRS(FLAG)
FINISH
OUT:
DISCONNECT(FILE,FLAG)
UNLESS FLAG=0 START
PRINTSTRING("Disconnect ".FILE." ")
UDERRS(FLAG)
FINISH
END ; ! ROUTINE EXTRACTARCH
!
EXTERNALROUTINE RESET CHECKSUM(STRING (255) S)
!***********************************************************************
! FORCES CHECKSUM CORRECT
!***********************************************************************
STRING (80) USER
RECORD (AINFF) ENT
INTEGER FLAG,FSYS
PROMPT("User: ")
RSTRG(USER)
PROMPT("Fsys: ")
RDINT(FSYS)
ENT=0
ENT_NKB=-1
FLAG=DMODARCH(USER,"","",ENT,FSYS,0)
! PLANT ENTRY, BUT NO PLANT.
UDERRS(FLAG)
END ; ! RESET CHECKSUM
!
ENDOFFILE