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