From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CAMPUS.SWARTHMORE.EDU::JAMISON" 29-MAR-1989 17:13
To:	MRGATE::"ARISIA::EVERHART"
Subj:	SHOWDEF  1/2


Received: from physics.swarthmore.edu by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 9446; Wed, 29 Mar 89 16:08:56 EST
Return-path: JAMISON%campus.swarthmore.edu@CUNYVM.CUNY.EDU
Received: from campus.swarthmore.edu by physics.swarthmore.edu; Wed, 29 Mar 89
 15:11 EST
Date: Wed, 29 Mar 89 15:02 EST
From: "John L. Jamison x8508" <JAMISON%campus.swarthmore.edu@CUNYVM.CUNY.EDU>
Subject: SHOWDEF  1/2
To: everhart%arisia.decnet@crd.ge.com
X-VMS-To: IN%"everhart%arisia.decnet@crd.ge.com"

$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! 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 JAMISON
$! on 29-MAR-1989 10:14:34.75.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 2 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 2 files:
$!        SHOWDEF.PAS
$!        DEFDIR.MAR
$!
$!============================================================================
$ 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.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$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"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); 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
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); 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 = "SHOWDEF.PAS"
$ CHECKSUM_IS = 761409998
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X(*
X--    SHOWDEF.PAS`009`009`009Version 1.0`009`00928-March-1989
X--
X--`009John Jamison
X--`009Swarthmore College
X--`009Swarthmore PA 19081
X--`009`009jamison@campus.swarthmore.edu
X--`009`009jamison@swarthmr.bitnet
X--
X--`009Copyright (c) 1989, John L. Jamison  `032
X--
X--`009This program is released for use and free distribution with`032
X--`009absolutely no warranties nor guarantees.  The author(s) and
X--`009their respective institutions shall not be liable for any
X--`009consequential damages which may occur through the use of`032
X--`009this program.
X--`009
X--`009Acknowledgements:
X--`009
X--`009  Michael Gretzinger of the MIT Joint Computer Facility  is
X--`009  gratefully acknowledged for the use of routines in DEFDIR.MAR
X--
X--`009  My thanks to Dan Graham for providing me with DEFDIR.MAR, the
X--`009  veritable guts of this program.
X--
X--`009FUNCTION
X--`009  Lists PID, Owner name, username and default directory for all
X--`009    Interactive, Remote and Dialup processses on the system.
X--`009  Can easily be modified to show additional information. Just add
X--          GETJPI item list blocks and modify write statements.
X--
X--    Files
X--`009SHOWDEF.PAS
X--`009DEFDIR.MAR
X--`009
X--    Requirements:
X--`009This version requires VAX Pascal 3.8, and >= VMS 5.0
X--`009Though some hacking might avail it to usage with 4.x
X--`009   (need to replace inheritance of PASCAL$* environment
X--`009    files, and any v5 specific routines- should be easy)
X--
X--`009This program requires several privileges: (CMKRNL, SYSPRV, WORLD )
X--`009`009defdir.mar requires CMKRNL`032
X--`009`009call to $GETUAI requires SYSPRV
X--`009`009call to $GETJPI requires WORLD
X--
X--`009Alternatively you could install it with privs and let
X--`009anyone use it. Probably not a good idea.
X--
X--    CAUTION:
X--`009Warning: do not use in SMP environment. The writer ran
X--`009it without problem on an 8810 VMS 5.1 non SMP system without
X--`009problem.
X--
X--`009See additional information included in DEFDIR.MAR documentation
X--
X--    Compilation and Linkage:
X--`009$ pascal showdef
X--`009$ macro defdir
X--`009$ link showdef,defdir,sys$system:sys.stb/select
X--
X--`009$ run showdef
X--
X--*)
X
X[inherit('sys$library:starlet','sys$library:pascal$lib_routines',
X'sys$library:pascal$str_routines')]
X
Xprogram SHOWDEF(output);
X
Xtype
X  $uword`009=`009[word] 0..65535;
X  $ubyte`009=`009[byte] 0..255;
X  $uquad`009=`009[quad,unsafe] record l0,l1 : unsigned; end;
X
X  dirStrType`009=`009packed array[1..256] of char;
X
Xvar
X  counter,
X  usernameL,
X  mode,jobtype,
X  cputim`009`009:`009integer;
X
X  pidadr, pid`009`009:`009unsigned;
X  valid_modes,
X  valid_jobtypes`009:`009set of 0..5;
X
X  defdir,
X  imagname`009`009:`009varying[256] of char;
X
X  username`009`009:`009packed array[1..12] of char;
X  Terminal`009`009:`009packed array[1..7] of char;
X  terminall`009`009:`009$uword;
X  stat`009`009`009:`009unsigned;
X
X  uai_iosb,
X  jpi_iosb`009`009:`009record`032
X`009`009iostat,count : $uword;
X`009`009dev_info     : integer;
X  end;
X
X(*  Item List Format-  End with single longword zero *)
X   `124--------------`124----------------`124
X   `124  item code   `124  buffer length `124
X   `124-------------------------------`124
X   `124          buffer address       `124
X   `124-------------------------------`124
X   `124       return length address   `124
X   `124-------------------------------`124  *)
X
X  jpi_itmlst `009`009:`009RECORD
X`009cputim_buflen`009:`009$uword;`009`009(* CPU time: 10 milliseconds *)
X`009cputim_itmcod`009:`009$uword;
X`009cputim_buffer`009:`009unsigned;
X`009cputim_retlen`009:`009unsigned;
X`009imagname_buflen`009:`009$uword;`009`009(* imagename string *)
X`009imagname_itmcod`009:`009$uword;
X`009imagname_buffer,                                                `032
X`009imagname_retlen`009:`009unsigned;
X`009jobtype_buflen,`009`009`009`009(* Jobtype word *)
X`009jobtype_itmcod`009:`009$uword;                          `032
X`009jobType_buffer,
X`009jobType_retlen`009:`009unsigned;
X`009mode_buflen,                            (* Process mode *)
X`009mode_itmcod`009:`009$uword;
X`009mode_buffer,
X`009mode_retlen`009:`009unsigned;             `032
X`009pid_buflen,
X`009pid_itmcod`009:`009$uword;`009`009(* Process PID *)
X`009pid_buffer,
X`009pid_retlen`009:`009unsigned;
X`009username_buflen`009:`009$uword;`009`009(* Process username *)
X`009username_itmcod : `009$uword;
X`009username_buffer,
X`009username_retlen : `009unsigned;
X`009terminal_buflen,`009`009`009(* Terminal *)
X`009terminal_itmcod : `009$uword;
X`009terminal_buffer,
X`009terminal_retlen`009:`009unsigned;
X`009jpi_listend`009:`009unsigned;`009(* Item list terminator *)
X      END;
X
X      uai_name`009`009:`009record
X`009size_byte`009:`009[pos(0)] $ubyte;
X`009str`009`009:`009[pos(8)] packed array[1..31] of char;
X      end;
X      nameL`009`009:`009$uword;
X      owner`009`009:`009varying[31] of char;
X
X      uai_itmlst`009:`009record
X        name_buflen`009:`009$uword;
X`009name_itmcod`009:`009$uword;
X`009name_buffer,
X`009name_retlen`009:`009unsigned;
X        uai_listend`009:`009unsigned;
X      end;
X
Xvalue
X`009uai_name.str`009`009`009:=`009(31 of ' ');
X`009nameL`009`009`009`009:=`0090;
X`009owner`009`009`009`009:=`009'';
X`009uai_itmlst.uai_listend`009`009:=`0090;
X`009uai_itmlst.name_itmcod`009`009:=`009uai$_owner;
X`009uai_itmlst.name_buflen`009`009:=`00932;
X`009jpi_itmlst.jpi_listend`009`009:=`0090;
X`009jpi_itmlst.cputim_buflen`009:=`0094;
X`009jpi_itmlst.cputim_itmcod`009:=`009jpi$_cputim;
X`009jpi_itmlst.cputim_retlen`009:=`0090;
X`009cputim`009`009`009`009:=`0090;
X`009jpi_itmlst.imagname_buflen`009:=`009256;
X`009jpi_itmlst.imagname_itmcod`009:=`009jpi$_imagname;
X`009imagname `009`009`009:= `009'';
X`009jpi_itmlst.jobtype_buflen`009:=`0094;
X`009jpi_itmlst.jobtype_itmcod`009:=`009jpi$_jobtype;
X`009jpi_itmlst.jobtype_retlen`009:=`0090;
X`009jobtype`009`009`009`009:=`0090;
X`009jpi_itmlst.mode_buflen`009`009:=`0094;
X`009jpi_itmlst.mode_itmcod`009`009:=`009jpi$_mode;
X`009jpi_itmlst.mode_retlen`009`009:=`0090;
X`009mode`009`009`009`009:=`0090;
X`009jpi_itmlst.pid_buflen`009`009:=`0094;
X`009jpi_itmlst.pid_itmcod`009`009:=`009jpi$_pid;
X`009jpi_itmlst.pid_retlen`009`009:=`0090;
X`009pid`009`009`009`009:=`0090;     `032
X`009jpi_itmlst.username_buflen`009:=`00912;
X`009jpi_itmlst.username_itmcod`009:=`009jpi$_username;
X`009username`009`009`009:=`009'            ';
X`009usernamel`009`009`009:=`0090;
X`009jpi_itmlst.terminal_buflen`009:=`0097;
X`009jpi_itmlst.terminal_itmcod`009:=`009jpi$_terminal;
X`009defdir`009`009`009`009:=`009'';
X
X`009jpi_iosb.iostat`009`009`009:=`0090;
X`009jpi_iosb.count`009`009`009:=`0090;
X`009jpi_iosb.dev_info`009`009:=`0090;
X
X`009valid_modes`009`009`009:=`009[jpi$k_interactive];
X`009valid_jobtypes`009`009`009:=`009[jpi$k_local,jpi$k_remote,
X`009`009`009`009`009`009jpi$k_dialup];
X
X[external]
Xfunction lib_default_dir(pid : [reference] unsigned;
X`009`009`009 var dir : [class_s] dirStrType):unsigned;
Xextern;`032
X
X
XBEGIN
X  uai_itmlst.name_buffer`009:=`009iaddress(uai_name);
X  uai_itmlst.name_retlen`009:=`009iaddress(nameL);
X  jpi_itmlst.cputim_buffer`009:=`009iaddress(cputim);
X  jpi_itmlst.imagname_buffer`009:=`009iaddress(imagname.body);
X  jpi_itmlst.imagname_retlen`009:=`009iaddress(imagname.length);
X  jpi_itmlst.jobtype_buffer`009:=`009iaddress(jobtype);
X  jpi_itmlst.mode_buffer`009:=`009iaddress(mode);
X  jpi_itmlst.pid_buffer`009`009:=`009iaddress(pid);
X  jpi_itmlst.username_buffer`009:=`009iaddress(username);
X  jpi_itmlst.username_retlen`009:=`009iaddress(usernameL);
X  jpi_itmlst.terminal_buffer`009:=`009iaddress(terminal);
X  jpi_itmlst.terminal_retlen`009:=`009iaddress(terminalL);
X
X`009(* -1 sets GETJPI to iterate through process index table- needs
X`009WORLD privilege *)
X
X  pidadr := -1;
X  stat := ss$_normal;`009(* just to get through WHILE condition *)
X
X  while stat <> ss$_nomoreproc do begin
X`009(* requires WORLD privilege *)
X    stat := $GETJPI(efn    := 1,
X`009`009    pidadr := pidadr,
X`009`009    itmlst := jpi_itmlst,
X`009`009    iosb   := jpi_iosb);
X`009(* check error on call to $GETJPI *)
X   `032
X    if (not odd(stat))`032
X`009and (stat <> ss$_nomoreProc) then`032
X`009`009lib$stop(%immed stat);
X
X    if (stat = ss$_normal) then begin
X`009(* $SYNCHronize to EFN 1 - wait for GETJPI to complete*)
X      stat := $SYNCH(efn  := 1,
X`009`009   iosb := jpi_iosb);
X
X`009(* check error on call to $SYNCH *)
X      if not odd(stat) then`032
X`009 lib$stop(%immed stat);
X
X`009(* check error returned in IOSB of call to $GETJPI *)
X      if not odd(jpi_iosb.iostat) then`032
X`009 lib$stop(%immed stat);
X
X`009(* check for MODE and JOBTYPE matchup *)
X      if (mode in valid_modes)`032
X`009  and (jobtype in valid_jobtypes) then begin`032
X
X`009  (* get default directory. Needs CMKRNL privilege *)
X        stat := lib_default_dir(pid,defDir.body);
X        if not odd(stat) then lib$stop(%immed stat);
X
X`009  (* Trim sets correct .LENGTH field *)
X        stat := str$trim(defDir.body,defDir.body,defDir.length);
X        if not odd(stat) then`032
X`009   lib$stop(%immed stat);
X
X`009  (* get OWNER field from UAF file.  Needs SYSPRV *)
X`009stat := $getuai(,,username,uai_itmlst,,,);
X        if not odd(stat) then lib$stop(%immed stat);
X`009
X`009stat := str$trim(owner.body,uai_name.str,owner.length);
X`009if not odd(stat) then lib$stop(%immed stat);
X
X`009  (* remove null chars returned for Terminal *)
X(*`009for counter:=1 to 7 do`032
X`009  if terminal[counter]=''(0) then`032
X`009     terminal[counter]:=' ';
X*)
X
X        write(hex(pid,8):8);     (* write HEX PID *)
X`009write(' ',uai_name.str);`032
X(*`009write(' ',terminal);`009`032
X*)`032
X        write(' ',username);    `032
X`009write('  ',defDir);
X`009writeln;
X      end
X    end;
X  end;                                                    `032
X               `032
XEND.
$ GOSUB UNPACK_FILE

$ FILE_IS = "DEFDIR.MAR"
$ CHECKSUM_IS = 1984652952
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X        .title  lib_default_dir - obtain default directory of a process
X    `032
X;++
X; FACILITY:     JCF SYSTEM PROGRAMS
X;
X; ABSTRACT:     This routine obtains the default directory of a given
X;               process specified by process ID. It uses a special kernel
X;               mode AST to get the translation of SYS$DISK and the directory
X;               string in PIO$GT_DDSTRING of the processes virtual address
X;               space.
X;
X; ENVIRONMENT:  Native, User and Kernel mode, privileged code
X;               Not reentrant -- do not call from AST level.
X;
X; AUTHOR:       Michael R. Gretzinger
X; DATE:         26-OCT-1982
X;
X;       Copyright (C) 1982  MIT Joint Computer Facility
X;
X; MODIFIED BY:  Ned Freed (MATHLIB) converted program to routine.
X;               Extensive rewrite for VMS 4.0.
X;
X;               Ned Freed (MATHLIB) converted to use LNM$SEARCH_ONE;
X;               LNM$SEARCHLOG isn't available in VMS 5.0.
X;
X; Call:
X;   ret-status.wlc.v = DEFDIR (pid.rl.r, dirstring.wt.ds)
X;--
X    `032
-+-+-+-+-+ End of part 1 +-+-+-+-+-
