$! ...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.03 20-Oct-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user TA2
$! on 15-JUN-1989 22:59:03.84.
$!
$! It contains the following 2 files:
$!        SHOWLOCK.C
$!        SL.CLD
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.03 20-Oct-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY

b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) );
s_file_spec := GET_INFO( COMMAND_LINE, "output_file" );SET( OUTPUT_FILE, b_part
, s_file_spec ); 
b_errors := CREATE_BUFFER( "{Errors}" );i_errors := 0; 
pat_beg_1 := ANCHOR & "-+-+-+ Beginning";
pat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning";
pat_end := ANCHOR & "+-+-+-+-+ End";
pat_trail := " " & LINE_END;POSITION( BEGINNING_OF( b_part ) ); LOOP b 
:= SEARCH( pat_trail, FORWARD); EXITIF b=0; POSITION( END_OF( b ) )
; LOOP MOVE_HORIZONTAL( -1 ); EXITIF CURRENT_CHARACTER <> ' '; ERASE_CHARACTER
( 1 ); EXITIF CURRENT_OFFSET=0; ENDLOOP; ENDLOOP; POSITION( BEGINNING_OF
( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE ) = END_OF( b_part )
; s_x := ERASE_CHARACTER( 1 ); 
  IF s_x = "+" THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF; 
  IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF; 
  IF s_x = "V" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x = "X" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x <> "" THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION
( b_errors ); 
    COPY_TEXT( "The following line could not be unpacked properly:" )
; SPLIT_LINE; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part )
; MOVE_VERTICAL( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP 
  r_x := SEARCH( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x )
; ERASE_CHARACTER( 1 ); 
  IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) ); 
  COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; 
  SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" );ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "SHOWLOCK.C"
$ CHECKSUM_IS = 237009852
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * Showlock.C - Show some interesting things from the lock manager database
X *
X * SHOW LOCK
X *`009/ALL
X *`009`009Show all locks. May not be used with /GROUP, /PREFIX or /SYSTEM.
X *
X *`009/GROUP=nnn
X *`009`009Show locks for the UIC group. If not specified, the current
X *`009`009users group id is used. Input value is decimal, use %o for
X *`009`009octal.
X *
X *`009/MODE=USER_MODE`124SUPERVISOR_MODE`124EXECUTIVE_MODE`124KERNEL_MODE
X *`009`009Minimize access mode at which to show locks. Default
X *`009`009is USER. This qualifier applies to /ALL, /GROUP, /PREFIX,
X *`009`009and /SYSTEM.
X *
X *`009/OUTPUT=file
X *`009`009Send program output to file
X *
X *`009/PREFIX=string
X *`009`009Only show locks whose name begins with string.
X *
X *`009/SYSTEM
X *`009`009Show system wide locks
X *
X * Priv's required:
X *`009CMKRNL - Required to get information for all access modes.
X *`009SYSLCK - Needed to get information about system wide locks
X *`009WORLD  - Needed to get information about locks created by
X *`009`009`009other UIC groups.
X */
X
X#include`009<ctype.h>
X#include`009<descrip.h>
X#include`009<lckdef.h>
X#include`009<lkidef.h>
X#include`009<nam.h>
X#include`009<psldef.h>
X#include`009<ssdef.h>
X#include`009<stdio.h>
X#include`009<string.h>
X#include`009<stsdef.h>
X
X/*
X * Data types
X *
X * -- Return buffer descriptor for retlenadr field in some VMS item blocks
X */
Xtypedef`009struct RETBUF `123
X`009unsigned`009buffer_bytes`009: 16;
X`009unsigned`009each_bytes`009: 15;
X`009unsigned`009truncated`009:  1;
X`009`125 RETBUF;
X
X/*
X * -- General VMS system call item descriptor
X */
Xtypedef`009struct ITEM `123
X`009short`009buflen;
X`009short`009code;
X`009void`009*bufadrP;
X`009RETBUF`009*retlenadrP;
X`009`125 ITEM;
X
X/*
X * External routines
X *
X * -- This one from the CRTL doesn't appear to have a prototype anywhere.
X */
Xextern`009int`009getgid(void);
X
X/*
X * -- DCL callback interface
X */
Vextern`009long`009CLI$get_value(struct dsc$descriptor_s*,struct dsc$descriptor_
Xs*,
X`009`009`009`009short*);
Xextern`009long`009CLI$present(struct dsc$descriptor_s*);
X
X/*
X * -- RTL general routines
X */
Xextern`009void`009LIB$signal(long,...);
X
X/*
X * -- RTL string routines
X */
Xextern`009long`009STR$free1_dx(struct dsc$descriptor_s*);
Vextern`009long`009STR$upcase(struct dsc$descriptor_s*,struct dsc$descriptor_s*)
X;
X
X/*
X * -- VMS system services
X */
Xextern`009long`009SYS$cmexec(long (*)(),void*);
Xextern`009long`009SYS$cmkrnl(long (*)(),void*);
Xextern`009long`009SYS$getlkiw(long,long*,void*,void*,void*,long,long);
X
X/*
X * Local routines
X */
Xstatic`009char`009*decode_lock_mode(char);
Xstatic`009char`009*decode_lock_queue(char);
Xstatic`009char`009*decode_processor_mode(int);
Xstatic`009void`009display_lock_information(FILE*);
Xstatic`009long`009issue_SYS$getlkiw(void);
Xstatic`009char`009*make_printable(char*,int);
Xstatic`009void`009process_command_line(void);
X
X/*
X * Local data
X *
X * -- Static data to receive the results from SYS$getlkiw()
X */
Xstatic`009long`009`009lock_id;
Xstatic`009long`009`009lock_owner;
Xstatic`009struct namspace`009lock_space;
Xstatic`009struct statef`009lock_state;
Xstatic`009char`009`009resource_nameA[32];
Xstatic`009RETBUF`009`009resource_name_ret;
X
X/*
X * -- Item list for the SYS$getlkiw() calls
X */
Xstatic`009ITEM`009item_listA[] =
X `123`123sizeof(lock_id),       LKI$_LOCKID,  &lock_id,      NULL`125,
X  `123sizeof(lock_owner),    LKI$_PID,     &lock_owner,   NULL`125,
V  `123sizeof(resource_nameA),LKI$_RESNAM,  resource_nameA,&resource_name_ret`12
X5,
X  `123sizeof(lock_state),    LKI$_STATE,   &lock_state,   NULL`125,
X  `123sizeof(lock_space),    LKI$_NAMSPACE,&lock_space,   NULL`125,
X  `1230,          0,                       NULL,          NULL`125`125;
X
X/*
X * -- Data from the command line
X */
Xstatic`009char`009match_all = FALSE;
Xstatic`009int`009match_group = 0;
Xstatic`009int`009match_mode = PSL$C_USER;
Xstatic`009char`009match_prefixA[32] = "";
Xstatic`009char`009match_system = FALSE;
Xstatic`009char`009outputA[NAM$C_MAXRSS] = "";
Xstatic`009int`009prefix_length = 0;
X
X/*
X * -- Map names of processor modes to access mode constants
X */
Xstatic`009int`009processor_modesA[] =
X `123PSL$C_USER,PSL$C_SUPER,PSL$C_EXEC,PSL$C_KERNEL`125;
Xstatic`009char`009*processor_mode_namesA[] =`032
X `123"USER_MODE","SUPERVISOR_MODE","EXECUTIVE_MODE","KERNEL_MODE"`125;
X#define`009MODES`009(sizeof(processor_modesA)/sizeof(int))
X
X/*
X * -- String descriptors for the command line qualifiers
X */
Xstatic`009$DESCRIPTOR(all_qual_desc,   "ALL");
Xstatic`009$DESCRIPTOR(group_qual_desc, "GROUP");
Xstatic`009$DESCRIPTOR(mode_qual_desc,  "MODE");
Xstatic`009$DESCRIPTOR(output_qual_desc,"OUTPUT");
Xstatic`009$DESCRIPTOR(prefix_qual_desc,"PREFIX");
Xstatic`009$DESCRIPTOR(system_qual_desc,"SYSTEM");
X
X/*
X * -- Other misc. statics
X */
Xstatic`009long`009lki_context = -1;`009/* Select wildcard SYS$getlkiw() mode */
X
X
X`012
X
X/*
X * Main program.
X */
X
Xmain()
X`123
X`009char`009bitison;
X`009char`009display;
X`009char`009done = FALSE;
X`009FILE`009*outfileP;
X`009long`009status;
X`009int`009t;
X
X/*
X * Get the command line qualifiers.
X */
Xprocess_command_line();
X
X/*
X * If no options were specified, match the locks in the UIC group of the
X * current user.
X */
Xif ((!match_all) && (match_group==0) && (prefix_length==0) && (!match_system))
X`009`123
X`009match_group = getgid();
X`009`125
X
X/*
X * Open the output file.
X */
Xif (strlen(outputA) != 0)
X`009`123
X`009if ((outfileP = fopen(outputA,"wt","rat=cr","rfm=var")) == NULL)
X`009`009`123
X`009`009perror("showlock");
X`009`009exit(STS$K_SEVERE`124STS$M_INHIB_MSG);
X`009`009`125
X`009`125
X else`009`123
X`009outfileP = NULL;
X`009`125
X
X/*
X * Call VMS to retrieve the data for each lock in the system.
X */
Xwhile (!done)
X`009`123
X`009switch (status = SYS$cmkrnl(issue_SYS$getlkiw,NULL))
X`009 `123
X`009 case SS$_NORMAL:
X`009`009`123
X`009`009/*
X`009`009 * Does this lock match our criteria?
X`009`009 */
X`009`009display = FALSE;
X
X`009`009/*
X`009`009 * Test the state of the SYSNAM bit. Note the way we have to
X`009`009 * test it. The namspace struct in C 2.4 LKIDEF.H is wrong so
X`009`009 * we have to go around the corner.
X`009`009 */
X`009`009bitison = ((*(long*)&lock_space & LKI$M_SYSNAM) != 0);
X`009`009`032
X`009`009/*
X`009`009 * If /ALL was given, it's a match.
X`009`009 */
X`009`009if (match_all)
X`009`009`009`123
X`009`009`009display = TRUE;
X`009`009`009`125
X
X`009`009/*
X`009`009 * If /GROUP was given, the group field of the lock must
X`009`009 * match.
X`009`009 */
X`009`009if ((match_group!=0) && (match_group==lock_space.lki$w_group))
X`009`009`009`123
X`009`009`009display = TRUE;
X`009`009`009`125
X
X`009`009/*
X`009`009 * If /PREFIX was given, the resource name must begin with
X`009`009 * the pattern.
X`009`009 */
X`009`009t = resource_name_ret.buffer_bytes;
X`009`009if ((prefix_length != 0)
X`009`009 && (t >= prefix_length)
X`009`009 && (strncmp(match_prefixA,resource_nameA,prefix_length) == 0))
X`009`009`009`123
X`009`009`009display = TRUE;
X`009`009`009`125
X
X`009`009/*
X`009`009 * If /SYSTEM was given, see if the SYSNAM bit is on.
X`009`009 */
X`009`009if ((match_system) && (bitison))
X`009`009`009`123
X`009`009`009display = TRUE;
X`009`009`009`125
X
X`009`009/*
X`009`009 * If no options were specified, the SYSNAM bit must be
X`009`009 * off.
X`009`009 */
V`009`009if ((!((match_group!=0)`124`124(prefix_length!=0)`124`124(match_system)
X))
X`009`009 && (!bitison))
X`009`009`009`123
X`009`009`009display = TRUE;
X`009`009`009`125
X
X`009`009/*
X`009`009 * Qualify the decision to display against the access mode
X`009`009 * of the lock.
X`009`009 */
X`009`009if ((display) && (lock_space.lki$b_rmod <  match_mode))
X`009`009`009`123
X`009`009`009display = FALSE;
X`009`009`009`125
X
X`009`009/*
X`009`009 * Display the lock if we made it through all that.
X`009`009 */
X`009`009if (display)
X`009`009`009`123
X`009`009`009display_lock_information(outfileP);
X`009`009`009`125
X
X`009`009break;
X`009`009`125
X`009 case SS$_NOMORELOCK:
X`009`009`123
X`009`009/*
X`009`009 * SYS$getlkiw() has run out locks. Goodbye.
X`009`009 */
X`009`009done = TRUE;
X`009`009break;
X`009`009`125
X`009 default:
X`009`009`123
X`009`009/*
X`009`009 * Unexpected status.
X`009`009 */
X`009`009LIB$signal(status);
X`009`009done = TRUE;
X`009`009`125
X`009 `125
X`009`125
X
X/*
X * Cleanup and exit
X */
Xif (outfileP != NULL)
X`009`123
X`009fclose(outfileP);
X`009`125
Xexit(SS$_NORMAL);
X`125
X
X`012
X
X/*
X * decode_lock_mode - Convert the mode value for lock to a printable two
X * character code.
X */
X
Xstatic char *decode_lock_mode(mode)
X`009char`009mode;
X`123
X`009char`009*retvalP;
X
Xswitch (mode)
X `123
X case LCK$K_NLMODE:`009retvalP = "NL";`009break;
X case LCK$K_CRMODE:`009retvalP = "CR";`009break;
X case LCK$K_CWMODE:`009retvalP = "CW";`009break;
X case LCK$K_PRMODE:`009retvalP = "PR";`009break;
X case LCK$K_PWMODE:`009retvalP = "PW";`009break;
X case LCK$K_EXMODE:`009retvalP = "EX";`009break;
X default:`009`009retvalP = "??"; break;
X `125
Xreturn(retvalP);
X`125
X
X`012
X
X/*
X * decode_lock_queue - Convert the queue value for lock to a printable four
X * character code.
X */
X
Xstatic char *decode_lock_queue(queue)
X`009char`009queue;
X`123
X`009char`009*retvalP;
X
Xswitch (queue)
X `123
X case LKI$C_CONVERT:`009retvalP = "Conv";`009break;
X case LKI$C_GRANTED:`009retvalP = "Grnt";`009break;
X case LKI$C_WAITING:`009retvalP = "Wait";`009break;
X default:`009`009retvalP = "????";`009break;
X `125
Xreturn(retvalP);
X`125
X
X`012
X
X/*
X * decode_processor_mode - Convert a processor access mode to a one character
X * printable value.
X */
X
Xstatic char *decode_processor_mode(mode)
X`009int`009mode;
X`123
X`009char`009*retvalP;
X
Xswitch (mode)
X `123
X case PSL$C_USER:`009retvalP = "U";`009break;
X case PSL$C_SUPER:`009retvalP = "S";`009break;
X case PSL$C_EXEC:`009retvalP = "E";`009break;
X case PSL$C_KERNEL:`009retvalP = "K";`009break;
X default:`009`009retvalP = "?";`009break;
X `125
Xreturn(retvalP);
X`125
X
X`012
X/*
X * display_lock_information - Format the information we have gained about
X * the lock whose data in the static vars.
X */
X
Xstatic void display_lock_information(outfileP)
X`009FILE`009*outfileP;
X`123
Xstatic`009char`009first_call = TRUE;
X`009int`009t;
X
X/*
X * First time through, display the column headings.
X */
Xif (first_call)
X`009`123
V`009      /*IIIIIIII  OOOOOOOO  GGG  M  RR/GG/QQQQ  NNNNNNNNNNNNNNNNNNNNNNNNNNN
XNNNN*/
X`009fprintf(outfileP,"                            State\n");
X`009fprintf(outfileP,"LockID    Owner     Grp  M  Rq/Gr/Que   Name\n");
X`009`125
Xfirst_call = FALSE;
X
X/*
X * Show the lock id number and the process id that owns it
X */
Xfprintf(outfileP,"%08x  ",lock_id);
Xfprintf(outfileP,"%08x  ",lock_owner);
X
X/*
X * Show the UIC group unless this is a system wide lock.
X */
Xif (*(long*)&lock_space & LKI$M_SYSNAM)
X`009`123
X`009fprintf(outfileP,"n/a  ");
X`009`125
X else`009`123
X`009fprintf(outfileP,"%3o  ",lock_space.lki$w_group);
X`009`125
X
X/*
X * Show the process mode of the lock, the lock request mode, its grant mode
X * and which lock queue it is in.
X */
Xfprintf(outfileP,"%s  ",decode_processor_mode(lock_space.lki$b_rmod));
Xfprintf(outfileP,"%s/",decode_lock_mode(lock_state.lki$b_state_rqmode));
Xfprintf(outfileP,"%s/",decode_lock_mode(lock_state.lki$b_state_grmode));
Xfprintf(outfileP,"%s  ",decode_lock_queue(lock_state.lki$b_state_queue));
X
X/*
X * Display the name of the lock
X */
Xt = resource_name_ret.buffer_bytes;
Xfprintf(outfileP,"%*.*s\n",t,t,make_printable(resource_nameA,t));
X`125
X
X`012
X
X/*
X * issue_SYS$getlkiw - Call SYS$getlkiw() using the static item list. This
X * indirected caller function may be passed to SYS$cmkrnl().
X */
X
Xstatic long issue_SYS$getlkiw()
X`123
Xreturn(SYS$getlkiw(0,&lki_context,item_listA,NULL,NULL,0,NULL));
X`125
X
X`012
X
X/*
X * make_printable - Convert all non-printable characters in a string to '.'s.
X * The conversion is done in place.
X */
X
Xchar *make_printable(stringP,length)
X`009char`009*stringP;
X`009int`009length;
X`123
X`009int`009i;
X`009char`009*tP = stringP;
X
Xfor (i=0;i<length;i++)
X`009`123
X`009*tP = ((*tP>=0) && (isprint(*tP))) ? *tP : '.';
X`009tP++;
X`009`125
Xreturn(stringP);
X`125
X
X`012
X
X/*
X * process_command_line - Callback to DCL to retrieve the command line
X * qualifiers. Since DCL validates the command line, we don't need to do
X * a whole lot of error checking. In fact, we do none.
X */
X
Xstatic void process_command_line()
X`123
X`009int`009`009`009i;
X`009char`009`009`009scratchA[100];
V`009struct dsc$descriptor_s`009retdesc = `1230,DSC$K_DTYPE_T,DSC$K_CLASS_D,NULL
X`125;
X`009short`009`009`009retlen;
X
X/*
X * Process /ALL. It's either there or it's not.
X */
Xif ($VMS_STATUS_SUCCESS(CLI$present(&all_qual_desc)))
X`009`123
X`009match_all = TRUE;
X`009`125
X
X/*
X * Process /GROUP. The DCL definition requires the value to be present,
X * so we can just test for the presence of the qualifier. The definition
X * also requires the value to be numeric, so we just convert it.
X */
Xif ($VMS_STATUS_SUCCESS(CLI$present(&group_qual_desc)))
X`009`123
X`009CLI$get_value(&group_qual_desc,&retdesc,&retlen);
X`009strncpy(scratchA,retdesc.dsc$a_pointer,retlen);
X`009scratchA[retlen] = '\0';
X`009match_group = atoi(scratchA);
X`009`125
X
X/*
X * Process /MODE. The DCL definition requires that the value be present, and
X * that it be an unambiguous abbreviation of USER, SUPERVISOR, EXECUTIVE, or
X * KERNEL. Get the value the figure out which mode name it matches.
X */
Xif ($VMS_STATUS_SUCCESS(CLI$present(&mode_qual_desc)))
X`009`123
X`009CLI$get_value(&mode_qual_desc,&retdesc,&retlen);
X`009STR$upcase(&retdesc,&retdesc);
X`009match_mode = -1;
X`009i = 0;
X`009while ((match_mode == -1) && (i < MODES))
X`009`009`123
X`009`009if (strncmp(retdesc.dsc$a_pointer,
X`009`009`009processor_mode_namesA[i],retlen) == 0)
X`009`009`009`123
X`009`009`009match_mode = processor_modesA[i];
X`009`009`009`125
X`009`009i++;
X`009`009`125
X`009`125
X
X/*
X * Process /OUTPUT. Simply pickup the value. This one can be negated, so
X * we do have to watch for that.
X */
Xif ($VMS_STATUS_SUCCESS(CLI$present(&output_qual_desc)))
X`009`123
X`009CLI$get_value(&output_qual_desc,&retdesc,&retlen);
X`009strncpy(outputA,retdesc.dsc$a_pointer,retlen);
X`009outputA[retlen] = '\0';
X`009`125
X else`009`123
X`009outputA[0] = '\0';`009/* Handle /NOOUTPUT */
X`009`125
X/*
X * Process /PREFIX. Again, just pickup the value.
X */
Xif ($VMS_STATUS_SUCCESS(CLI$present(&prefix_qual_desc)))
X`009`123
X`009CLI$get_value(&prefix_qual_desc,&retdesc,&retlen);
X`009strncpy(match_prefixA,retdesc.dsc$a_pointer,retlen);
X`009match_prefixA[retlen] = '\0';
X`009prefix_length = retlen;
X`009`125
X
X/*
X * Process /SYSTEM. It's either there or it's not.
X */
Xif ($VMS_STATUS_SUCCESS(CLI$present(&system_qual_desc)))
X`009`123
X`009match_system = TRUE;
X`009`125
X
X/*
X * Release the dynamic string we have been using.
X */
Xif (retdesc.dsc$a_pointer != NULL)
X`009`123
X`009STR$free1_dx(&retdesc);
X`009`125
X`125
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "SL.CLD"
$ CHECKSUM_IS = 20261160
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X! SL.CLD - VMS CDU definition for the ShowLock utility
X
Xdefine type ACMODE
X   keyword USER_MODE
X   keyword SUPERVISOR_MODE
X   keyword EXECUTIVE_MODE
X   keyword KERNEL_MODE
X
Xdefine verb SL
X   image TOOLS:SHOWLOCK
X   qualifier ALL
X   qualifier GROUP
X      value (required,type=$number)
X   qualifier MODE
X      value (required,type=ACMODE)
X   qualifier OUTPUT
X      default
X      value (default="SYS$OUTPUT",type=$file)
X   qualifier PREFIX
X      value (required)
X   qualifier SYSTEM
X   disallow (ALL and (GROUP or PREFIX or SYSTEM))
X
$ GOSUB UNPACK_FILE
$ EXIT