NetNews Usenet Archive 1992 #26/NN_1992_26.iso/spool/comp/os/vms/17736

Internet Message Format | 1992-11-10 | 8.9 KB

Path: sparky!uunet!ogicse!uwm.edu!spool.mu.edu!news.nd.edu!bsu-cs!bsu-ucs.uucp!00prneubauer
From: [e-mail] (Paul Neubauer)
Newsgroups: comp.os.vms
Subject: Re: TPU -- get process info question
Message-ID: <1992Nov10.115144.11709@bsu-ucs>
Date: 10 Nov 92 16:51:44 GMT
Article-I.D.: bsu-ucs.1992Nov10.115144.11709
References: <[e-mail]> <[e-mail]>
Distribution: usa
Organization: Ball State U.
Lines: 173

In article <[e-mail]>,
 Ken Fairfield, [e-mail] writes:
> In article <[e-mail]>,
>  [e-mail] (UCC MR. D M YOSHIKAMI) writes:
>>
>> Quick TPU question.  We have a small tpu script in which it would be nice to
>> have the USERNAME (right now we have to enter it by hand).  Is there a way to
>> do the equivalent of GETJPI("","USERNAME") without going through a lot of
>> trouble?  I was looking for a function (maybe I overlooked something in the
>> manual?), and thought I'd eventually have to spin off a subprocess to look it
>> up, which seems to be an awful lot of work for so simple a function.
>
>     There is no TPU built-in function to do what you want.
>
>     OTOH, you can write a TPU_CALLUSER program (shareable image), in the
> language of your choice, which in turn calls, e.g. LIB$GETJPI, and returns
> the information you wanted to your TPU procedure.  Look in the VAXTPU manual
> (page 7-39/7-42 in the VMS V5.2 docs) for the description of CALL_USER.  It
> contains an example VAX BASIC (really! ;-).
>
>     The only tricky part of all this is that the string _returned_ by your
> procedure must be by DYNAMIC string descriptor (which is why the example is
> in BASIC).  In Fortran, which uses static descriptors, you'll need to call
> STR$GET1_DX and STR$COPY_DX in order to "get and fill" a dynamic string.
> From C, you should be able to use the DESCRIP.H macros to handle the
> descriptors.  Someone else will have to comment on PASCAL...

No problem, Ken.  :-)  Here's a Pascal program that does what he wants
(and then some :-).  The internal docs show how to build and use it.

    Paul
--
Paul Neubauer   [e-mail]  [e-mail]
                [e-mail]       [e-mail]

---------------  Cut here ----------------
(******************************************************************************)
(* FACILITY:                                                                  *)
(*      EVE extensions                                                        *)
(*                                                                            *)
(* ABSTRACT:                                                                  *)
(*      This is a module of functions to be called by means of the            *)
(*      TPU built-in CALL_USER.                                               *)
(*                                                                            *)
(* ENVIRONMENT:                                                               *)
(*      VAX/VMS, version 5.0 or higher (This version built with 5.5)          *)
(*                                                                            *)
(* LANGUAGE: VAX Pascal, version 3.8 or higher (This version built with 4.2)  *)
(*                                                                            *)
(* AUXILIARY FILE(S) REQUIRED:                                                *)
(*      None.  The shareable image created from this source file is           *)
(*      itself an auxiliary file to the EVE section file.                     *)
(*      The logical name TPU$CALLUSER must be defined to point to             *)
(*      the shareable image.                                                  *)
(*                                                                            *)
(* BUILD PROCEDURE:                                                           *)
(*      $ pascal calluser                                                     *)
(*      $ link/share calluser, sys$input/opt                                  *)
(*      universal=tpu$calluser                                                *)
(*      ^Z                                                                    *)
(*      $ define tpu$calluser <device>:[<directory>]calluser.exe              *)
(*                                                                            *)
(* USAGE EXAMPLES:                                                            *)
(*      section := call_user (1, "tpu$section") !translates log name          *)
(*      value   := call_user (2, "symbol_name") !translates symbol to string  *)
(*      user    := call_user (3, ""));          !username to variable "user"  *)
(*      message   (call_user (4, ""));          !displays process name        *)
(*                                                                            *)
(* AUTHOR:  Paul Neubauer                                                     *)
(*                                                                            *)
(* DATE:  8-Jul-1992                                                          *)
(*                                                                            *)
(* VERSION:  2.0                                                              *)
(*                                                                            *)
(* MODIFIED BY: PRN, 10-NOV-1992                                              *)
(*                                                                            *)
(******************************************************************************)
[INHERIT ('sys$library:starlet',
          'sys$library:pascal$lib_routines',
          'sys$library:pascal$str_routines')]
MODULE calluser;
CONST
    maxlen     = 200;
TYPE
    varstring  = varying [maxlen] of char;
    fixstring  = packed array [1..maxlen] of char;
    $uword     = [word] 0..65535;               {repeated from STARLET.PAS}
    $byte      = [byte] -128..127;              {because hidden there}
    $ubyte     = [byte] 0..255;

{ Translate a DCL logical name and return the translation as a string.
  Return null string if no translation found.
}
PROCEDURE translate_lnm (    input_string  : varstring ;
                         VAR output_string : varstring );
VAR
    return_status    : integer;
    trnlnm_item_list :  RECORD
                        buffer_length : $uword;
                        item_code     : $uword;
                        buffer_address: integer;
                        return_length : integer;
                        end_of_list   : integer;
                        END;
BEGIN
    output_string := '';
    with trnlnm_item_list do                {build the item list}
        BEGIN
        buffer_length   := size(output_string.body);
        item_code       := lnm$_string;
        buffer_address  := iaddress(output_string.body);
        return_length   := iaddress(output_string.length);
        end_of_list     := 0;
        END; {with}
    return_status := $trnlnm(
        attr    := lnm$m_case_blind,
        tabnam  := 'LNM$DCL_LOGICAL',
        lognam  := input_string,
        itmlst  := trnlnm_item_list);
END; {procedure translate_lnm}

{ Get Job/Process Information and return as string.
}
PROCEDURE jpi ( VAR the_info:varstring ; item:$UWORD );
TYPE
    sys$itmlst = RECORD
                 buffer_length  : $uword;
                 item_code      : $uword;
                 buffer_address : unsigned;
                 return_address : integer;
                 terminator     : unsigned;
                 END;
VAR
    item_list : sys$itmlst;
    outstring : varstring;
    how_many  : $uword;
    status    : unsigned;
BEGIN
the_info := '';
item_list.buffer_length  := size(the_info.body);
item_list.item_code      := item;
item_list.buffer_address := iaddress(the_info.body);
item_list.return_address := iaddress(the_info.length);
item_list.terminator     := 0;
status := $getjpiw (itmlst := item_list);
END; {procedure jpi}

[global] FUNCTION tpu$calluser ( dispatch_no : integer   ;
                                 VAR input   : dsc1$type ;
                                 VAR output  : dsc1$type ) : integer;
VAR
    the_status : unsigned;
    instring   : varstring;
    outstring  : varstring;
BEGIN
    {First change the input string to a form we can use directly.}
    the_status  := str$copy_dx ( %DESCR instring , %REF input );
    outstring   := '';
    CASE dispatch_no OF
        1       : translate_lnm ( instring , outstring );
        2       : lib$get_symbol ( %REF input , %DESCR outstring );
        3       : jpi ( outstring , jpi$_username );
        4       : jpi ( outstring , jpi$_prcnam );
        otherwise outstring := ''
        END; {case}
    IF (outstring = '') THEN
        tpu$calluser := ss$_badparam
    ELSE
        tpu$calluser := ss$_normal;
    the_status  := str$copy_dx ( %REF output , outstring );
END; {function tpu$calluser}

END. {module calluser}