From:	MERC::"uunet!WKUVX1.BITNET!FILESERV-Mgr"  3-JUN-1992 09:45:33.48
To:	galaxy::gleeve
CC:	
Subj:	GETCMD.01_OF_04

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  2-JUN-1992 13:42:49.66   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 4 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. [.GETCMD]AAAREADME.TXT;1
$!       2. [.GETCMD]BUILD_GETCMD.COM;1
$!       3. [.GETCMD]DESCRIP.MMS;1
$!       4. [.GETCMD]GETCMD.B32;1
$!       5. [.GETCMD]GETCMD.MAR;1
$!       6. [.GETCMD]GETCMD_MSG.MSG;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X!
X!  Copyright `A9 1992 by Hunter Goatley.  All rights reserved.  Permission
X!  is given to freely distribute and modify this software for no commercial
X!  gain as long as this copyright notice is retained.
X!
XGETCMD.B32 is a BLISS-32 program that will display the DCL command recall
Xbuffer for any interactive process on the system.  A MACRO-32 source is
Xsupplied for those who do not have BLISS-32.
X
XThis is a cleaner rewrite of the previous MACRO-32 version; I believe it
Xis bug-free.  While you are to use this program at your own risk, please
Xlet me know if you encounter any problems.
X
XTo build it, simply:
X
X`09$ @BUILD_GETCMD
X`09$ GETCMD :== $dev:`5Bdir`5DGETCMD.EXE
X`09$ GETCMD <pid>
X`09
XQuestions, comments, or suggestions are welcome.
X
XHunter Goatley, VAX Systems Programmer      E-mail: goathunter@WKUVX1.BITNET
XAcademic Computing, STH 226                 Voice:  (502) 745-5251
XWestern Kentucky University
XBowling Green, KY 42101
$ CALL UNPACK [.GETCMD]AAAREADME.TXT;1 1209456644
$ create 'f'
X$ say := write sys$output
X$ if f$search("SYS$SYSTEM:BLISS32.EXE") .eqs. "" then goto _Assemble_Em
X$ say "Compiling GETCMD...."
X$ bliss getcmd
X$ goto _Continue
X$ _Assemble_Em:
X$ say "Assembling GETCMD...."
X$ macro getcmd
X$ _Continue:
X$ message getcmd_msg.msg
X$ say "Linking GETCMD...."
X$ link/notrace getcmd,getcmd_msg,sys$system:sys.stb/sel,dcldef.stb/sel
X$ say "Build completed"
X$ exit
$ CALL UNPACK [.GETCMD]BUILD_GETCMD.COM;1 1731095823
$ create 'f'
Xgetcmd.exe :`09getcmd.obj, getcmd_msg.obj, sys$system:sysdef.stb, -
X`09`09sys$system:dcldef.stb
X`09LINK/NOTRACE/NOMAP/NOCROSS/EXE=$(MMS$TARGET) getcmd.obj,-
X`09`09getcmd_msg.obj,sys$system:sys.stb/selective_search,-
X`09`09sys$system:dcldef.stb/selective_search
X
Xgetcmd.obj :`09`09getcmd.b32
Xgetcmd_msg.obj :`09getcmd_msg.msg
X
Xkit :`09build_getcmd.com,descrip.mms,getcmd.b32,getcmd_msg.msg,getcmd.mar,-
X`09aaareadme.txt
X`09set default `5B-`5D
X`09@dub4:`5Bhunter.hunter`5Dvms_share `5B.getcmd`5D*.*; getcmd
X`09@dub4:`5Bhunter.sig`5Drenumber getcmd
X
Xgetcmd.mar :`09`09getcmd.b32
X`09BLISS/LIST=$(MMS$TARGET)/MACHINE=(ASSEMBLER,UNIQUE_NAMES)-
X`09`09/SOURCE=NOHEADER/NOOBJECT $(MMS$SOURCE)
X`09EDIT/TPU/NODISPLAY/NOJOURNAL/COMMAND=B32:STRIP_BLISS_COMMENTS -
X`09`09$(MMS$TARGET)
X`09PURGE/NOLOG $(MMS$TARGET)
X`09RENAME/NOLOG $(MMS$TARGET); *.*;1
$ CALL UNPACK [.GETCMD]DESCRIP.MMS;1 1615225340
$ create 'f'
X%TITLE`09'GETCMD'
XMODULE GETCMD (MAIN = main, IDENT = '03-001') =`20
XBEGIN
X!
X!  Copyright `A9 1992 by Hunter Goatley.  All rights reserved.  Permission
X!  is given to freely distribute and modify this software for no commercial
X!  gain as long as this copyright notice is retained.
X!
X!++
X!
X!  Facility:`09GETCMD
X!
X!  Author:`09Hunter Goatley
X!
X!  Date:`09February 5, 1992
X!
X!  Abstract:
X!
X!`09This program will display another process's DCL command recall
X!`09buffer.  A special kernel mode AST is queued to the target process
X!`09to gather the information; this AST then queues another AST back
X!`09to the requesting process to copy the information to this program's
X!`09buffer.
X!
X!  Modified by:
X!
X!`0903-001`09`09Hunter Goatley`09`09 2-JUN-1992 08:01
X!`09`09Fixed two stupid problems (thanks to Jon Pinkley for
X!`09`09pointing them out).  GETCMD now compares the IPID with
X!`09`09SCH$GL_SWPPID to avoid checking SWAPPER (or NULL) and
X!`09`09it also checks for a non-existent PRC region.  Also
X!`09`09added checks to be sure that the target CLI is DCL.
X!
X!`0903-000`09`09Hunter Goatley`09`09 5-FEB-1992 06:49
X!`09`09BLISS rewrite of original MACRO-32 program.
X!
X!--
XLIBRARY 'SYS$LIBRARY:LIB';`09`09`09!Pull stuff from LIB
X
X!
X!  Define offsets for extended ACB (starting at ACB$K_LENGTH)
X!
XMACRO ACB_L_USERBUF`09= ACB$K_LENGTH,    0, 32, 0 %;`09!Pointer to local buf
Vf
XMACRO ACB_L_PID`09`09= ACB$K_LENGTH+4,  0, 32, 0 %;`09!PID of this process
XMACRO ACB_L_2ND_KAST`09= ACB$K_LENGTH+8,  0, 32, 0 %;`09!2nd KAST address
XMACRO ACB_L_EFN`09`09= ACB$K_LENGTH+12, 0, 32, 0 %;`09!Event flag to set
XMACRO ACB_L_IMGCNT`09= ACB$K_LENGTH+16, 0, 32, 0 %;`09!Process image count
XMACRO ACB_L_USERPTR`09= ACB$K_LENGTH+20, 0, 32, 0 %;`09!Address for offset
XMACRO ACB_L_RECALLPTR`09= ACB$K_LENGTH+24, 0, 32, 0 %;`09!Offset into buffer
XMACRO ACB_L_USERSTAT`09= ACB$K_LENGTH+28, 0, 32, 0 %;`09!Address for status
XMACRO ACB_L_AST_STATUS`09= ACB$K_LENGTH+32, 0, 32, 0 %;`09!Status from AST #
V1
XLITERAL ACB_S_DCLBUFFER = 1028;`09`09`09`09!Actual size is 1025
XMACRO ACB_T_DCLBUFFER`09= ACB$K_LENGTH+36, 0,  0, 0 %;`09!Reserve space
XLITERAL`09ACB_K_LENGTH`09= ACB$K_LENGTH+36+ACB_S_DCLBUFFER;
XMACRO ACB_T_ASTCODE`09= ACB_K_LENGTH,    0,  0, 0 %;`09!Stick AST code at en
Vd
X
X!
X! MACROS
X!
XLITERAL
X`09true`09= 1,
X`09false`09= 0;
XMACRO
X`09$STATICDESC (len, addr) =`09`09!Static descriptor declaration
X`09`09$BBLOCK`5BDSC$C_S_BLN`5D
X`09`09PRESET`09(`5BDSC$W_LENGTH`5D = len,
X`09`09`09 `5BDSC$B_DTYPE`5D`09= DSC$K_DTYPE_T,
X`09`09`09 `5BDSC$B_CLASS`5D`09= DSC$K_CLASS_S,
X`09`09`09 `5BDSC$A_POINTER`5D= addr)
X`09%,
X`09G_HAT =`09`09`09`09`09!General addressing mode
X`09`09ADDRESSING_MODE (GENERAL)
X`09%;
X!
X!  Macro BITFLD takes a normal structure reference macro and converts it
X!  to a bit field reference (it leaves out the byte offset).
X!
XMACRO
X`09BITFLD (b,o,s,t) =
X`09`09<o,s,t>%;
X
X`0C
X%SBTTL`09'Linkages'
X!
X!  Define JSB linkages for external and internal routines.
X!
XLINKAGE
X`09jsb_qast`09= JSB ( REGISTER = 2,`09`09!Priority Increment
X`09`09`09`09REGISTER = 5;`09`09!Pointer to AST block
X`09`09`09`09REGISTER = 4) :`09`09!Target's PCB
X`09`09`09`09NOPRESERVE(1,3)
X`09`09`09`09NOTUSED(6,7,8,9,10,11),
X`09ast_jsb`09`09= JSB ( REGISTER = 4,`09`09!PCB is passed in R4
X`09`09`09`09REGISTER = 5) :`09`09!ACB is passed in R5
X`09`09`09`09NOPRESERVE(1,2,3,4,5)`09!Don't save registers
X`09`09`09`09NOTUSED(6,7,8,9,10,11),
X`09alon_call`09= JSB ( REGISTER = 1;`09`09!Input is size to allo
X`09`09`09`09REGISTER = 1,`09`09!Returns size in R1
X`09`09`09`09REGISTER = 2),`09`09!... & addr in R2
X`09deal_call`09= JSB ( REGISTER = 0) :`09`09!Address of block
X`09`09`09`09NOTUSED(1,2,3,4,5,6,7,8,9,10,11),
X`09pid_call`09= JSB ( REGISTER = 0;`09`09!PID passed in R0
X`09`09`09`09REGISTER = 0) :`09`09!PCB returned in R0
X`09`09`09`09PRESERVE(1,2,3,4,5),`09!R0--R5 are OK
X`09chsep_call`09= JSB (`09REGISTER = 0,`09`09!New priority in R0
X`09`09`09`09REGISTER = 4) :`09`09!PCB address
X`09`09`09`09NOPRESERVE(2)
X`09`09`09`09PRESERVE(1,3,5),
X`09clref_call`09= JSB (`09REGISTER = 3,`09`09!EFN passed in R3
X`09`09`09`09REGISTER = 4),`09`09!PCB addr in R4
X`09postef_call`09= JSB (`09REGISTER = 1,`09`09!The PID in R1
X`09`09`09`09REGISTER = 2,`09`09!Priority increment
X`09`09`09`09REGISTER = 3) :`09`09!The EFN in R3
X`09`09`09`09NOTUSED(4,5,6,7,8,9,10,11);
X
X`0C
X%SBTTL`09'Forwards and Externals'
XFORWARD ROUTINE
X`09main,`09`09`09`09`09!Main entry point
X`09list_cmds,`09`09`09`09!List the commands
X`09krnl_get_dclbuffer,`09`09`09!Kernel mode routine
X`09ast_code`09: NOVALUE ast_jsb,`09!Kernel AST for target prc
X`09ast2_code`09: NOVALUE ast_jsb`09!Second AST for original prc
X`09;
X
XEXTERNAL ROUTINE
X`09LIB$GET_FOREIGN`09: G_HAT,`09`09!Get foreign command line
X`09LIB$PUT_OUTPUT`09: G_HAT,`09`09!Write to SYS$OUTPUT
X`09OTS$CVT_TZ_L`09: G_HAT;`09`09!Convert ASCII # to hex
X
XEXTERNAL ROUTINE
X`09EXE$ALONONPAGED`09: G_HAT alon_call,`09!Allocate from non-paged pool
X`09EXE$DEANONPAGED`09: G_HAT deal_call,`09!Deallocate non-paged
X`09EXE$EPID_TO_PCB : G_HAT pid_call,`09!Convert EPID to PCB address
X`09EXE$IPID_TO_PCB : G_HAT pid_call,`09!Convert IPID to PCB address
X`09SCH$CHSEP`09: G_HAT chsep_call,`09!Make process executable
X`09SCH$CLREF`09: G_HAT clref_call,`09!Clear Event Flag
X`09SCH$POSTEF`09: G_HAT postef_call,`09!Post Event Flag
X`09SCH$QAST`09: G_HAT jsb_qast;`09!Queue an AST
X
XBUILTIN
X`09MOVPSL;
X
XEXTERNAL
X`09CTL$AL_CLICALBK`09: G_HAT LONG,`09`09!Address of CLI callback routine
X`09CTL$GL_PCB`09: G_HAT REF $BBLOCK,`09!P1 pointer to PCB
X`09CTL$GL_PHD`09: G_HAT REF $BBLOCK,`09!P1 pointer to PHD
X`09SCH$GL_SWPPID`09: G_HAT LONG;`09`09!IPID of SWAPPER process
X
XEXTERNAL
X`09GETCMD_NOCLI`09: G_HAT,`09`09!Error: DCL not mapped
X`09GETCMD_NODCL`09: G_HAT,`09`09!Error: CLI is not DCL
X`09GETCMD_NOCMDS`09: G_HAT;`09`09!Msg: no DCL commands to recall
X
X`0C
X%SBTTL`09'MAIN'
XROUTINE main =
XBEGIN
X!+
X!
X!  Routine:`09MAIN
X!
X!  Functional description:
X!
X!`09This is the main routine for GETCMD.  It calls LIB$GET_FOREIGN to
X!`09retrieve the PID of the target process, converts it to binary,
X!`09calls KRNL_GET_DCLBUFFER to queue the necessary ASTs, waits for
X!`09an event flag to be set, and calls LIST_CMDS to display the
X!`09target process's command recall buffer.
X!
X!  Environment:
X!
X!`09User-mode.
X!
X!  Formal parameters:
X!
X!`09None.
X!
X!  Implicit inputs:
X!
X!`09None.
X!
X!  Outputs:
X!
X!`09None.
X!
X!  Returns:
X!
X!`09R0`09- Status
X!
X!-
XLITERAL
X`09event_flag`09= 13;`09`09`09!Pick some event flag
XOWN
X`09pid`09`09: UNSIGNED LONG,`09!Longword for target PID
X`09pid_buff`09: $BBLOCK`5B8`5D,`09`09!Buffer for ASCII PID
X`09pid_d`09`09: $staticdesc(8,pid_buff),`09!Descriptor for buffer
X`09cmd_buffer`09: $BBLOCK`5B1025`5D,`09!Local copy of DCL recall buffer
X`09ast_status,`09`09`09`09!Status from ASTs
X`09recall_ptr`09: LONG,`09`09`09!Offset of last command
X`09krnl_arglst`09: VECTOR`5B6,LONG`5D`09!KRNL_GET_DCLBUFFER arglst
X`09`09`09INITIAL(5,`09`09!... Four arguments follow
X`09`09`09`09event_flag,`09!... The event flag to wait for
X`09`09`09`09pid,`09`09!... The PID of the target prc
X`09`09`09`09cmd_buffer,`09!... Address to receive buffer
X`09`09`09`09recall_ptr,`09!... Address to receive offset
X`09`09`09`09ast_status);`09!... Address to receive status
X
XREGISTER
X`09status`09`09: UNSIGNED LONG;`09!The status
X
X  !
X  !  Call LIB$GET_FOREIGN to pick up the target process's PID.  If the PID
X  !  is not given on the command line, the user will be prompted to enter it
V.
X  !
X  status = LIB$GET_FOREIGN (pid_d, %ASCID'_PID: ', pid_d);
X  IF NOT(.status)`09`09`09`09!Was an error returned?
X  THEN`09`09`09`09`09`09!If so, check to see if user
X     RETURN( (IF (.status EQLU RMS$_EOF)`09!... entered `5EZ; if so, change
X`09      THEN`09`09`09`09!... it to SS$_NORMAL and
X`09`09SS$_NORMAL`09`09`09!... return
X`09      ELSE`09`09`09`09!Otherwise, just return
X`09`09.status));`09`09`09!... the error
X
X  status = OTS$CVT_TZ_L (pid_d, pid);`09`09!Convert from ASCII to hex
X  IF NOT(.status) THEN RETURN (.status);`09!Return any error
X
X  !
X  !  Now switch to kernel mode to queue an AST to the target process.
X  !
X  status = $CMKRNL (ROUTIN = krnl_get_dclbuffer,`09!Call krnl_get_dclbuffer
X`09`09    ARGLST = krnl_arglst);`09`09!... with its arglst
X
X  IF (.status)`09`09`09`09`09!AST queued successfully?
X  THEN`09`09`09`09`09`09!If so, then wait for the
X      status = $WAITFR (EFN = event_flag);`09!... event flag to be set
X
X  IF (.status)`09`09`09`09`09!If successful, then get the
X  THEN`09`09`09`09`09`09!... status from the AST and
X     status = .ast_status;`09`09`09!... use that as the status
X
X  IF (.status)`09`09`09`09`09!If successful, then dump
X  THEN`09`09`09`09`09`09!... the commands to SYS$OUTPUT
X     status = list_cmds (cmd_buffer, recall_ptr);
X
XRETURN (.status);`09`09`09`09!Return status back to VMS
X
XEND;`09`09`09`09`09`09!End of routine
X
X`0C
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
