Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/diuqut.b36
There are 4 other files named diuqut.b36 in the archive. Click here to see a list.
%TITLE 'DIU Queue Request Block Maniupuation'

MODULE DIUQUT (IDENT = '224',
               LANGUAGE(BLISS36),
               ENTRY(q$req_block_init,     ! Init a request block
                     q$copy_req_block,     ! Copy a request block
                     q$release_chain,      ! Free chain of blocks
                     q$extract_filespecs,  ! Extract filespecs from reqblk
                     move_without_password,! Strip password from filespec
                     q$valid_req_block,    ! Validate new request
                     q$fnode,              ! Find node in filespec buffer
                     q$options_extract     ! Get options from request blk
                    )
               )=
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 some simple utility routines for 
!               dealing with request blocks.
!
! ENVIRONMENT:  TOPS-20 V6.1   RMS V3
!               BLISS-36 V4    XPORT
!
! AUTHOR:       Rick Fricchione (DIU version)        CREATION DATE: Aug 10,1984
!               Larry Campbell  (FTS Version)        CREATION DATE: May 6,1982
! HISTORY:
!
!  234  Change library of RMSUSR to RMSINT.
!       Gregory A. Scott 17-Jul-86
!
!  174  Remove library of TOPS20, use wild_match routine instead of wild  jsys.
!       Fix Q$FNOD bug with embedded access strings.
!       Gregory A. Scott 20-May-86
!
!  156  Remove  DIU$V_CHECKPOINT  reference,  set  DIU$H_WARNING_MAX  to  1  in
!       Q$REQ_BLOCK_INIT.
!       Gregory A. Scott 13-May-86
!
!  152  Q$REQ_BLOCK_INIT didn't default the priority to 10 in a new block.
!       Gregory A. Scott 11-May-86
!
!  150  Q$REQ_BLOCK_INIT very stupidly cleared the  request block a field at  a
!       time.  Now we just clear the whole thing and then reset the version and
!       length.
!       Gregory A. Scott 9-May-86
!
!  122  Routine Q$EXTRACT_FILESPECS had (yet) another bug having to do with 
!       output of multiple source filespecs.
!       Gregory A. Scott 22-Mar-86
!
!  121  Routine Q$EXTRACT_FILESPECS didn't have a prayer of moving the 
!       destination filespecs correctly.  It does now.
!       Gregory A. Scott 19-Mar-86
!
!  102  Change routine name Q$FIND_NODE to Q$FNODE so that LINK doesn't 
!       grab Q$FIND.  Also rewrite it.
!       Gregory A. Scott 28-Mar-86
!
!            40  Put the REQUIRE/LIBRARY of 'TOPS20' into a TOPS-20 only
!                conditional.
!                Sandy Clemens  7-Oct-85
!
!      V01-001  DPR0001        Doug Rayner		 14-Aug-85
!		Minor modifications for TOPS-10.  Support for [P,Pn]'s
!		in request block.  Replace WILD% JSYS with call to routine
!		to emulate it.
!
!      V01-000  RDF0001        Rick Fricchione           10-Aug-1984
!               Original DIU version.  Change for new request block format,
!               rewrite output routines, and modify for new filespec format.
!--
!******************************************************************************
!**              L I B R A R Y   A N D   R E Q U I R E   F I L E S
!******************************************************************************

LIBRARY 'DIU';                          ! DIU Data structures
LIBRARY 'RMSINT';                       ! RMS structures and macros
LIBRARY 'BLI:XPORT';                    ! XPORT of course
!******************************************************************************
!**                 F O R W A R D   R O U T I N E
!******************************************************************************
FORWARD ROUTINE
    q$req_block_init           : NOVALUE, ! Init a request block
    q$release_chain            : NOVALUE, ! Release chain of blocks in heap 
    q$copy_req_block           : NOVALUE, ! Copy a request block
    q$extract_filespecs        : NOVALUE, ! Extract filespecs from request 

    move_without_password      : NOVALUE, ! Move filespec minus password
    move_access_control_string : NOVALUE, ! Move access string sans pswd
    q$valid_req_block,                    ! Validate new request
    q$fnode,                              ! Find node in filespec buffer
    q$options_extract          : NOVALUE; ! Extract options from req blk
!****************************************************************************
!                   E X T E R N A L   R O U T I N E S 
!****************************************************************************
EXTERNAL ROUTINE
    wild_match,				! Do a WILD% JSYS or a simulation
    s$time,                             ! Return current time of day
    s$dtstr : NOVALUE,                  ! Convert date/time to string
    s$ttyno;                            ! Return TTY number
!****************************************************************************
!                 Q $ R E Q _ B L O C K _ I N I T 
!****************************************************************************
GLOBAL ROUTINE q$req_block_init (p_req_block) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Initializes a request block.
!
! FORMAL PARAMETERS:
!   p_req_block         - pointer to the request block
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--

BIND req_block = .p_req_block : $DIU_BLOCK;

CH$FILL(0,DIU$K_LEN,CH$PTR(req_block,0,%BPUNIT));       ! Zero the entire block

req_block[DIU$H_VERSION] = DIU$K_VERSION;       ! Set the block version
req_block[DIU$H_TERMINAL] = s$ttyno();          ! Set the terminal number
req_block[DIU$H_LENGTH] = DIU$K_LEN;            ! Set the length of the block
req_block[DIU$B_PRIORITY] = 10;                 ! Set /PRIORITY to 10
req_block[DIU$H_WARNING_MAX] = 1;               ! Reset /WARNINGS to 1

END;                                ! End of q$req_block_init
!***********************************************************************
!**               Q $ C O P Y _ R E Q _ B L O C K 
!***********************************************************************
GLOBAL ROUTINE q$copy_req_block (p_src_block, p_dst_block) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Copy a request block.  On 36-bit machines, we emit a BLT instruction.
!   On other machines we use CH$MOVE.
!
! FORMAL PARAMETERS:
!   p_src_block         - pointer to source request block
!   p_dst_block         - pointer to destination request block
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--

BIND
        src_block = .p_src_block : $DIU_BLOCK,
        dst_block = .p_dst_block : $DIU_BLOCK;

%BLISS32(
    CH$MOVE (DIU$K_LEN, CH$PTR (src_block, 0, %BPUNIT),
             CH$PTR (dst_block, 0, %BPUNIT));
)

%BLISS36(

    REGISTER
        blt_reg,
        end_reg;

    BUILTIN
        MACHOP;

    blt_reg<18, 18> = src_block;
    blt_reg< 0, 18> = dst_block;
    end_reg = dst_block + DIU$K_LEN;
    MACHOP (%O'251', blt_reg, -1, end_reg, 0);

)

END;                                ! End of q$copy_req_block
!******************************************************************
!**               Q $ R E L E A S E _ C H A I N 
!******************************************************************
GLOBAL ROUTINE q$release_chain (head) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Release a chain of request blocks in heap space.  Each block is
!   preceded by one overhead word which points to the next block.
!
! FORMAL PARAMETERS:
!   head        - pointer to first block in chain
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   Heap space is freed.
!
!--

LOCAL
        current,
        next,
        req_block : REF $DIU_BLOCK;

IF (current = .head) EQL 0 THEN RETURN;
! Empty chain, return

DO BEGIN
     req_block = .current + 1;
     IF .req_block[DIU$H_LENGTH] NEQ DIU$K_LEN
        THEN SIGNAL (DIU$_BUG, DIU$_INV_BLK_LEN);
     ! If the block isn't what we expect, signal an error

     next = ..current;
     $XPO_FREE_MEM(BINARY_DATA=(DIU$K_LEN+%UPVAL,.current,UNITS));
     current = .next;
END UNTIL .current EQL 0;
! Release all the members of the chain..

END;                                ! End of q$release_chain
!*************************************************************************
!**                Q $ E X T R A C T _ F I L E S P E C S 
!*************************************************************************
GLOBAL ROUTINE q$extract_filespecs (p_req_block, p_src, p_dst) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       Extract the filespecs from  a request block, with  the password of  the
!       access control  informatio  replaced  by the  string  "password".   The
!       filespecs  are  copied   to  caller-supplied   descriptors.   All   tag
!       information will be OMITTED.  Since there can be multiple source  files
!       in the request, we loop through those, and extract the filespecs  only,
!       comma listing them  if necessary.   Destination files  are much  easier
!       since we only have one to deal with.
!
! FORMAL PARAMETERS
!
!       p_req_block: pointer to request block
!       p_src_desc: pointer to descriptor for source filespec
!       p_dst_desc: pointer to descriptor for destination filespec
!
!--

BIND
        req       = .p_req_block : $DIU_BLOCK,
        src_desc  = .p_src       : $STR_DESCRIPTOR (CLASS=DYNAMIC),
        dst_desc  = .p_dst       : $STR_DESCRIPTOR (CLASS=DYNAMIC);
 
BIND
        dlen      = req[DIU$H_DESTINATION_FILESPEC],
        dbuf      = req[DIU$T_DESTINATION_FILESPEC],
        slen      = req[DIU$H_SOURCE_FILESPEC],
        sbuf      = req[DIU$T_SOURCE_FILESPEC];
LOCAL
        next_ptr,
        remaining,
        file_ptr,
        file_len,
        temp        : $STR_DESCRIPTOR(CLASS=DYNAMIC),
        current     : $STR_DESCRIPTOR(CLASS=BOUNDED);

! If there are no filespecs just return...

IF (.slen EQL 0) AND (.dlen EQL 0) THEN RETURN;

! Init the number of charactes in the buffer and start a pointer to the spec.

remaining  = .slen;                     ! Init the number of chars in fs buf
file_ptr = CH$PTR(sbuf);                ! Init a pointer to the buffer
 
DO BEGIN
   ! Get the length of the filespec, and point at it.  Then move the filespec
   ! to current.  Call routine to replace the password with "password".

   next_ptr = CH$FIND_CH(.remaining,.file_ptr,$ETG);    ! Look for tag
   IF CH$FAIL(.next_ptr) THEN EXITLOOP; ! Exit if it wasn't found

   file_len = CH$A_RCHAR(next_ptr);     ! Load the length byte
   IF .file_len EQL 0 THEN EXITLOOP;    ! Done if zero length filespec seen

   remaining = .remaining-(2+.file_len); ! Compute bytes left in the spec
   file_ptr = CH$PLUS(.next_ptr,1);     ! Get past the length

   ! Copy the spec into a string descr, then move it changing the password
   ! string into "password".

   $STR_DESC_INIT(DESC=current,STRING=(.file_len,.file_ptr),CLASS=BOUNDED);
   $STR_DESC_INIT(DESCRIPTOR=temp,CLASS=DYNAMIC);
   MOVE_WITHOUT_PASSWORD(current, temp);
 
   ! Copy the resulting string to source file descr that we are returning.  If
   ! we are doing the 2nd through nth files then put in a seperator string.

   IF .src_desc[STR$H_LENGTH] EQL 0 
   THEN $STR_COPY(STRING=temp,TARGET=src_desc)
   ELSE $STR_APPEND(STRING=$STR_CONCAT(%CHAR(%C',',13,10,%C'-',9,' '),temp),
                    TARGET=src_desc);

   ! List all the filespecs until we have reached the end of the sources

   END WHILE .remaining NEQ 0;

! Now do the destination side, there being only one filespec there I hope.
 
file_ptr = CH$FIND_CH(.dlen,CH$PTR(dbuf),$ETG); ! Find the tag
IF CH$FAIL(.file_ptr) THEN RETURN;      ! None there?  Quit now

! There is a dest file there, so copy it back to the caller's desc.

file_len = CH$A_RCHAR(file_ptr);        ! Get the length of the filespec
file_ptr = CH$PLUS(.file_ptr,1);        ! Point to the filespec itself
$STR_DESC_INIT(DESC=current,CLASS=BOUNDED,STRING=(.file_len,.file_ptr));
MOVE_WITHOUT_PASSWORD(current, dst_desc);  ! actually its move with "password"
 
END;                                ! End of q$extract_filespecs
!******************************************************************************
!                M O V E _ W I T H O U T _ P A S S W O R D
!******************************************************************************
GLOBAL ROUTINE move_without_password (p_bounded_descr, p_dest_descr): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!   Copy a filespec string, changing the password in it to the string
!   "password".
!
! FORMAL PARAMETERS
!
!   p_bounded_descr     - bounded descriptor whose remainder string contains
!                         the filespec to scan.
!   p_dest_descr        - output descriptor in which the string scanned goes.
!
! IMPLICIT INPUTS
!
!   None
!
! IMPLICIT OUTPUTS
!
!   None
!
! ROUTINE VALUE and SIGNALS
!
!   None
!--

BIND
        bounded_descr = .p_bounded_descr : $STR_DESCRIPTOR(CLASS=BOUNDED),
        dest_descr    = .p_dest_descr    : $STR_DESCRIPTOR();

LOCAL
	delim;

! We scan through the remainder string, moving the piece scanned
! to the output string, except for the password.  First we try
! for the node name, which will always be terminated by either
! a double quote or a colon.  (Two colons, actually, but if we hit
! a single colon, it's a device name and there's  no access string.)

IF $STR_SCAN(REMAINDER=bounded_descr,STOP='":',
             DELIMITER=delim,SUBSTRING=bounded_descr)
   THEN BEGIN
          $STR_APPEND(TARGET=dest_descr,STRING=bounded_descr);
          IF .delim EQL %C'"'
             THEN move_access_control_string (bounded_descr, dest_descr);
          ! There is either a node spec or a device name.  If delimiter
          ! was double quote, we have an access string to parse.
        END;

! OK, we've scanned (and moved) node spec and access control if
! present.  Now move the remainder string and return.

$STR_APPEND(TARGET=dest_descr,
            STRING=((.bounded_descr[STR$H_MAXLEN]
                   -(.bounded_descr[STR$H_LENGTH]+.bounded_descr[STR$H_PFXLEN])
                   ),
                   CH$PLUS (.bounded_descr[STR$A_POINTER],
                            .bounded_descr[STR$H_LENGTH])
                   ));

END;                                ! End of move_without_password
!***********************************************************************
!**       M O V E _ A C C E S S _ C O N T R O L _ S T R I N G
!***********************************************************************
ROUTINE move_access_control_string (p_bounded_descr, p_dest_descr) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Move the access control string of a filespec, replacing the password
!   with the literal "password".
!
! FORMAL PARAMETERS:
!   p_bounded_descr     - pointer to bounded descriptor whose remainder
!                         string contains that part of the filespec
!                         beginning at the access control string (including
!                         the initial double quote).
!   p_dest_descr        - pointer to descriptor of destination for altered
!                         string.
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--

BIND
        bounded_descr = .p_bounded_descr : $STR_DESCRIPTOR(CLASS=BOUNDED),
        dest_descr = .p_dest_descr       : $STR_DESCRIPTOR ();

LOCAL
        delim;

IF NOT $STR_SCAN(REMAINDER=bounded_descr,SPAN='"',SUBSTRING=bounded_descr)
   THEN SIGNAL (DIU$_BUG);
! Scan and move the inital quote

$STR_APPEND(TARGET=dest_descr,STRING=bounded_descr);

! Now move the four fields of the access control string
! (user-ID, password, account, optional data)

INCR index FROM 1 TO 4 DO
   BEGIN
        $STR_SCAN (REMAINDER = bounded_descr,
                   STOP = '" ', DELIMITER = delim,
                   SUBSTRING = bounded_descr);
        ! Each field will be terminated by either a quote or a space

        IF .bounded_descr[STR$H_LENGTH] NEQ 0
        THEN IF .index EQL 2
                  THEN $STR_APPEND(TARGET=dest_descr,STRING='password')
                  ELSE $STR_APPEND(TARGET=dest_descr,STRING=bounded_descr);
        ! If we found a nonempty field, copy it, but fake the password

        bounded_descr[STR$A_POINTER] =  CH$PLUS (.bounded_descr[STR$A_POINTER],
                                                 .bounded_descr[STR$H_LENGTH]);
        bounded_descr[STR$H_PFXLEN] = .bounded_descr[STR$H_PFXLEN]
                                    + .bounded_descr[STR$H_LENGTH];
        ! Skip over the field we just copied

        bounded_descr[STR$H_LENGTH] = 1;

        $STR_APPEND(TARGET=dest_descr,STRING=bounded_descr);
        bounded_descr[STR$A_POINTER] =CH$PLUS(.bounded_descr[STR$A_POINTER],1);
        bounded_descr[STR$H_PFXLEN] = .bounded_descr[STR$H_PFXLEN] + 1;
        bounded_descr[STR$H_LENGTH] = 0;
        ! Copy the delimiter and skip over it

        IF .delim EQL %C'"' THEN RETURN;
        ! If the delimiter was double quote, we're done

    END;

    SIGNAL (DIU$_SPACE_NOT_ALLOWED);    
    ![3] More than four fields???
    
END;                                ! End of move_access_control_string
!**********************************************************************
!                Q $ V A L I D _ R E Q _ B L O C K 
!**********************************************************************
GLOBAL ROUTINE q$valid_req_block (p_req_block) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Validate a request being entered in the queue.
!
! FORMAL PARAMETERS:
!   p_req_block         - pointer to request block to check.
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   DIU$_INVALID_REQUEST        - general purpose badness
!   DIU$_INV_FUNCTION_CODE      - invalid DIU function code
!   DIU$_INV_BLK_LEN            - invalid request block length
!   DIU$_INV_FLAGS              - inconsistent or invalid flags settings
!
! SIDE EFFECTS:
!   NONE
!
!--

BIND req_block = .p_req_block : $DIU_BLOCK;

! Make sure it is the right version and length

IF .req_block[DIU$H_VERSION] NEQ DIU$K_VERSION
THEN RETURN (DIU$_INV_REQ_BLK_VER);

IF .req_block[DIU$H_LENGTH] NEQ DIU$K_LEN
THEN RETURN (DIU$_INV_BLK_LEN);

! Validate the function code in an interesting way

SELECTONE .req_block[DIU$H_FUNCTION] OF
SET
[DIU$K_COPY, DIU$K_APPEND, DIU$K_DELETE, DIU$K_RENAME,
 DIU$K_PRINT, DIU$K_SUBMIT, DIU$K_DIRECTORY] : ;

[OTHERWISE] : RETURN (DIU$_INV_FUN_CODE);
TES;

IF.req_block[DIU$H_SOURCE_FILESPEC] EQL 0       ! Validate the filespec
THEN RETURN (DIU$_INV_STR_LENGTH);

! Can't specify the following bit

IF .req_block[DIU$V_DELETED]
THEN RETURN (DIU$_INV_FLAGS);

! Check for /AFTER is later than /DEADLINE 

IF (.req_block[DIU$G_AFTER] NEQ 0) AND (.req_block[DIU$G_DEADLINE] NEQ 0)
THEN IF .req_block[DIU$G_AFTER] GEQ .req_block[DIU$G_DEADLINE]
     THEN RETURN (DIU$_DEADLINE_CONFLICT);

! /DEADLINE has already gone by

IF (.req_block[DIU$G_DEADLINE] NEQ 0) AND 
   (.req_block[DIU$G_DEADLINE] LEQ s$time ())
THEN RETURN (DIU$_DEADLINE_PAST);

RETURN (DIU$_NORMAL);

END;                                ! End of q$valid_req_block
!********************************************************************
!                         Q $ F N O D E 
!********************************************************************
GLOBAL ROUTINE q$fnode (p_buff,p_buff_len,p_node,p_node_len) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:

!       This routine will attempt to find  the given node name in the  filespec
!       buffer given.  It will skip over  the tag information and only look  at
!       the file specifications.   We take  the node  name and  run a  wildcard
!       match against it. If  any of the filespecs  match, we return TRUE.   If
!       none do, we return FALSE.
!
!       Note that all filespecs with the global  tags (if any) and an ETG,  and
!       end (either they or their tag streams) with one.  Therefore to find the
!       filespecs, we simply  find the  ETG bytes.  The  ETG is  followed by  a
!       character count including the null at  the end of the filespec.   After
!       the null is another count byte.
!
!       globaltags,$ETG,filespeclength,filespec,tags,$ETG,null
!
! FORMAL PARAMETERS:
!
!       buff: Address of a CH$PTR to filespec buffer we are to search.
!       buff_len: Length of filespec buffer
!       node: Address of an CH$PTR to node name to search for.
!             This must not contain colons (::).
!       node_len: Length of node name
!
! ROUTINE VALUE
!
!       TRUE: match
!       FALSE: no match
!--

LITERAL node_max = 6;

BIND buff     = .p_buff,
     buff_len = .p_buff_len,
     node     = .p_node,
     node_len = .p_node_len;

LOCAL match,
      buff_node_len,
      buff_node_end,
      file_ptr,
      file_len,
      next_ptr,     
      remaining,
      source_buf  : VECTOR[CH$ALLOCATION(node_max+1)];

! Point file_ptr to the buffer.

file_ptr = CH$PTR(buff);                ! Point to start of buffer
remaining = buff_len;                   ! Get max characters left to look at

DO BEGIN

! Find the next tag in the buffer and point to the filespec after it

    next_ptr = CH$FIND_CH(.remaining,.file_ptr,$ETG);   ! Find the ETG
    IF CH$FAIL(.next_ptr) THEN RETURN FALSE;    ! Return if no ETG found
    file_len = CH$A_RCHAR(next_ptr);            ! Get length of this file spec
    next_ptr = CH$PLUS(.next_ptr,1);            ! Skip over the count byte
    IF .file_len EQL 0 THEN RETURN FALSE;       ! Return if end
    remaining = .remaining-(2+.file_len);       ! Compute chars remaining
    file_ptr = .next_ptr;               ! Point to start of current filespec

! Find the end of the node by locating the colons or the beginning of the
! embedded access string, and get length of it.  Then copy it to the source_buf
! and see if it matches.  If it matches, return true.

    buff_node_end = CH$FIND_SUB(.file_len,.file_ptr,    ! Look for access str
                                1,CH$PTR(UPLIT('"')));  ! (end of node name)
    IF CH$FAIL(.buff_node_end)          ! If no embedded access try for ::.
    THEN buff_node_end = CH$FIND_SUB(.file_len,.file_ptr,
                                     2,CH$PTR(UPLIT('::')));

    IF NOT CH$FAIL(.buff_node_end)      ! If we found the end of a node
    THEN BEGIN                          ! Then see if it matches
         buff_node_len = CH$DIFF(.buff_node_end,.file_ptr);
         CH$COPY(.buff_node_len,.file_ptr,      ! Copy node to source buf
                 0,node_max+1,CH$PTR(source_buf));
         IF wild_match(CH$PTR(source_buf),CH$PTR(node)) ! Does it match?
         THEN RETURN TRUE;              ! Yes, return true if match 
         END;                           ! IF NOT CH$FAIL(.buff_node_end)

! Keep searching until we get a null in the buffer.

END UNTIL CH$RCHAR(.file_ptr) EQL $NUL;

! If we get here nothing matched

RETURN FALSE;

END;                                    ! q$fnode
GLOBAL ROUTINE q$options_extract (p_req_block, p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Create a textual representation of request options and copy it to
!   descriptor specified.
!
! FORMAL PARAMETERS:
!   p_req_block         - pointer to request block
!   p_descr             - pointer to descriptor of string to put text in
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    BIND
        req_block = .p_req_block : $DIU_BLOCK,
        descr = .p_descr : $STR_DESCRIPTOR ();

    SELECT 1
    OF
        SET
        [.req_block[DIU$V_NOTIFY_MAIL]] :
            $STR_COPY (TARGET = descr, STRING = '/NOTIFY:MAIL ');
        [.req_block[DIU$V_NOTIFY_TERMINAL]] :
            $STR_COPY (TARGET = descr, STRING = '/NOTIFY:TERMINAL ');
        [.req_block[DIU$V_NOTIFY_IPCF]] :
            $STR_COPY (TARGET = descr, STRING = '/NOTIFY:IPCF ');
        TES;
    IF .req_block[DIU$B_PRIORITY] NEQ 10
    THEN
        $STR_APPEND (TARGET = descr,
                     STRING =
                         $STR_CONCAT ('/PRIORITY:',
                                      $STR_ASCII (.req_block[DIU$B_PRIORITY],
                                                  BASE10),
                                      ' '));
    !
    ! If /DEADLINE exists, cons up a string to represent it
    !
    IF .req_block[DIU$G_DEADLINE] NEQ 0
    THEN
        BEGIN
        LOCAL
            time_descr : $STR_DESCRIPTOR ();
        $STR_DESC_INIT (DESCRIPTOR = time_descr, CLASS = DYNAMIC);
        s$dtstr (.req_block[DIU$G_DEADLINE], time_descr);
        $STR_APPEND (TARGET = descr,
                     STRING = $STR_CONCAT ('/DEADLINE:',
                                           time_descr,
                                           ' '));
        $XPO_FREE_MEM (STRING = time_descr);
        END;
    !
    ! If /AFTER exists, cons up a string to represent it
    !
    IF .req_block[DIU$G_AFTER] NEQ 0
        AND .req_block[DIU$G_AFTER] GTR s$time ()
    THEN
        BEGIN
        LOCAL
            time_descr : $STR_DESCRIPTOR ();
        $STR_DESC_INIT (DESCRIPTOR = time_descr, CLASS = DYNAMIC);
        s$dtstr (.req_block[DIU$G_AFTER], time_descr);
        $STR_APPEND (TARGET = descr,
                     STRING = $STR_CONCAT ('/AFTER:',
                                           time_descr,
                                           ' '));
        $XPO_FREE_MEM (STRING = time_descr);
        END;
    !
    ! Append /LOG and /NOTIFY switches to options line
    !
    IF .req_block[DIU$H_LOG_FILESPEC] NEQ 0
    THEN
        $STR_APPEND (TARGET = descr,
                     STRING = $STR_CONCAT ('/LOG:',
                                           (.req_block[DIU$H_LOG_FILESPEC],
                                            CH$PTR (req_block[DIU$T_LOG_FILESPEC]))));
    !
    ! If prerequisite exists, append that and value of /SEQUENCE switch
    !
    IF .req_block[DIU$H_PREREQUISITE_ID] NEQ 0
    THEN
        BEGIN
        $STR_APPEND (TARGET = descr,
                     STRING = $STR_CONCAT ('/PREREQUISITE:',
                                           $STR_ASCII (.req_block[DIU$H_PREREQUISITE_ID]),
                                           '/SEQUENCE:'));
        IF .req_block[DIU$V_SEQ_CONTINUE]
        THEN
            $STR_APPEND (TARGET = descr,
                         STRING = 'CONTINUE-ON-ERROR')
        ELSE
            $STR_APPEND (TARGET = descr,
                         STRING = 'ABORT-ON-ERROR');
        END;
    END;                                ! End of q$options_extract

END
ELUDOM