/**/
trace o
arg input
call a_initial
if result = 0 then do
call b_accfiles
if result = 0 then do
call c_procstor
end
end
finalrc = result
call z_terminate
exit result
a_initial:
call setlocal
OutputOpen = 0
signal on syntax
signal on halt
'@ECHO OFF'
call aa_nlssetup
call ab_otherinit
if result = 0 then do
call ac_parameters
if result = 0 then ,
call x_msg '20' , version
end
return result
aa_nlssetup:
esc = '1b'x'['
normal = esc'0;37;40m'
crlf = '0d'x||'0a'x
msg.1 = "REC0001E: %1 is not a valid ACL set. use only once some or all of the"||crlf
msg.1 = msg.1||"          letters RWCDAXP to specify the ACLs"
msg.2 = "REC0002I: Reading an existing current database file"
msg.3 = "REC0003E: No Userid is logged on, program terminating...."
msg.4 = "REC0004E: Unable to locate database as error occured trying to resolve alias %1. Error was %2."
msg.5 = "REC0005W: The Database is locked. CHKRECOVR will still produce a recovered"||crlf
msg.5 = msg.5||"          database CHKSTORE.REC"
msg.6 = "REC0006E: Unable to Open and Lock New Database file, program terminating"||crlf
msg.6 = msg.6||"          possible causes are :-"||crlf
msg.6 = msg.6||"          1. Administrator id not logged on"||crlf
msg.6 = msg.6||"          2. Another UNREVOKE or CHKSTORE operation in progress"
msg.7 = "REC0007E: Unable to Open an existing New Database file, program terminating"||crlf
msg.7 = msg.7||"          possible causes are :-"||crlf
msg.7 = msg.7||"          1. Administrator id not logged on"
msg.8 = "REC0008E: Unable to Open an existing Database file, program terminating"||crlf
msg.8 = msg.8||"          possible causes are :-"||crlf
msg.8 = msg.8||"          1. Administrator id not logged on"
msg.9 = "REC0009I: No users with storage limits on their home directories"
msg.10 = "REC0010E: Unable to get a list of users, Administrator id not logged on"
msg.11 = "REC0011I: Processing %1"
msg.12 = "REC0012I: Reading an existing new database file"
msg.13 = "REC0013E: Unable to Open an a file to write the recovered database, program terminating"||crlf
msg.13 = msg.13||"          possible causes are :-"||crlf
msg.13 = msg.13||"          1. Administrator id not logged on"||crlf
msg.13 = msg.13||"          2. Another UNREVOKE or CHKSTORE operation in progress"
msg.14 = "REC0014I: Entry for %1 found in an existing new database file"
msg.15 = "REC0015I: Entry for %1 found in an existing current database file"
msg.16 = "REC0016I: No entry for %1 found in any database files, new entry created"
msg.17 = "REC0017E: REXXUTIL.DLL or CHKSTDLL.DLL could not be accessed. Please ensure"||crlf
msg.17 = msg.17||"          that these DLLs are in a directory specified in the LIBPATH"
msg.18 = "REC0018W: An external interrupt was received (CTRL-C most likely). The"||crlf
msg.18 = msg.18||"          program has been halted, no files have been updated."
msg.19 = "REC0019E: Unable to find a domain server for domain %1"
msg.20 = "REC0020I: CHKRECVR version %1 Initialisation completed"
msg.21 = "REC0021W: Unable to get access permissions for %1"||crlf
msg.21 = msg.21||"          on server %2, entry for %3 created or used entry found"
msg.22 = "REC0022W: Userid %1, ACLs imply userid is revoked. the database entry"||crlf
msg.22 = msg.22||"          found does not agree. Userid is assumed to be revoked."||crlf
msg.22 = msg.22||"          A new entry will be created"
msg.23 = "REC0023I: Database Entry found for userid %1 will be used"
msg.24 = "REC0024W: Userid %1, ACLs imply userid is not revoked. if a database entry was found"||crlf
msg.24 = msg.24||"          it does not agree. Userid is assumed to be not revoked. A new"||crlf
msg.24 = msg.24||"          database entry will be created"
msg.25 = "REC0025W: enter acls to be saved for user > %1 < for home directory"||crlf
msg.25 = msg.25||"          owned by > %2 <. These acls are restored for this"||crlf
msg.25 = msg.25||"          user when the home directory is unrevoked. Options are :-"||crlf
msg.25 = msg.25||"          1. some or all of 'RWCADXP' and press return"||crlf
msg.25 = msg.25||"          2. 'N' and press return to not specify on acls to be saved"||crlf
msg.25 = msg.25||"          3. just press return to use default > %3 <"
msg.26 = "REC0026W: acls > %1 < are not valid."
msg.27 = "REC0027E: New Database file is locked. CHKSTORE, UNREVOKE or RECOVERY'"||crlf
msg.27 = msg.27||"          already running. This program cannot run"
msg.28 = "REC0028W: Attempt %1 to swop database files failed. %2 attempts remaining"
msg.29 = "REC0028E: The Recovery process failed to swop the newly recovered database"
msg.29 = msg.29||"          The new database remains as %1"
msg.30 = "REC0030E: Unable to Open output file for recovered database, program terminating"||crlf
msg.30 = msg.30||"          possible causes are :-"||crlf
msg.30 = msg.30||"          1. Administrator id not logged on"
return 0
ab_otherinit:
version = '2.12'
OutputFile = 'CHKSTORE.REC'
ChkstorFile = 'CHKSTORE.DBF'
OldstorFile = 'CHKSTORE.DBO'
NewChkFile  = 'CHKSTORE.DBN'
LogFile     = 'CHKRECVR.ERR'
retry_limit = 10
retry_delay = 5
swopok = 0
swoprequired = 0
dummylock    = 0
call RxFuncAdd "SysLoadFuncs" , "REXXUTIL" , "SysLoadFuncs"
call SysLoadFuncs
call RxFuncAdd "ChkStLoadFuncs" , "CHKSTDLL" , "ChkStLoadFuncs"
call ChkStLoadFuncs
do i = 1 to queued() ; pull . ; end
return 0
ac_parameters:
if left(input,1) = '?' then do
call aca_help_chkrecvr
call z_terminate
exit
end
swoprequired = 0
LogRequired  = 0
quietflag    = 'Y'
prompt       = 'N'
ignore       = 0
parse var input '/R:'acls .
if translate(acls,'*******','RWCAXDP') <> copies('*',length(acls)) then do
call x_msg '1' , acls
return 4
end
if acls = '' then acls = 'RWCAXDP'
parse var input '/DB:'db_location .
if db_location = '' then db_location = 'LOGON'
if pos('/N',input) <> 0 then quietflag = 'N'
if pos('/P',input) <> 0 then prompt = 'Y'
if pos('/S',input) <> 0 then swoprequired = 1
if pos('/L',input) <> 0 then LogRequired = 1
if pos('/I',input) <> 0 then ignore = 1
parse value ChkStNetUser() with myuserid computername domain
if domain = '' then do
call x_msg '3'
return 3
end
domain_server = ChkStDCName(domain)
if pos('ERROR',domain_server) <> 0 then do
call x_msg '19',domain
return 19
end
if left(db_location,1) <> '\' & substr(db_location,2,1) <> ':' & ,
left(db_location,1) <> '.' then do
parse value ChkStNetAlias(domain_server,db_location) with alias_server alias_path
if pos('ERROR',alias_server) <> 0 then do
call x_msg '4' , db_location , alias_server
return 4
end
if strip(alias_server,'L','\') <> computername then ,
alias_drive  = alias_server'\'translate(alias_path,'$',':')
else
alias_drive = alias_path
end
else ,
alias_drive = strip(db_location,'t','\')
OutputFile = alias_drive||'\'||OutputFile
ChkstorFile = alias_drive||'\'||ChkstorFile
OldstorFile = alias_drive||'\'||OldstorFile
NewChkFile = alias_drive||'\'||NewChkFile
return 0
aca_help_chkrecvr:
say 'CHKRECVR - Version' version
say '(c) Copyright International Business Machines Corporation 1994.'
say 'All rights Reserved'
say
say 'CHKRECVR - This program will attempt to produce a CHKSTORE database file   '
say '           CHKSTORE.REC that is synchronised with the real environment.    '
say '           This file can automatically be placed into production.          '
say
say 'calling convention'
say '------------------'
say 'CHKRECVR /DB:db_location /R:acls /P /N /L /S /I'
'pause'
say
say 'where :-'
say '  db_location     : specify a different location for the CHKSTORE database'
say '                    can be an alias, UNC name or local drive specification'
say '                    If not specified then default is the LOGON alias'
say '  acls            : specify the list of acls which a revoked home directory'
say '                    will have restored when it is unrevoked.'
say '                    If not specified then default is the RWCDAXP'
say '  /P              : prompt for the acls to be stored for a revoked home'
say '                    directory, for every user who has revoked access.'
say '                    pressing enter at the prompt will use default supplied'
say '                    acls'
say '  /N              : if this parameter is included then CHKRECVR will output'
say '                    more information about what it is doing.'
say '  /L              : if this parameter is included then CHKRECVR will write'
say '                    to the CHKSTORE log'
say '  /S              : switch the recovered database straight into production'
say '  /I              : ignore any existing database files'
return
b_accfiles:
parse value ChkStNetUser() with . . check
if check = '' then do
call x_msg '3'
return 3
end
newdb.0 = 0
newdbuser = ''
if stream(NewChkFile,'c','query exists') <> '' then do
rc = stream(NewChkFile,'c','open')
if rc = 'NOTREADY:32' then do
call x_msg '27'
return 27
end
else do
if rc <> 'READY:' then do
call x_msg '6'
return 6
end
end
NewChkOpen = 1
i = 0
if stream(NewChkFile,'c','query size') <> 0 & ignore = 0 then do
call x_msg '12'
do while lines(NewChkFile) = 1
i = i + 1
newdb.i = linein(NewChkFile)
newdbuser = newdbuser strip(left(newdb.i,8))
end
end
newdb.0 = i
end
else do
rc = stream(NewChkFile,'c','open')
if rc <> 'READY:' then do
call x_msg '6'
return 6
end
dummylock = 1
NewChkOpen = 1
end
OutputOpen = 0
if stream(OutputFile,'c','query exists') <> '' then ,
call SysFileDelete OutputFile
rc = stream(OutputFile,'c','open')
if rc <> 'READY:' then do
call x_msg '30'
return 30
end
OutputOpen = 1
olddb.0 = 0
olddbuser = ''
if stream(ChkstorFile,'c','query exists') <> '' & stream(ChkstorFile,'c','query size') <> 0 & ignore = 0 then do
call x_msg '2'
entries = ChkStReadFile(ChkstorFile)
if pos('ERROR:',entries) <> 0 then do
call x_msg '8'
return 8
end
else do
do i = 1 to entries
olddb.i = filedata.i
olddbuser = olddbuser strip(left(filedata.i,8))
end
olddb.0 = entries
end
end
output = left(version,8)||date()||' 'time()
rc = lineout(OutputFile,output)
return 0
c_procstor:
count = ChkStAllUsers(domain_server)
if pos("ERROR",count) <> 0 then do
call x_msg '10'
return 10
end
if count = 0 then do
call x_msg '9'
return 0
end
do i = 1 to count
userid = user_name.i
parse value ChkStHomeDir(domain_server,userid) with allowed path
if quietflag <> 'N' then ,
call x_msg '11',userid
if allowed <> -1 & path <> '' then do
path = strip(path)
if left(path,1) = '\' then ,
parse var path '\\'server'\'drive'$'pathname
else ,
parse var path homedrv'\'server'\'drive'$'pathname
call ca_procacc
if result > 0 then return result
rc = lineout(OutputFile,dbentry)
end
end
swopok = 1
return 0
ca_procacc:
newpos = wordpos(userid,newdbuser)
if newpos <> 0 then do
call x_msg '14' , userid
dbentry = newdb.newpos
end
else do
oldpos = wordpos(userid,olddbuser)
if oldpos <> 0 then do
call x_msg '15' , userid
dbentry = olddb.oldpos
end
else do
call x_msg '16' , userid
dbentry = ''
end
end
if server <> computername then ,
count = ChkStGetAcc('\\'server,drive':'||pathname)
else ,
count = ChkStGetAcc('',drive':'||pathname)
if pos('ERROR',count) <> 0 then do
call x_msg '21' , drive':'||pathname , server , userid
if dbentry = '' then ,
dbentry = left(userid,8,' ')||left('0',8,' ')||left(allowed,8,' ')
return -1
end
revoked = 0
unrevoked = 0
do accloop = 1 to count
acl = strip(accacl.accloop)
if translate(acl,'***','RDA') = '***' then revoked = 1
if pos('W',acl) <> 0 | pos('C',acl) <> 0 | pos('P',acl) <> 0 then unrevoked = 1
end
if unrevoked = 1 & revoked = 1 then revoked = 0
if revoked = 1 then do
if SubStr(dbentry,25,1) <> 'R' | dbentry = '' then do
if dbentry <> '' then call x_msg '22' , userid
dbentry = left(userid,8,' ')||left(allowed + 10,8,' ')||left(allowed,8,' ')||'R'
useraccess = '       '
otheraccess = ''
do accloop = 1 to count
acl = strip(accacl.accloop)
if translate(acl,'***','RDA') = '***' then do
if prompt = 'Y' then do
acls_ok = 0
do until acls_ok = 1
call x_msg '25' , accuser.accloop , userid , acls
pull new_acls
if new_acls <> 'N' & new_acls <> '' then do
if translate(new_acls,'*******','RWCAXDP') <> copies('*',length(new_acls)) then do
call x_msg '26' , new_acls , acls
end
else acls_ok = 1
end
else do
if new_acls = '' then new_acls = acls
else new_acls = ''
acls_ok = 1
end
end
end
else new_acls = acls
if accuser.accloop = userid then useraccess = left(new_acls,7,' ')
else otheraccess = otheraccess||left(accuser.accloop,9)||left(new_acls,7,' ')
end
end
dbentry = dbentry||useraccess||otheraccess
end
else call x_msg '23'
end
else do
if SubStr(dbentry,25,1) = 'R' | dbentry = '' then do
if dbentry <> '' then call x_msg '24' , userid
dbentry = left(userid,8,' ')||left('0',8,' ')||left(allowed,8,' ')
end
else call x_msg '23'
end
return 0
x_msg:
msgno = arg(1)
do argloop = 2 to arg()
mypos = argloop - 1
field.mypos = arg(argloop)
end
msgcol = normal
msgout = msg.msgno
msgtype = substr(msgout,8,1)
startpos = 1
endflag = 0
do until endflag = 1
replacepoint = pos(' %',msgout,startpos)
if replacepoint <> 0 then do
if replacepoint+1 = length(msgout) then endflag = 1
else startpos = replacepoint + 3
fieldno = substr(msgout,replacepoint+2,1)
if datatype(fieldno,'num') = 1 then do
msgout = left(msgout,replacepoint)||field.fieldno||right(msgout,length(msgout)-replacepoint-2)
end
end
else endflag = 1
end
if msgtype = 'E' then do
if LogFileOpen = 0 & LogRequired = 1 then do
rc = stream(LogFile,'c','open')
rc = stream(LogFile,'c','seek <0')
rc = lineout(LogFile,'Error Log start time:'date() time())
LogFileOpen = 1
end
if LogRequired = 1 then ,
rc = lineout(LogFile,msgout)
call lineout "STDERR:",esc'1;31;40m'||msgout||normal
call beep 200,300
end
else do
if msgtype = 'W' then do
if LogFileOpen = 0 & LogRequired = 1 then do
rc = stream(LogFile,'c','open')
rc = stream(LogFile,'c','seek <0')
rc = lineout(LogFile,'Error Log start time:'date() time())
LogFileOpen = 1
end
if LogRequired = 1 then ,
rc = lineout(LogFile,msgout)
msgcol = esc'1;32;40m'
say msgcol||msgout||normal
end
else do
msgcol = normal
if quietflag <> 'Y' then ,
say msgcol||msgout||normal
end
end
return 0
z_terminate:
if OutputOpen = 1 then ,
rc = stream(OutputFile,'c','close')
OutputOpen = 0
if NewChkOpen = 1 then ,
rc = stream(NewChkFile,'c','close')
NewChkOpen = 0
if dummylock = 1 then ,
rc = SysFileDelete(NewChkFile)
if swoprequired = 1 then do
if swopok = 1 then do
'COPY' ChkstorFile OldStorFile '1>NUL 2>NUL'
i = 0
do while i < retry_limit
rc = 0
if stream(ChkstorFile,'c','query exists') <> '' then ,
rc = SysFileDelete(ChkstorFile)
if rc = 0 then do
RenameFile = filespec("name",ChkstorFile)
'RENAME' OutputFile RenameFile '1>NUL 2>NUL'
if stream(NewChkFile,'c','query exists') <> '' then ,
rc = SysFileDelete(NewChkFile)
i = retry_limit
end
else do
i=i+1
call x_msg 'xx' , i , retry_limit-i
if i < retry_limit then ,
call SysSleep retry_delay
else do
call x_msg '28'
end
end
end
end
else do
call x_msg '29' , OutputFile
finalrc = 29
end
end
swopok = 0
swoprequired = 0
call endlocal
do queued(); pull .; end
return finalrc
syntax:
signal off syntax
where = SigL
say 'Syntax Error in line' where 'occured'
call z_terminate
call x_msg '17'
exit 17
halt:
signal off halt
call z_terminate
call x_msg '18'
exit 18
