Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/diulg2.b36
There are 4 other files named diulg2.b36 in the archive. Click here to see a list.
%TITLE 'DIU Logging Routines'
MODULE DIULG2 (IDENT='257',
LANGUAGE(BLISS36),
ENTRY(
l$event, ! Log event code in system log file
l$uevent, ! Log event in user log file
l$text, ! Log text in system log file
lj$event, ! Log event for subjob in system log
lj$text, ! Log text for subjob
lj$ulog, ! Log event code in user log file
lj$uevent, ! Log event code in user log file
lj$utxt, ! Log text in user log file
l$uinit, ! Open user log file (or not)
l$check_access, ! Check access to log file
l$new_request ! Cons a new request string for logging
)
)=
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY: DIU-20 (Data Interchange Utility for TOPS-20).
!
! ABSTRACT: This module contains routines that open, close, and write
! in the log files.
!
!** This module was originally written transportably, using XPORT for all I/O
! to the log files. However, XPORT at the time of this writing has the
! serious deficiency that it opens files in restricted mode and does not use
! TOPS-20 append mode (that is, even with OPTIONS = APPEND, the OPENF bits
! XPORT uses are OF%RD, OF%WR, and OF%RTD, instead of just OF%APP). This
! makes it impossible for users to open the log files for read at any time;
! a serious bug. If XPORT is ever fixed, this code should be rewritten to
! use it, and not JSYSes.
!
! ENVIRONMENT: TOPS-20 V6.1 (user mode privileged)
! BLISS-36 V4 XPORT
!
! AUTHOR: Larry Campbell CREATION DATE: March 27, 1982
! HISTORY:
!
! 257 Change library BLI:MONSYM to just MONSYM.
! Gregory A. Scott 7-Jul-86
!
! 254 Don't write the job number in LJ$UTXT if we are yet the spooler.
! Gregory A. Scott 2-Jul-86
!
! 154 Add the l$uevent routine which logs a random event to the user log.
! Simplify the l$new_request routine.
! Gregory A. Scott 12-May-86
!
! 152 Add routine l$check_access which checks to see if a user has access to
! a log file that he specifed. Add l$event which logs a DIU event to the
! system log file. Add lj$event which logs a slave job type message to
! system log file. Add lj$uevent which logs a slave message to user log
! file from spooler.
! Gregory A. Scott 11-May-86
!
! 147 Add routine L$UINIT to open the user log file. Fix lj$utxt so that it
! can be called from DIUC20 at the time that request is created. Clean
! up user log routines.
! Gregory A. Scott 8-May-86
!
! 125 Change slightly the string returned by L$NEW_REQUEST.
! Gregory A. Scott 24-Apr-86
!
! 121 Put a line seperator in between the filenames when logging a new
! request.
! Gregory A. Scott 19-Apr-86
!
! V01-005 RDF0001 Rick Fricchione 26-Oct-1984
! Convert for DIU. Modify some small areas and clean up
! code.
!
! V01-004 AWN0004 Andrew Nourse --no date--
! 04 - Sleep & retry if log file can't be opened
! 03 - Do not try to write log file after failing to open it
! 02 - Put in Entry Points
! 01 - Use JSYSes instead of XPORT because XPORT gets it wrong
!--
!**************************************************************************
!** F O R W A R D R O U T I N E
!**************************************************************************
FORWARD ROUTINE
l$open : NOVALUE, ! Open log file
l$close : NOVALUE, ! Close log file
l$event : NOVALUE, ! Log event to system log file
l$uevent : NOVALUE, ! Log event to user log file
l$text : NOVALUE, ! Log text to system log file
lj$event : NOVALUE, ! Log event for subjob
lj$text : NOVALUE, ! Log text for subjob
lj$ulog : NOVALUE, ! Log code in user log file
lj$uevent : NOVALUE, ! Log code in user log file
lj$utxt : NOVALUE, ! Log text in user log file
l$uinit : NOVALUE, ! Init spec to the user log file
l$check_access, ! Check for access to the user log file
l$new_request : NOVALUE; ! Log new request
!**************************************************************************
!** L I B R A R Y F I L E S
!**************************************************************************
LIBRARY 'BLI:XPORT'; ! Of course
LIBRARY 'MONSYM'; ! Monitor symbols
LIBRARY 'DIU'; ! DIU Data structures
REQUIRE 'JSYSDEF'; ! JSYS defs
!**************************************************************************
!** G L O B A L S T O R A G E
!**************************************************************************
LITERAL max_log_retries = 10,
log_retry_wait = 1000;
OWN sys_log_jfn, ! System log file JFN
usrlog_reqblk,
usrlog_desc : $STR_DESCRIPTOR(CLASS=FIXED);
!**************************************************************************
!** E X T E R N A L D E C L A R A T I O N S
!**************************************************************************
EXTERNAL interactive, ! 0 if we are a slave, 1 if not
mst_flag : VOLATILE, ! We are (yet) the spooler if nonzero
jobstatus : BLOCKVECTOR [DIU$K_MAX_MJOB, DIUJ$K_LEN]
FIELD (DIUJ$$JOBSTAT_FIELDS);
EXTERNAL ROUTINE
s$jobno, ! Return current job no.
s$noint : NOVALUE, ! Disable interrupts
s$okint : NOVALUE, ! Enable interrupts
q$extract_filespecs : NOVALUE, ! Extract filespecs from request block
q$options_extract : NOVALUE, ! Extract command options from req blk
diu$abort, ! Default condition handler
diu$errmsg : NOVALUE, ! Convert condition code into text
s$dtstr : NOVALUE; ! Convert date/time to string
!**************************************************************************
!** L $ O P E N
!**************************************************************************
ROUTINE l$open : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Open the system log file (SYSTEM:DIU.LOG) for append.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! We go NOINT to prevent races in writing the log file. L$CLOSE will
! undo this.
!
!--
BEGIN
LOCAL
retcode,
logfile_descr : $STR_DESCRIPTOR (),
error,
output,
retries: INITIAL (0);
s$noint ();
!
! Init descr to ASCIZ filespec string, but fudge byte count to not
! include trailing null.
!
$STR_DESC_INIT (DESCRIPTOR = logfile_descr, CLASS = FIXED,
STRING =
(%STRING (
%IF %SWITCHES(DEBUG)
%THEN
'SYSTEM:DIUDEB.LOG'
%ELSE
'SYSTEM:DIU.LOG'
%FI, %CHAR (0))));
logfile_descr[STR$H_LENGTH] = .logfile_descr[STR$H_LENGTH] - 1;
IF NOT JSYS_GTJFN (GJ_SHT, .logfile_descr[STR$A_POINTER]; output)
THEN
SIGNAL (DIU$_SYS_LOG_FAULT, .output, 0, logfile_descr);
sys_log_jfn = .output;
WHILE NOT JSYS_OPENF (.output, OF_APP + %O'070000000000'; error)
DO ![4] Retry open if locked
BEGIN
JSYS_RLJFN (.sys_log_jfn);
IF (.error NEQ OPNX9) ![4] Only retry if locked by another
OR ((retries = .retries + 1) GTR max_log_retries) ![4]
THEN
EXITLOOP SIGNAL (DIU$_SYS_LOG_FAULT, .error, 0, logfile_descr)
ELSE
JSYS_DISMS (log_retry_wait) ![4] sleep for one second
END;
END; ! End of l$open
!**************************************************************************
!** L $ C L O S E
!**************************************************************************
ROUTINE l$close : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Close the log file.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! S$OKINT is called to reenable interrupts.
!
!--
BEGIN
JSYS_CLOSF (.sys_log_jfn);
s$okint ();
END; ! End of l$close
!**************************************************************************
!** L $ E V E N T
!**************************************************************************
GLOBAL ROUTINE l$event (code, code2, p_descr) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Log an event in the system log file. This routine can be called from
! anywhere in DIU.
!
! FORMAL PARAMETERS:
!
! code: condition code
! code2: secondary condition code
! p_descr: pointer to descriptor for optional text
!
!--
BIND opt_descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
! Get message for this code
$STR_DESC_INIT (DESCRIPTOR = descr, CLASS = DYNAMIC);
DIU$ERRMSG(.code, .code2, opt_descr, descr, %REF(0));
! Place message in log file
l$text (descr);
! Gee that was easy, free memory and return
$XPO_FREE_MEM (STRING = descr); ! Thanks for the memories
END; ! End of l$event
!**************************************************************************
!** L J $ E V E N T
!**************************************************************************
GLOBAL ROUTINE lj$event (code, code2, p_descr, job_handle) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Log an event in the system log file.
!
! FORMAL PARAMETERS:
!
! code: condition code
! code2: secondary condition code
! p_descr: pointer to descriptor for optional text
! job_handle: DIU stream number
!
!--
BIND opt_descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
! Get message for this code
$STR_DESC_INIT (DESCRIPTOR = descr, CLASS = DYNAMIC);
DIU$ERRMSG(.code, .code2, opt_descr, descr, %REF(0));
! Place message in system wide log file
lj$text (descr, .job_handle);
! Gee that was easy, free memory and return
$XPO_FREE_MEM (STRING = descr); ! Thanks for the memories
END; ! End of l$jevent
!**************************************************************************
!** L $ T E X T
!**************************************************************************
GLOBAL ROUTINE l$text (p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Place a line of text in the log file.
!
! FORMAL PARAMETERS:
! p_descr - pointer to descriptor for text to put in log file
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
BIND
descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL
retcode,
date_descr : $STR_DESCRIPTOR (),
date_buff : VECTOR [CH$ALLOCATION (19)],
log_line_descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
$STR_DESC_INIT (DESCRIPTOR = date_descr,
STRING = (19, CH$PTR (date_buff)));
$STR_DESC_INIT (DESCRIPTOR = log_line_descr, CLASS = DYNAMIC);
l$open ();
s$dtstr (-1, date_descr);
$STR_COPY (TARGET = log_line_descr,
STRING = $STR_CONCAT (date_descr,
descr,
%CHAR (13, 10, 0)));
JSYS_SOUT (.sys_log_jfn, .log_line_descr[STR$A_POINTER], 0, 0);
$XPO_FREE_MEM (STRING = log_line_descr);
!
! Close log file for readers
!
l$close ();
END; ! End of l$text
!**************************************************************************
!** L J $ T E X T
!**************************************************************************
GLOBAL ROUTINE lj$text (p_descr, job_handle) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Append a line of text pertaining to a particular slave job
! to the log file. The pertinent job is identified.
!
! FORMAL PARAMETERS:
! p_descr - pointer to descriptor for string
! job_handle - job handle (index into JOBSTATUS blockvector)
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
BIND
descr = .p_descr : $STR_DESCRIPTOR (),
req_block = .jobstatus[.job_handle, DIUJ$A_REQ_BLOCK] : $DIU_BLOCK;
LOCAL
retcode,
date_descr : $STR_DESCRIPTOR (),
date_buff : VECTOR [CH$ALLOCATION (19)],
log_line_descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
$STR_DESC_INIT (DESCRIPTOR = date_descr,
STRING = (19, CH$PTR (date_buff)));
$STR_DESC_INIT (DESCRIPTOR = log_line_descr, CLASS = DYNAMIC);
l$open ();
s$dtstr (-1, date_descr);
$STR_COPY (TARGET = log_line_descr,
STRING = $STR_CONCAT (date_descr,
'Req ',
$STR_ASCII (.req_block[DIU$H_REQUEST_ID]),
' (',
$STR_FORMAT ((.req_block[DIU$H_JOBNAME],
CH$PTR (req_block[DIU$T_JOBNAME])),
UP_CASE),
'), job ',
$STR_ASCII (.jobstatus[.job_handle,
DIUJ$H_JOB_NUMBER]),
': ',
descr,
%CHAR (13, 10, 0)));
JSYS_SOUT (.sys_log_jfn, .log_line_descr[STR$A_POINTER], 0, 0);
$XPO_FREE_MEM (STRING = log_line_descr);
!
! Close system log for perusers
!
l$close ();
END; ! End of lj$text
!**************************************************************************
!** L J $ U L O G
!**************************************************************************
GLOBAL ROUTINE lj$ulog (code, code2, p_descr) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Log an event in the user-specified log file. This routine is called by
! a slave job or by the master job, but the access has already been
! checked when the request was queued. If the condition code is
! DIU$_USER_LOG_FAULT, we just turn off user logging and return.
!
! FORMAL PARAMETERS:
!
! code: condition code
! code2: secondary condition code
! p_descr: pointer to descriptor for optional text
!
! IMPLICIT INPUTS:
!
! usrlog_desc: points to the log file text
!
!--
BIND opt_descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL length,
descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
ENABLE DIU$ABORT;
! If we are being called because of a user log fault, just turn off
! logging (to prevent infinite loops) and return.
IF .code EQL DIU$_USER_LOG_FAULT
THEN usrlog_desc[STR$H_LENGTH] = 0;
! If user said /NOLOG_FILE or there have been errors then return now
IF .usrlog_desc[STR$H_LENGTH] EQL 0
THEN RETURN;
! Get message for this code
$STR_DESC_INIT (DESCRIPTOR = descr, CLASS = DYNAMIC);
DIU$ERRMSG(.code, .code2, opt_descr, descr, length);
! Place message in log file
lj$utxt (descr);
! Free memory and return
$XPO_FREE_MEM (STRING = descr);
END; ! End of lj$ulog
!**************************************************************************
!** L $ U E V E N T
!**************************************************************************
GLOBAL ROUTINE l$uevent (code, code2, p_descr, p_req_block) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Log an event in the user's log file. Should only be called from
! interrupt level in spooler job.
!
! FORMAL PARAMETERS:
!
! code: condition code
! code2: secondary condition code
! p_descr: pointer to descriptor for optional text
! p_req_block: request block associated with request (for log file spec)
!
!--
BIND opt_descr = .p_descr : $STR_DESCRIPTOR (),
req_block = .p_req_block : $DIU_BLOCK;
LOCAL descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
! Get message for this code
$STR_DESC_INIT (DESCRIPTOR = descr, CLASS = DYNAMIC);
DIU$ERRMSG(.code, .code2, opt_descr, descr, %REF(0));
! Place message in user log file (if any)
l$uinit(req_block);
lj$utxt(descr);
! Gee that was easy, free memory and return
$XPO_FREE_MEM (STRING = descr); ! Thanks for the memories
END; ! End of l$uevent
!**************************************************************************
!** L J $ U E V E N T
!**************************************************************************
GLOBAL ROUTINE lj$uevent (code, code2, p_descr, job_handle) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Log an event in the user's log file. Should only be called from slave
! or from interrupt level in spooler job.
!
! FORMAL PARAMETERS:
!
! code: condition code
! code2: secondary condition code
! p_descr: pointer to descriptor for optional text
! job_handle: DIU stream number
!
!--
BIND opt_descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
! Get message for this code
$STR_DESC_INIT (DESCRIPTOR = descr, CLASS = DYNAMIC);
DIU$ERRMSG(.code, .code2, opt_descr, descr, %REF(0));
! Place message in user log file (if any)
l$uinit(.jobstatus[.job_handle, DIUJ$A_REQ_BLOCK]);
lj$utxt(descr);
! Gee that was easy, free memory and return
$XPO_FREE_MEM (STRING = descr); ! Thanks for the memories
END; ! End of lj$uevent
!**************************************************************************
!** L J $ U T X T
!**************************************************************************
GLOBAL ROUTINE lj$utxt (p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Place a line of text in the user's log file.
!
! FORMAL PARAMETERS:
!
! p_descr: address of descriptor of text to write
!
! IMPLICIT INPUTS:
!
! usrlog_reqblk: points to the request we are handling
! usrlog_desc: points to the log file string
!--
BEGIN
LOCAL date_descr : $STR_DESCRIPTOR (CLASS = FIXED),
date_buff : VECTOR [CH$ALLOCATION (19)],
retcode,
logline_descr : $STR_DESCRIPTOR (CLASS = DYNAMIC),
usr_log_jfn,
error;
BIND req = .usrlog_reqblk : $DIU_BLOCK,
descr = .p_descr : $STR_DESCRIPTOR ();
ENABLE DIU$ABORT;
! If user said /NOLOG_FILE then return now
IF .usrlog_desc[STR$H_LENGTH] EQL 0
THEN RETURN;
! Attempt to open the file
IF NOT JSYS_GTJFN (GJ_SHT, CH$PTR(req[DIU$T_LOG_FILESPEC]); usr_log_jfn)
THEN BEGIN
SIGNAL (DIU$_USER_LOG_FAULT, .usr_log_jfn, 0, usrlog_desc);
RETURN
END;
! Some other slave job might be trying to write in the file. If
! we get an OPNX9 (invalid simultaneous access), sleep for a second
! and try again, up to 10 seconds.
DECR counter FROM 10 TO 1 ! Try this ten times
DO IF JSYS_OPENF (.usr_log_jfn, OF_APP + %O'070000000000'; error)
THEN EXITLOOP ! If success, quit the loop
ELSE IF .error EQL OPNX9 ! If invalid simultaneous access
THEN JSYS_DISMS (1000) ! sleep for one second
ELSE BEGIN ! any other error, give up
JSYS_RLJFN (.usr_log_jfn);
SIGNAL (DIU$_USER_LOG_FAULT, .error, 0, usrlog_desc);
RETURN
END;
! Log file is open now, get the current date and time asciized
$STR_DESC_INIT (DESCRIPTOR = date_descr,
STRING = (19, CH$PTR (date_buff)));
s$dtstr (-1, date_descr);
! Start building the message that we will write to the log file.
$STR_DESC_INIT (DESCRIPTOR = logline_descr, CLASS = DYNAMIC);
$STR_COPY (TARGET = logline_descr,
STRING = $STR_CONCAT (date_descr,
'Req ',
$STR_ASCII (.req[DIU$H_REQUEST_ID]),
' (',
(.req[DIU$H_JOBNAME],
CH$PTR(req[DIU$T_JOBNAME]))));
IF .mst_flag ! Am I yet the spooler
THEN $STR_APPEND(TARGET = logline_descr, ! Yes, put that in the log
STRING = ') spooler')
ELSE $STR_APPEND(TARGET = logline_descr, ! No, put slave job number
STRING = $STR_CONCAT(') job ',
$STR_ASCII(s$jobno())));
$STR_APPEND(TARGET = logline_descr,
STRING = $STR_CONCAT(': ',
descr,
%CHAR(13,10,0)));
! Write that string to the user's log file
JSYS_SOUT (.usr_log_jfn, .logline_descr[STR$A_POINTER], 0, 0);
! Free the memory we used, close the log file and return
$XPO_FREE_MEM (STRING = logline_descr); ! Thanks for the memories
JSYS_CLOSF (.usr_log_jfn); ! Thump
END; ! End of lj$utxt
!**************************************************************************
!* L $ U I N I T
!**************************************************************************
GLOBAL ROUTINE l$uinit (p_req) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Copies the user log filespec to userlog for later use.
!
! FORMAL PARAMETERS:
!
! p_req: request block (containing log file specification)
!
! IMPLICIT OUTPUTS:
!
! usrlog_desc: set up to point to user log descr
!--
BIND req = .p_req : $DIU_BLOCK;
! Init a string desc to the log filespec in the request block we were passed.
! Note that if the length of this desc is zero then we aren't doing logging.
$STR_DESC_INIT(DESC=usrlog_desc, CLASS=FIXED,
STRING=(.req[DIU$H_LOG_FILESPEC],
CH$PTR(req[DIU$T_LOG_FILESPEC])));
! Remember the address of the request block passed to us or later use.
usrlog_reqblk = req;
END; ! l$uinit
!**************************************************************************
!* L $ C H E C K _ A C C E S S
!**************************************************************************
GLOBAL ROUTINE l$check_access (user_num, dir_num, caps, log_filespec) : =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Checks to see if a user has append access to the given log file.
!
! FORMAL PARAMETERS:
!
! user_num: user number of request creator
! dir_num: connected directory of request creator
! caps: capabilities of request creator
! log_filespec: address of log filespec
!
! ROUTINE VALUES:
!
! TRUE if access is allowed
! DIU$_ILLEGAL_USER_LOG if access is not allowed
!--
LOCAL chkac_block: VECTOR[$CKAUD+1],
retcode,
log_jfn;
! First get a JFN on the file we are going to check
IF NOT JSYS_GTJFN (GJ_SHT, CH$PTR(.log_filespec); log_jfn)
THEN RETURN (DIU$_ILLEGAL_USER_LOG); ! Return owie if can't get JFN
! Construct the log file chkac block
chkac_block[$CKAAC] = $CKAAP; ! Check append access to file
chkac_block[$CKALD] = .user_num; ! User number
chkac_block[$CKACD] = .dir_num; ! Connected directory number
chkac_block[$CKAEC] = .caps; ! Enabled capabilities
chkac_block[$CKAUD] = .log_jfn; ! File to check access to
! Do the call to check access and return if it had an error
IF NOT JSYS_CHKAC(CK_JFN+$CKAUD+1, chkac_block; retcode)
THEN BEGIN ! Punt if JSYS fails
JSYS_RLJFN(.log_jfn); ! Release the JFN
RETURN DIU$_ILLEGAL_USER_LOG; ! Return the error
END;
! Release the log file jfn and return based on whatever CHKAC gave us
JSYS_RLJFN(.log_jfn); ! Release the jfn
IF .retcode ! Did CHKAC return -1 or 0?
THEN RETURN TRUE ! -1, access allowed
ELSE RETURN DIU$_ILLEGAL_USER_LOG; ! 0, access not allowed
END; ! l$check_access
!**************************************************************************
!** L $ N E W _ R E Q U E S T
!**************************************************************************
GLOBAL ROUTINE l$new_request (p_req_block, p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Create a hairy multiline exposition of a new request. This is
! used to log new requests in the system and user log files.
!
! FORMAL PARAMETERS:
!
! p_req_block: pointer to request block
! p_descr: pointer to descriptor for string to receive text
!
!--
BEGIN
BIND req_block = .p_req_block : $DIU_BLOCK,
log_descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL source_descr : $STR_DESCRIPTOR (CLASS = DYNAMIC),
dest_descr : $STR_DESCRIPTOR (CLASS = DYNAMIC),
options_descr : $STR_DESCRIPTOR (CLASS = DYNAMIC);
MACRO function_to_string [funct, str] =
[%NAME ('DIU$K_', funct)] : $STR_APPEND (STRING = str,
TARGET = log_descr) %,
continuation = %CHAR (13, 10, %C'-', 9) %;
! Init string descriptors
$STR_DESC_INIT (DESCRIPTOR = source_descr, CLASS = DYNAMIC);
$STR_DESC_INIT (DESCRIPTOR = dest_descr, CLASS = DYNAMIC);
$STR_DESC_INIT (DESCRIPTOR = options_descr, CLASS = DYNAMIC);
$STR_DESC_INIT (DESCRIPTOR = log_descr, CLASS = DYNAMIC);
! Start the string with the job name and so forth.
$STR_COPY(TARGET = log_descr,
STRING = $STR_CONCAT ('Request ',
$STR_ASCII (.req_block[DIU$H_REQUEST_ID]),
' (',
(.req_block[DIU$H_JOBNAME],
CH$PTR (req_block[DIU$T_JOBNAME])),
') created by user ',
(.req_block[DIU$H_USERNAME],
CH$PTR(req_block[DIU$T_USERNAME])),
%CHAR(%C':',13,10,%C'-',9)));
! Get the function figured out
SELECTONE .req_block[DIU$H_FUNCTION] OF
SET
function_to_string (COPY, 'COPY ',
APPEND, 'APPEND ',
DELETE, 'DELETE ',
RENAME, 'RENAME ',
PRINT, 'PRINT ',
SUBMIT, 'SUBMIT ',
DIRECTORY,'DIRECT ')
TES;
! Get the filespecs formatted
q$extract_filespecs (req_block, source_descr, dest_descr);
$STR_APPEND (TARGET = log_descr,
STRING = source_descr);
! Get the switches that we care about extracted
q$options_extract (req_block, options_descr);
! Append destination filespecs if needed
SELECTONE .req_block[DIU$H_FUNCTION] OF
SET
[DIU$K_COPY, DIU$K_DIRECTORY, DIU$K_RENAME, DIU$K_APPEND] :
$STR_APPEND (TARGET = log_descr,
STRING = $STR_CONCAT (continuation,
'(to) ',
dest_descr));
[DIU$K_PRINT, DIU$K_SUBMIT]:
$STR_APPEND (TARGET = log_descr,
STRING = $STR_CONCAT (continuation,
'(after copying to) ',
dest_descr));
TES;
! Append in the options
$STR_APPEND (TARGET = log_descr,
STRING = $STR_CONCAT (continuation,
options_descr));
! Free memory and return
$XPO_FREE_MEM (STRING = source_descr);
$XPO_FREE_MEM (STRING = dest_descr);
$XPO_FREE_MEM (STRING = options_descr);
END; ! End of l$new_request
END ! End of module
ELUDOM