!***********************************************************************
!*
!* Utility commands for managing public files
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXI
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Site-dependent constants
!*
!***********************************************************************
!
CONSTBYTEINTEGER RESTRICTED = 0, UNRESTRICTED = 1
CONSTINTEGER LOGFILE IDENTITY = X'FFFFFF06'; ! Needed by JOURNAL system
CONSTINTEGER DEFAULT LOG COPIES = 2; ! Number of extra copies of logfile
CONSTINTEGER MAX VALID USERS = 5
CONSTSTRING (11) LOGFILE = "UPDATELOG"
CONSTBYTEINTEGERARRAY USER TYPES(1:MAX VALID USERS) = C
UNRESTRICTED,
RESTRICTED,
UNRESTRICTED,
UNRESTRICTED,
RESTRICTED
CONSTSTRING (6)ARRAY VALID USERS(1:MAX VALID USERS) = C
"PUBLIC",
"PUBSRC",
"PUBTXT",
"UKCLIB",
"UKCSRC"
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
CONSTINTEGER NO = 0, YES = 1
CONSTINTEGER SSCHARFILETYPE = 3
CONSTINTEGER MAXF = 200; ! Max number of files summarised
CONSTINTEGER MAXBF = 500; ! Max number of backup entries examined
CONSTINTEGER MAX LOG COPIES = 15; ! Max number of extra copies of logfile
CONSTSTRING (1) SNL = "
"
CONSTSTRING (10) TEMPLOGFILE = "T#LOGFILE"
CONSTSTRING (6) UDNAME = "UPDATE"
CONSTINTEGER UDKEYMAX = 4; ! Number of parameter keywords for UPDATE
CONSTSTRING (7)ARRAY UDKEYS(1:UDKEYMAX) = C
"FROM",
"TO",
"TYPE",
"VERSION"
CONSTSTRING (14) PLNAME = "PRINTUPDATELOG"
CONSTINTEGER PLKEYMAX = 2; ! Number of parameter keywords for PRINTUPDATELOG
CONSTSTRING (9)ARRAY PLKEYS(1:PLKEYMAX) = C
"SUMMARIES",
"LOGCOPIES"
CONSTSTRING (8) DDNAME = "DOWNDATE"
CONSTINTEGER DDKEYMAX = 2; ! Number of parameter keywords for DOWNDATE
CONSTSTRING (4)ARRAY DDKEYS(1:DDKEYMAX) = C
"FILE",
"DATE"
CONSTINTEGER LUKEYMAX = 1; ! Number of parameter keywords for LOGUPDATE
CONSTSTRING (9) LUNAME = "LOGUPDATE"
CONSTSTRING (7)ARRAY LUKEYS(1:LUKEYMAX) = C
"MESSAGE"
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
RECORDFORMAT BINFF(STRING (11) NAME,INTEGER KBYTES,STRING (8) DATE,C
STRING (6) TAPE,INTEGER CHAPTER,FLAGS)
RECORDFORMAT FF(INTEGER NKB,RUP,EEP,APF,USE,ARCH,FSYS,CONSEG,C
CCT,CODES,CODES2,SSBYTE,STRING (6) OFFER)
RECORDFORMAT HF(INTEGER DATAEND,DATASTART,FILESIZE,FILETYPE,C
SUM,DATETIME,FORMAT,RECORDS)
RECORDFORMAT INFF(STRING (11) NAME,INTEGER SP12,KBYTES,BYTEINTEGER C
ARCH,CODES,CCT,OWNP,EEP,USE,CODES2,SSBYTE,FLAGS,C
SP29,SP30,SP31)
RECORDFORMAT HPF(STRING (6) TAPENAME,USERNAME,STRING (15) FILENAME,C
STRING (8) DATE,TIME,TYPE,BYTEINTEGER SPARE0,C
SPARE1,SPARE2,INTEGER CHAPTER,EPAGES,FSYS,PERMS,C
OWN,EEP,ARCH,CODES,SSBYTE,CCT,SPARE3,SPARE4,SPARE5,C
RECORDS,STRING (6) OFFERED TO)
RECORDFORMAT RF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND)
OWNRECORDARRAYFORMAT SINFF(1:MAXF)(INFF)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER,STRING (15) FILE,C
INTEGER FSYS,NKB,TYPE)
EXTERNALINTEGERFNSPEC DDESTROY(STRING (6) USER,STRING (15) FILE,C
STRING (8) DATE,INTEGER FSYS,TYPE)
EXTERNALSTRINGFNSPEC DERRS(INTEGER N)
EXTERNALINTEGERFNSPEC DFILENAMES(STRING (6) USER,C
RECORDARRAYNAME INF,C
INTEGERNAME FILENO,MAXREC,NFILES,C
INTEGER FSYS,TYPE)
EXTERNALINTEGERFNSPEC DFINFO(STRING (6) USER,STRING (11) FILE,C
INTEGER FSYS,ADR)
EXTERNALINTEGERFNSPEC DFSTATUS(STRING (6) USER,STRING (11) FILE,C
INTEGER FSYS,ACT,VALUE)
EXTERNALINTEGERFNSPEC DFSYS(STRING (6) USER,INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DMESSAGE2(STRING (6) USER,INTEGERNAME LEN,C
INTEGER ACT,INVOC,FSYS,ADR)
EXTERNALINTEGERFNSPEC DNEWGEN(STRING (6) USER,STRING (11) FILE,C
NEWGEN OF FILE,INTEGER FSYS)
EXTERNALINTEGERFNSPEC DOFFER(STRING (6) USER,OFFERTO,C
STRING (11) FILE,INTEGER FSYS)
EXTERNALINTEGERFNSPEC DPERMISSION(STRING (6) OWNER,USER,C
STRING (8) DATE,STRING (11) FILE,C
INTEGER FSYS,TYPE,ADRPRM)
EXTERNALINTEGERFNSPEC DTRANSFER(STRING (6) USER1,USER2,C
STRING (11) FILE,NEWNAME,C
INTEGER FSYS1,FSYS2,TYPE)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
SYSTEMROUTINESPEC CHANGEFILESIZE(STRING (31) FILE,C
INTEGER NEWSIZE,INTEGERNAME FLAG)
SYSTEMROUTINESPEC CONNECT(STRING (31) FILE,INTEGER MODE,HOLE,C
PROT,RECORDNAME R,INTEGERNAME FLAG)
SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE,INTEGERNAME FLAG)
SYSTEMSTRINGFNSPEC FAILUREMESSAGE(INTEGER MESS)
SYSTEMSTRINGFNSPEC ITOS(INTEGER N)
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH,FROM,TO)
SYSTEMROUTINESPEC NEWGEN(STRING (31) FILE,NEWFILE,INTEGERNAME FLAG)
SYSTEMSTRINGFNSPEC NEXTTEMP
SYSTEMROUTINESPEC OUTFILE(STRING (31) FILE,INTEGER SIZE,HOLE,C
PROT,INTEGERNAME CONAD,FLAG)
SYSTEMROUTINESPEC PERMIT(STRING (31) FILE,STRING (6) USER,C
INTEGER MODE,INTEGERNAME FLAG)
SYSTEMINTEGERFNSPEC PSTOI(STRING (63) S)
SYSTEMROUTINESPEC RENAME(STRING (31) FILE,NEWFILE,INTEGERNAME FLAG)
SYSTEMROUTINESPEC SENDFILE(STRING (31) FILE,STRING (16) DEVICE,C
STRING (11) NAME,INTEGER COPIES,FORMS,C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC SETFNAME(STRING (63) S)
!
EXTERNALROUTINESPEC CHERISH(STRING (255) S)
EXTERNALSTRINGFNSPEC DATE
EXTERNALROUTINESPEC SET RETURN CODE(INTEGER I)
EXTERNALINTEGERFNSPEC OUTPOS
EXTERNALROUTINESPEC TERMINATE
EXTERNALSTRINGFNSPEC TIME
!
!
!***********************************************************************
!*
!* External magnetic tape utility routines
!*
!***********************************************************************
!
DYNAMICROUTINESPEC ASKMT(STRING (7) VOL,INTEGERNAME FLAG)
DYNAMICROUTINESPEC REWINDMT
DYNAMICROUTINESPEC UNLOADMT
DYNAMICROUTINESPEC READMT(INTEGER AD,INTEGERNAME LEN,FLAG)
DYNAMICROUTINESPEC FSKIPTMMT(INTEGER N,INTEGERNAME FLAG)
!
!
!***********************************************************************
!*
!* Common routines
!*
!***********************************************************************
!
INTEGERFN MATCHSTRINGS(STRINGNAME A,STRING (255) B)
INTEGER L
!
L = LENGTH(A)
IF LENGTH(B) < L THEN RESULT = 0
LENGTH(B) = L
IF A = B THEN RESULT = YES ELSE RESULT = NO
END ; ! of MATCHSTRINGS
!
!
INTEGERFN PARAMDECODE(STRING (255) PARAM,INTEGER PMAX,C
STRINGARRAYNAME KEYS,PARS)
INTEGER I,PNUM,PN,RES,C,PARPTR,PARLENG
STRING (255) WKSP
!
INTEGERFN FINDKEY
INTEGER F,I
!
IF LENGTH(WKSP) = 0 THEN RESULT = -2; ! Missing keyword
F = 0
CYCLE I = 1,1,PMAX
IF MATCHSTRINGS(WKSP,KEYS(I)) = YES THEN START
UNLESS F = 0 THEN RESULT = -1
F = I
FINISH
REPEAT
RESULT = F
END ; ! of FINDKEY
!
INTEGERFN GETPAR
INTEGER C,INPR
!
INPR = 0
WKSP = ""
!
CYCLE
PARPTR = PARPTR + 1
IF PARPTR > PARLENG THEN RESULT = -1
C = CHARNO(PARAM,PARPTR)
IF C = ',' OR C = '=' THEN RESULT = C
WKSP = WKSP.TOSTRING(C)
REPEAT
END ; ! of GETPAR
!
CYCLE I = 1,1,PMAX
PARS(I) = ""; ! Initialise
REPEAT
PARPTR = 0
PNUM = 1
PARLENG = LENGTH(PARAM)
!
CYCLE
C = GETPAR
RES = 0
IF C # '=' THEN START
PN = PNUM
FINISH ELSE START
PN = FINDKEY
IF PN = 0 THEN RES = 322; ! Unknown keyword
IF PN = -1 THEN RES = 321; ! Ambiguous keyword
IF PN = -2 THEN RES = 325; ! Missing keyword
C = GETPAR
IF C = '=' THEN RES = 320; ! Format error
FINISH
IF PN > PMAX THEN RES = 323; ! Too many parameters
IF RES = 0 THEN START
IF WKSP # "" # PARS(PN) THEN RES = 324
! Duplicated parameter
PARS(PN) = WKSP
FINISH
IF RES # 0 THEN RESULT = RES
IF C = -1 THEN RESULT = 0; ! Finished, all OK
PNUM = PNUM + 1
REPEAT
END ; ! of PARAMDECODE
!
!
ROUTINE FAIL(STRING (255) MES,INTEGER N,STRING (31) OP)
SELECTOUTPUT(0)
PRINTSTRING(SNL.OP." fails - ".MES)
SET RETURN CODE(N)
STOP
END ; ! of FAIL
!
!
INTEGERFN VALIDATE FILENAME(STRINGNAME S)
INTEGER I,C
!
UNLESS 8 <= LENGTH(S) <= 18 THEN RESULT = 167
UNLESS CHARNO(S,7) = '.' THEN RESULT = 167
CYCLE I = 8,1,LENGTH(S)
C = CHARNO(S,I)
CONTINUE IF 'A' <= C <= 'Z'
RESULT = 167 IF I = 8; ! Must start with letter
UNLESS '0' <= C <= '9' OR C = '#' THEN RESULT = 167
REPEAT
RESULT = 0
END ; ! of VALIDATE FILENAME
!
!
ROUTINE SPLIT NAME(STRINGNAME S,USER,FILE)
USER = FROMSTRING(S,1,6)
FILE = FROMSTRING(S,8,LENGTH(S))
END ; ! of SPLIT NAME
!
!
ROUTINE LOCATE USER(STRING (6) USER,INTEGERNAME FSYS,STRING (31) OP)
INTEGER FLAG
!
FSYS = -1
FLAG = DFSYS(USER,FSYS)
IF FLAG = 37 THEN START ; ! Common fault - no such user
SETFNAME(USER)
FAIL(FAILUREMESSAGE(201),201,OP)
FINISH
IF FLAG # 0 THEN START ; ! Some other error
FAIL("DFSYS flag = ".DERRS(FLAG).SNL,FLAG,OP)
FINISH
END ; ! of LOCATE USER
!
!
INTEGERFN DIRTOSS(INTEGER FLAG)
CONSTINTEGER MAXDSS=83
CONSTBYTEINTEGERARRAY DSS(1:MAXDSS) = C
1,2,3,4,5,173,7,8,174,175,
11,12,13,14,176,119,176,120,19,173,
21,22,23,177,178,26,27,162,162,30,
177,118,179,34,209,176,101,156,156,178,
180,178,176,44,45,46,47,48,181,182,
183,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,
71,72,73,74,75,76,77,78,79,80,
81,82,208
!
IF FLAG = 0 THEN RESULT = 0; ! Most likely result
IF 1 <= FLAG <= MAXDSS THEN START
FLAG = DSS(FLAG)
IF FLAG < 100 THEN FLAG = FLAG+500 ELSE FLAG = FLAG+100
FINISH ELSE FLAG = FLAG+500
RESULT = FLAG
END ; ! of DIRTOSS
!
!
ROUTINE CHECK USER(STRINGNAME USER,INTEGERNAME USER TYPE,C
STRING (31) OP)
INTEGER I
!
CYCLE I = 1,1,MAX VALID USERS
IF USER = VALID USERS(I) THEN START
USER TYPE = USER TYPES(I)
RETURN
FINISH
REPEAT
FAIL("User ".USER." not a public user".SNL,1001,OP)
END ; ! of CHECK USER
!
!
ROUTINESPEC CREATE LOGFILE(STRING (31) OP)
!
ROUTINE LOG(STRING (255) S,STRING (31) OP)
INTEGER FLAG,CONAD,J,TCONAD
RECORD RR(RF)
RECORDNAME R(HF)
!
CYCLE
CONNECT(LOGFILE,1,0,0,RR,FLAG)
IF FLAG = 0 THEN EXIT
CREATE LOGFILE(OP)
REPEAT
!
S <- "DT: ".DATE." ".TIME." ".S.SNL
IF LENGTH(S) = 255 THEN CHARNO(S,255) = NL
J = LENGTH(S)
!
CONAD = RR_CONAD
R == RECORD(CONAD)
OUTFILE(TEMPLOGFILE,R_FILESIZE,0,0,TCONAD,FLAG)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,OP)
MOVE(R_DATAEND,CONAD,TCONAD); ! Make temporary copy of log file
R == RECORD(TCONAD); ! Operate on temporary copy
IF R_DATAEND + J > R_FILESIZE THEN START
CHANGEFILESIZE(TEMPLOGFILE,R_FILESIZE+4096,FLAG)
IF FLAG # 0 THEN START
SETFNAME(TEMPLOGFILE)
FAIL(FAILUREMESSAGE(FLAG),FLAG,OP)
FINISH
R_FILESIZE = R_FILESIZE + 4096
FINISH
MOVE(J,ADDR(S)+1,TCONAD+R_DATAEND)
R_DATAEND = R_DATAEND + J
NEWGEN(TEMPLOGFILE,LOGFILE,FLAG); ! Update the real logfile
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,OP)
DISCONNECT(LOGFILE,FLAG); ! To avoid NEWGEN confusion
END ; ! of LOG
!
!
ROUTINE CREATE LOGFILE(STRING (31) OP)
INTEGER CONAD,FLAG
RECORDNAME R(HF)
!
OUTFILE(TEMPLOGFILE,4096,0,0,CONAD,FLAG)
IF FLAG # 0 THEN START
FAIL(FAILUREMESSAGE(FLAG),FLAG,OP)
FINISH
R == RECORD(CONAD)
R_FILETYPE = SSCHARFILETYPE
R_FORMAT = LOGFILE IDENTITY
NEWGEN(TEMPLOGFILE,LOGFILE,FLAG)
IF FLAG # 0 THEN START
IF FLAG = 218 THEN START ; ! Creating first logfile
RENAME(TEMPLOGFILE,LOGFILE,FLAG)
CHERISH(LOGFILE)
PERMIT(LOGFILE,"",1,FLAG); ! Set EEP = R
FINISH
IF FLAG # 0 THEN START ; ! Some other error
FAIL(FAILUREMESSAGE(FLAG),FLAG,OP)
FINISH
FINISH
DISCONNECT(LOGFILE,FLAG)
LOG("*** Logfile started ***",OP)
END ; ! of CREATE LOGFILE
!
!
ROUTINE GET BACKUP LOCATION(STRING (6) USER,STRING (11) FILE,C
INTEGER FSYS,STRINGNAME TAPE,C
INTEGERNAME CHAPTER,STRING (8) BDATE)
INTEGER FLAG,MAXREC,FILENUM,NFILES,I,J
RECORDARRAY INF(0:MAXBF)(BINFF)
!
MAXREC = MAXBF
FILENUM = 0
FLAG = DFILENAMES(USER,INF,FILENUM,MAXREC,NFILES,FSYS,2)
-> NONE IF FLAG # 0
!
J = -1
-> NONE IF NFILES = 0
CYCLE I = 0,1,NFILES - 1
IF INF(I)_NAME = FILE THEN START
IF BDATE = "" OR BDATE = INF(I)_DATE THEN J = I AND EXIT
FINISH
REPEAT
IF J >= 0 THEN START
CHAPTER = INF(J)_CHAPTER
TAPE = INF(J)_TAPE
RETURN
FINISH
!
NONE:
TAPE = ""
END ; ! of GET BACKUP LOCATION
!
!
ROUTINE ASORT(RECORDARRAYNAME P,INTEGERARRAYNAME X,INTEGER NUM)
RECORDSPEC P(INFF)
INTEGER I,J,JG,K,GAP
!
RETURN IF NUM <= 0
CYCLE I = 1,1,NUM
X(I) = I
REPEAT
GAP = NUM//2
WHILE GAP > 0 CYCLE
I = GAP + 1
WHILE I <= NUM CYCLE
J = I - GAP
WHILE J > 0 CYCLE
JG = J + GAP
IF P(X(J))_NAME > P(X(JG))_NAME THEN START
K = X(J)
X(J) = X(JG)
X(JG) = K
FINISH
J = J - GAP
REPEAT
I = I + 1
REPEAT
GAP = GAP//2
REPEAT
END ; ! of ASORT
!
!
ROUTINE BANNER(STRING (6) USER)
INTEGER I,J
!
CYCLE I = 1,1,8
PRINTSTRING("|-")
CYCLE J = 1,1,12
PRINTSTRING(USER)
PRINTSTRING("-----") UNLESS J = 12
REPEAT
PRINTSTRING("-|".SNL)
REPEAT
END ; ! of BANNER
!
!
ROUTINE SUMMARISE(STRING (6) USER)
INTEGER FLAG,MAXREC,FILENUM,NFILES,I,J
INTEGERARRAY X(1:MAXF)
STRING (255) S
RECORDARRAY INF(0:MAXF)(INFF)
RECORDARRAYNAME SINF(INFF)
STRINGNAME NAME
!
MAXREC = MAXF
FILENUM = 0
FLAG = DFILENAMES(USER,INF,FILENUM,MAXREC,NFILES,-1,0)
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
SETFNAME(USER)
FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
FINISH
IF NFILES > MAXF THEN START
PRINTSTRING(SNL."*** User ".USER.C
" has too many files to summarise ***".SNL)
RETURN
FINISH
IF NFILES = 0 THEN START
PRINTSTRING(SNL."*** User ".USER." has no files ***".SNL)
RETURN
FINISH
!
SINF == ARRAY(ADDR(INF(0)),SINFF)
ASORT(SINF,X,NFILES)
NEWPAGE
BANNER(USER)
NEWLINES(3)
S = "Summary of user ".USER." on ".DATE." at ".TIME
I = (132-LENGTH(S))//2
SPACES(I)
PRINTSTRING(S.SNL)
SPACES(I)
CYCLE I = 1,1,LENGTH(S)
PRINTSYMBOL('-')
REPEAT
NEWLINES(3)
J = 0
CYCLE I = 1,1,NFILES
NAME == SINF(X(I))_NAME
CONTINUE IF CHARNO(NAME,1) = '#'
CONTINUE IF NAME -> ("T#").NAME
CONTINUE IF NAME -> ("SS#").NAME
PRINTSTRING(NAME)
J = J + 20
IF J > 132 OR I = NFILES THEN START
NEWLINE
J = 0
FINISH ELSE START
SPACES(J-OUTPOS)
FINISH
REPEAT
NEWLINES(3)
BANNER(USER)
END ; ! of SUMMARISE
!
!
!***********************************************************************
!*
!* U P D A T E
!*
!***********************************************************************
!
EXTERNALROUTINE UPDATE(STRING (255) S)
STRINGNAME FROM,TO,VERSION,TYPE
INTEGER FLAG,I,FROMFSYS,TOFSYS,NG,CHAPTER,USER TYPE,NEW
STRING (6) FROMUSER,TOUSER,TAPE
STRING (11) FROMFILE,TOFILE,TFILE
STRING (255) MES
STRING (255)ARRAY OPTIONS(1:UDKEYMAX)
RECORD INF(FF)
!
SET RETURN CODE(1000); ! In case of catastrophic failure
FLAG = PARAMDECODE(S,UDKEYMAX,UDKEYS,OPTIONS)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FROM == OPTIONS(1)
TO == OPTIONS(2)
TYPE == OPTIONS(3)
VERSION == OPTIONS(4)
IF LENGTH(VERSION) > 15 THEN LENGTH(VERSION) = 15
!
CYCLE I = 1,1,2
IF OPTIONS(I) = "" THEN START
FAIL(FAILUREMESSAGE(263),263,UDNAME); ! Wrong number of parameters
FINISH
IF LENGTH(OPTIONS(I)) > 31 THEN LENGTH(OPTIONS(I)) = 31
FLAG = VALIDATE FILENAME(OPTIONS(I))
IF FLAG # 0 THEN START
SETFNAME(OPTIONS(I))
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
REPEAT
!
IF TYPE = "" OR MATCHSTRINGS(TYPE,"NEW") = YES THEN START
NEW = YES
FINISH ELSE START
IF MATCHSTRINGS(TYPE,"REPLACE") = YES THEN START
NEW = NO
FINISH ELSE START
SETFNAME(OPTIONS(3))
FAIL(FAILUREMESSAGE(202),202,UDNAME)
FINISH
FINISH
!
SPLIT NAME(FROM,FROMUSER,FROMFILE)
SPLIT NAME(TO,TOUSER,TOFILE)
!
LOCATE USER(FROMUSER,FROMFSYS,UDNAME)
LOCATE USER(TOUSER,TOFSYS,UDNAME)
CHECK USER(TOUSER,USER TYPE,UDNAME)
!
! Get information on 'from' file
!
SETFNAME(FROM)
FLAG = DFINFO(FROMUSER,FROMFILE,FROMFSYS,ADDR(INF))
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
IF INF_CONSEG # 0 THEN START ; ! File is connected
DISCONNECT(FROM,FLAG); ! Ignore flag
FLAG = DFINFO(FROMUSER,FROMFILE,FROMFSYS,ADDR(INF)); ! Update INF
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
FINISH
IF INF_USE # 0 THEN START ; ! File is in use
FAIL(FAILUREMESSAGE(279),279,UDNAME)
FINISH
IF INF_OFFER # "" THEN START ; ! File is on OFFER
UNLESS INF_OFFER = TOUSER THEN START
FAIL(FAILUREMESSAGE(273),273,UDNAME)
FINISH
FLAG = DOFFER(FROMUSER,"",FROMFILE,FROMFSYS); ! Revoke the OFFER
FINISH
!
! Get information on 'to' file
!
SETFNAME(TO)
FLAG = DFINFO(TOUSER,TOFILE,TOFSYS,ADDR(INF))
IF 0 # FLAG # 32 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
IF FLAG = 0 THEN START ; ! File already exists
IF NEW = YES THEN FAIL(FAILUREMESSAGE(219),219,UDNAME)
TFILE = "Z#UPDATE"; ! Temporary site for file
FLAG = DDESTROY(TOUSER,TFILE,"",TOFSYS,0); ! Ignore flag
NG = YES
FINISH ELSE START
IF NEW = NO THEN START
SETFNAME(TO)
FAIL(FAILUREMESSAGE(218),218,UDNAME)
FINISH
TFILE = TOFILE
NG = NO
FINISH
!
! Move file to new user
!
SETFNAME("")
FLAG = DTRANSFER(FROMUSER,TOUSER,FROMFILE,TFILE,FROMFSYS,TOFSYS,1)
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
IF NG = YES THEN START
FLAG = DNEWGEN(TOUSER,TOFILE,TFILE,TOFSYS)
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
FINISH
!
! Cherish and permit the file, setting archive inhibit
!
SETFNAME(TO)
FLAG = DFSTATUS(TOUSER,TOFILE,TOFSYS,1,0); ! Cherish
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
FLAG = DFSTATUS(TOUSER,TOFILE,TOFSYS,17,0); ! Archive inhibit
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
IF USER TYPE = UNRESTRICTED THEN START
FLAG = DPERMISSION(TOUSER,"","",TOFILE,TOFSYS,1,5); ! Set EEP = ER
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,UDNAME)
FINISH
FINISH
!
! Inform the user who provided the file being updated
!
MES = "File ".FROM." updated to ".TO
I = LENGTH(MES)
FLAG = DMESSAGE2(FROMUSER,I,1,0,FROMFSYS,ADDR(MES)+1); ! Ignore failures - it isn't critical
IF VERSION # "" THEN START
WHILE LENGTH(MES) < 65 THEN MES = MES." "
MES <- MES."Version: ".VERSION
FINISH
LOG(MES,UDNAME)
GET BACKUP LOCATION(TOUSER,TOFILE,TOFSYS,TAPE,CHAPTER,"")
IF TAPE = "" THEN MES = "no backup available" ELSE START
MES = "last backup on tape ".TAPE.", chapter ".ITOS(CHAPTER)
FINISH
PRINTSTRING("Update successful - ".MES.SNL)
SET RETURN CODE(0)
END ; ! of UPDATE
!
!
!***********************************************************************
!*
!* P R I N T U P D A T E L O G
!*
!***********************************************************************
!
EXTERNALROUTINE PRINT UPDATE LOG(STRING (255) S)
STRINGNAME SUMMARIES,LOGCOPIES
INTEGER FLAG,ICONAD,OCONAD,I,SIZE,SUM,COPIES,TCONAD,J
STRING (11) TITLE
STRING (31) FILE
STRING (255) HEAD
STRING (255)ARRAY OPTIONS(1:PLKEYMAX)
RECORD RR(RF)
RECORDNAME IR(HF)
RECORDNAME OR(HF)
!
SET RETURN CODE(1000); ! In case of catastrophic failure
FLAG = PARAMDECODE(S,PLKEYMAX,PLKEYS,OPTIONS)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
SUMMARIES == OPTIONS(1)
LOGCOPIES == OPTIONS(2)
!
IF SUMMARIES = "" THEN SUMMARIES = "NO"
IF LOGCOPIES = "" THEN LOGCOPIES = ITOS(DEFAULT LOG COPIES)
IF MATCHSTRINGS(SUMMARIES,"YES") = YES THEN START
SUM = YES
FINISH ELSE START
IF MATCHSTRINGS(SUMMARIES,"NO") = YES THEN START
SUM = NO
FINISH ELSE START
SETFNAME(PLKEYS(1))
FAIL(FAILUREMESSAGE(326),326,PLNAME); ! Invalid value for SUMMARIES parameter
FINISH
FINISH
COPIES = PSTOI(LOGCOPIES)
UNLESS 1 <= COPIES <= MAX LOG COPIES THEN START
SETFNAME(PLKEYS(2))
FAIL(FAILUREMESSAGE(326),326,PLNAME); ! Invalid value for LOGCOPIES parameter
FINISH
!
LOG("*** Logfile finished ***",PLNAME); ! Ensures latest date both in header and log itself
CONNECT(LOGFILE,1,0,0,RR,FLAG)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
ICONAD = RR_CONAD
IR == RECORD(ICONAD)
OUTFILE(TEMPLOGFILE,IR_FILESIZE,0,0,TCONAD,FLAG)
IF FLAG # 0 THEN START
FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
FINISH
MOVE(IR_DATAEND,ICONAD,TCONAD)
IR == RECORD(TCONAD)
IR_FILETYPE = SSCHARFILETYPE
IR_FORMAT = LOGFILE IDENTITY; ! Replace this, in case file has been edited!
SIZE = IR_DATAEND - IR_DATASTART
!
HEAD = SNL.SNL.SNL." Public file update log"
HEAD = HEAD.SNL." ----------------------".SNL.SNL.SNL
CYCLE I = 1,1,2
FILE = "T#".NEXTTEMP
OUTFILE(FILE,SIZE+200,0,0,OCONAD,FLAG)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
OR == RECORD(OCONAD)
OR_FILETYPE = SSCHARFILETYPE
MOVE(LENGTH(HEAD),ADDR(HEAD)+1,OCONAD+OR_DATAEND)
OR_DATAEND = OR_DATAEND + LENGTH(HEAD)
MOVE(SIZE,ICONAD+IR_DATASTART,OCONAD+OR_DATAEND)
OR_DATAEND = OR_DATAEND + SIZE
DISCONNECT(FILE,FLAG)
IF I = 1 THEN J = 1 ELSE J = COPIES
IF I = 1 THEN TITLE = "For filing" ELSE TITLE = "Updates"
SENDFILE(FILE,"LP",TITLE,J,0,FLAG)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
REPEAT
!
SENDFILE(TEMPLOGFILE,"JOURNAL","UPDATES",0,0,FLAG)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,PLNAME)
CREATE LOGFILE(PLNAME)
!
IF SUM = YES THEN START
CYCLE I = 1,1,MAX VALID USERS
SUMMARISE(VALID USERS(I))
REPEAT
NEWPAGE
FINISH
SET RETURN CODE(0)
END ; ! of PRINT UPDATE LOG
!
!
!***********************************************************************
!*
!* D O W N D A T E
!*
!***********************************************************************
!
EXTERNALROUTINE DOWNDATE(STRING (255) S)
STRINGNAME NAME,BDATE
INTEGER FLAG,CHAPTER,FSYS,AD,NG,I,LEN,USER TYPE,PERM
STRING (6) TAPE,USER
STRING (11) FILE,TFILE
BYTEINTEGERARRAY BUFF(0:4095)
STRING (255)ARRAY OPTIONS(1:DDKEYMAX)
RECORD INF(FF)
RECORD RR(RF)
RECORDNAME HP(HPF)
!
SET RETURN CODE(1000); ! In case of catastrophic failure
FLAG = PARAMDECODE(S,DDKEYMAX,DDKEYS,OPTIONS)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
NAME == OPTIONS(1)
BDATE == OPTIONS(2)
IF LENGTH(NAME) > 31 THEN LENGTH(NAME) = 31
IF LENGTH(BDATE) > 8 THEN LENGTH(BDATE) = 8
IF NAME = "" THEN FAIL(FAILUREMESSAGE(263),263,DDNAME); ! Wrong number of parameters
!
FLAG = VALIDATE FILENAME(NAME)
IF FLAG # 0 THEN START
SETFNAME(NAME)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
SPLIT NAME(NAME,USER,FILE)
LOCATE USER(USER,FSYS,DDNAME)
CHECK USER(USER,USER TYPE,DDNAME)
!
GET BACKUP LOCATION(USER,FILE,FSYS,TAPE,CHAPTER,BDATE)
IF TAPE = "" THEN START
FAIL("No backup available".SNL,1000,DDNAME)
FINISH
PRINTSTRING("Backup tape ".TAPE." required"); TERMINATE
ASKMT(TAPE,FLAG)
IF FLAG # 0 THEN START
PRINTSTRING(" but not available".SNL)
FAIL("Tape not available",1001,DDNAME)
FINISH ELSE PRINTSTRING(" - and mounted".SNL)
REWINDMT
!
! Locate the required chapter, and check it is the correct one
!
FSKIPTMMT(CHAPTER,FLAG)
IF FLAG # 0 THEN START
UNLOADMT
FAIL("Skip to file was unsuccessful",1002,DDNAME)
FINISH
AD = ADDR(BUFF(0))
LEN = 4096
READMT(AD,LEN,FLAG); ! Read the header page
IF FLAG # 0 THEN START
UNLOADMT
FAIL("Read chapter header was unsuccessful",1003,DDNAME)
FINISH
HP == RECORD(AD); ! Map onto header page
IF HP_TAPENAME # TAPE THEN START
UNLOADMT
FAIL("Inconsistent tape name in chapter header",1004,DDNAME)
FINISH
IF HP_CHAPTER # CHAPTER THEN START
UNLOADMT
FAIL("Wrong chapter found on tape",1005,DDNAME)
FINISH
IF HP_USERNAME.".".HP_FILENAME # NAME THEN START
UNLOADMT
FAIL("Wrong file found on tape",1006,DDNAME)
FINISH
IF HP_TYPE # "BACKUP" THEN START
UNLOADMT
FAIL("File on tape is not a BACKUP file",1007,DDNAME)
FINISH
!
! Correct file has been found - prepare for transfer
!
SETFNAME(NAME)
FLAG = DFINFO(USER,FILE,FSYS,ADDR(INF))
IF 0 # FLAG # 32 THEN START
UNLOADMT
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
IF FLAG = 0 THEN START ; ! File already exists - need to NEWGEN
TFILE = "Z#DOWNDATE"; ! Temporary site for file
FLAG = DDESTROY(USER,TFILE,"",FSYS,0); ! Ignore flag
NG = YES
FINISH ELSE START
TFILE = FILE
NG = NO
FINISH
NAME = USER.".".TFILE
SETFNAME(NAME)
FLAG = DCREATE(USER,TFILE,FSYS,HP_EPAGES<<2,0)
IF FLAG # 0 THEN START
UNLOADMT
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
FLAG = DPERMISSION(USER,"","",TFILE,FSYS,1,3); ! Set EEP = RW
IF FLAG # 0 THEN START
UNLOADMT
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
CONNECT(NAME,3,0,0,RR,FLAG)
IF FLAG # 0 THEN START
UNLOADMT
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
AD = RR_CONAD
!
! Transfer pages from tape to file
!
CYCLE I = 1,1,HP_EPAGES
LEN = 4096
READMT(AD,LEN,FLAG)
IF FLAG # 0 THEN START
UNLOADMT
FAIL("Tape read failure",1008,DDNAME)
FINISH
AD = AD + 4096
REPEAT
DISCONNECT(NAME,FLAG)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
UNLOADMT; ! Finished with tape
SETFNAME("")
IF NG = YES THEN START
FLAG = DNEWGEN(USER,FILE,TFILE,FSYS)
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
FINISH
!
! Cherish and permit the file suitably, setting archive inhibit
!
NAME = USER.".".FILE
SETFNAME(NAME)
FLAG = DFSTATUS(USER,FILE,FSYS,1,0); ! Cherish
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
FLAG = DFSTATUS(USER,FILE,FSYS,17,0); ! Archive-inhibit
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
IF USER TYPE = UNRESTRICTED THEN PERM = 5 ELSE PERM = 0
FLAG = DPERMISSION(USER,"","",FILE,FSYS,1,PERM); ! Set EEP = ER or none, as appropriate
IF FLAG # 0 THEN START
FLAG = DIRTOSS(FLAG)
FAIL(FAILUREMESSAGE(FLAG),FLAG,DDNAME)
FINISH
LOG("Previous version of ".NAME." restored from backup",DDNAME)
PRINTSTRING("File successfully restored".SNL)
SET RETURN CODE(0)
END ; ! of DOWNDATE
!
!
!***********************************************************************
!*
!* L O G U P D A T E
!*
!***********************************************************************
!
EXTERNALROUTINE LOGUPDATE(STRING (255) S)
STRINGNAME MESSAGE
INTEGER FLAG
STRING (255)ARRAY OPTIONS(1:LUKEYMAX)
!
SET RETURN CODE(1000); ! In case of catastrophic failure
FLAG = PARAMDECODE(S,LUKEYMAX,LUKEYS,OPTIONS)
IF FLAG # 0 THEN FAIL(FAILUREMESSAGE(FLAG),FLAG,LUNAME)
MESSAGE == OPTIONS(1)
!
LOG(MESSAGE,LUNAME)
SET RETURN CODE(0)
END ; ! of LOGUPDATE
ENDOFFILE