From:	SMTP%"turion@research.ptt.nl" 23-MAR-1994 08:43:41.89
To:	EVERHART
CC:	
Subj:	part 12 status tool

X-Newsgroups: comp.os.vms
From: turion_s@dnlts0research.ptt.nl. (Paul Turion)
Subject: part 12 status tool
Message-Id: <1994Mar21.144729.1917@news.research.ptt.nl>
Sender: turion_s@research.ptt.nl (Paul Turion)
Nntp-Posting-Host: dnlts0.research.ptt.nl
Reply-To: turion@research.ptt.nl
Organization: PTT Research
X-Newsreader: mxrn 6.18-4
Date: Mon, 21 Mar 1994 14:47:29 GMT
Lines: 417
To: Info-VAX@CRVAX.SRI.COM
X-Gateway-Source-Info: USENET


-- 
 ------- --------------------  			Paul Turion 
| p t t |  r e s e a r c h   |			The Netherlands
|      _|                    | 			e-mail address
|    _|_|   .  .  .  .  .    |			P.Turion@research.ptt.nl
|___|_|      
My interest is in the future because
I am going to spend the rest of my life there.
-+-+-+-+-+-+-+-+ START OF PART 12 -+-+-+-+-+-+-+-+
X                   readv(boot_string, day);
X
X                   boot_string := substr(boot_string, 6, 5);
X
X                   if day <> 0 then
X                      writev(temp_string, day:3, '+', boot_string)
X                   else temp_string := '    ' + boot_string;
X
X                   if load_avg`0911`093 < 0 then
X                      writev(load_string, '  (Unavailable)  ')
X                   else writev(load_string, load_avg`0911`093:5:2, ' ', load
V_avg`0912`093:5:2, ' ', load_avg`0913`093:5:2);
X
X                   writeln(outfile, node_name, ' ':3, temp_string, ' ':3, op
Vr_sys:4, ' ':3, cpu_type, ' ':3, freepages:6, ' ':3,
X                                    inter_proc:3, ' ',batch_proc:3, ' ', tot
Val_proc:3, ' ':3, load_string:17);
X                end;  `123 with `125
X
X         if cli$present('TOTAL') = CLI$_PRESENT then
X            begin
X               writeln(outfile);
X               writeln(outfile, stats.tot_int:1, ' Interactive Users, ', sta
Vts.tot_bat:1, ' Batch Jobs, ',
X                                stats.tot_prc:1, ' Total Processes');
X            end;  `123 then `125
X
X      end  `123 then `125
X   else for loop := 1 to data.num_rec do
X           begin
X              infostring := data.data_buf`091loop`093`094;
X              status := str$trim(infostring, infostring, len);  `123 Trim th
Ve returned string `125
X              writeln(outfile, infostring:len);  `123 Print out the shortene
Vd string `125
X           end;  `123 for `125
X
X   close(outfile);  `123 Close the output file `125
X
Xend;  `123 printoutput `125
X
X
X
Xprocedure setupoutput(var outfile: text);
X
Xvar
X   len: $uword;  `123 Return length of the value `125
X   filename: varying `091256`093 of char;  `123 Filename that is specified `
V125
X
Xbegin
X   filename.length := 256;  `123 Initialy our filename can be 256 chars long
V `125
X   len := 0;  `123 Initialize the return length `125
X
X   if cli$get_value('OUTPUT', filename, len) <> CLI$_ABSENT then  `123 If th
Vere is a value on the line, get it `125
X      begin
X         filename.length := len;  `123 Set the length to that which was retu
Vrned `125
X         open(outfile, filename, new);  `123 Open the file `125
X      end  `123 then `125
X   else open(outfile, 'SYS$OUTPUT', new);  `123 Open the terminal we are usi
Vng `125
X   rewrite(outfile);  `123 Rewrite the file `125
Xend;  `123 setupoutput `125
X
X
X
Xprocedure getnodes(var nodes: dae_nodes_descr);
X
Xvar
X   len: $uword;
X   stat: integer;
X   log_name: varying `091255`093 of char;
X
Xbegin
X   log_name.length := 255;
X
X   if cli$get_value('SELECT', log_name, len) <> CLI$_ABSENT then  `123 If th
Vere is a value on the line, get it `125
X      begin
X         log_name.length := len;
X         what_trnlnm(nodes, log_name);
X      end  `123 then `125
X   else if cli$present('NODE') <> CLI$_ABSENT then
X           what_retnodes(nodes)
X        else begin
X                nodes.num_nodes := 1;
X                nodes.node_arr`0911`093.length := curr_node.length;
X                nodes.node_arr`0911`093.node_name := curr_node;
X             end;
Xend;  `123 getnodes `125
X
X
X
Xprocedure getfunction(var func: unsigned);
X
Xbegin
X   if cli$present('FULL') = CLI$_PRESENT then  `123 If FULL is present, then
V see if all is present `125
X      if cli$present('ALL') = CLI$_PRESENT then  `123 If ALL is present , th
Ven `125
X         func := DAE_SYSTEM  `123 - we want all system processes in full for
Vmat `125
X      else func := DAE_FULL  `123 We just want the full format of user proce
Vsses `125
X   else if cli$present('STATUS') = CLI$_PRESENT then  `123 If they want the
V status then `125
X           func := DAE_STATUS  `123 - just get the status `125
X        else func := DAE_BRIEF;  `123 We just want a brief format of user pr
Vocesses `125
Xend;  `123 getfunction `125
X
X
X
Xfunction getinfo(var nodes: dae_nodes_descr; func: unsigned): boolean;
X
Xvar
X   len: $uword;
X   comm_value: varying `091256`093 of char;
X   users: dae_match_buffer;
X
Xbegin
X   if cli$present('SILENT') = CLI$_PRESENT then  `123 If /SILENT, don't sign
Val error messages `125
X      func := uor(DAE_M_SILENT, func);
X
X   users.length := 0;
X   comm_value.length := 256;
X
X   if (cli$get_value('USER', comm_value, len) <> CLI$_ABSENT) then
X      begin
X         comm_value.length := len;
X         what_buildusers(users, comm_value, len);
X         users.length := len;
X      end;  `123 then `125
X   getinfo := dae_getinfo(func, nodes, users);
Xend;  `123 getinfo `125
X
X
X
X`091initialize`093 procedure setup;
X
Xvar
X   stat,
X   loop: integer;
X   syi_func: unsigned;
X   len: $uword;
X
Xbegin
X   date(date_str);
X   time(time_str);  `123 Get the date and time strings `125
X
X   syi_func := SYI$_NODENAME;
X   stat := lib$getsyi(syi_func,,curr_node,len);  `123 Get the current node w
Ve are on `125
X   if not odd(stat) then lib$signal(stat);
X   curr_node.length := len;  `123 Get its length `125
X
X   nodes.num_nodes := 0;
X   stats.num_stats := 0;  `123 Initialize all static variables `125
X   stats.tot_int := 0;
X   stats.tot_bat := 0;
X   stats.tot_net := 0;
X   stats.tot_prc := 0;
X   for loop := 1 to DAE_MAX_NUM_NODES do
X      begin
X         with nodes.node_arr`091loop`093 do
X            begin
X               length := 0;
X               node_name := '      ';
X            end;  `123 with nodes `125
X         with stats.stat_arr`091loop`093 do
X            begin
X               node_name := '      ';
X               opr_sys := '        ';
X               cpu_type := '    ';
X               boot_time.l0 := 0;
X               boot_time.l1 := 0;
X               login_lim := 0;
X               inter_proc := 0;
X               batch_proc := 0;
X               netwrk_proc := 0;
X               total_proc := 0;
X               load_avg`0911`093 := 0;
X               load_avg`0912`093 := 0;
X               load_avg`0913`093 := 0;
X               freepages := 0;
X            end;  `123 with stats `125
X      end;  `123 for `125
Xend;  `123 setup `125
X
X
X
Xbegin
X   getnodes(nodes);
X
X   getfunction(func);
X
X   if getinfo(nodes, func) then
X      begin
X         setupoutput(outfile);
X
X         outputheader(outfile, func);
X
X         printoutput(outfile);
X      end
Xend.  `123 what `125
$ CALL UNPACK WHAT.PAS;3 923161372
$ create/nolog 'f'
X$!
X$!  This command procedure is modified by the WHAT manager to define default
X$!  WHAT lookup groups
X$!
X$ define/nolog/sys/exec what_decentral DNLONE,DNLTWS,DNLNWD,DNLCAE
X$ define/nolog/sys/exec what_central   DNLTS0,DNLTS1,DNLSUR,DNLSCR
X$ define/nolog/sys/exec what_cluster   DNLTS0,DNLTS1
X$ define/nolog/sys/exec what_micros    DNLSUR,DNLSCR
X$ define/nolog/sys/exec what_network -
X   DNLTS0,DNLTS1,DNLONE,DNLTWS,DNLNWD,DNLCAE,DNLSUR,DNLSCR
X$!
X$ exit
$ CALL UNPACK WHATLOG.COM;8 739976178
$ create/nolog 'f'
X;***************************************************************************
V****
X;* Module to handle logical name translation *
X;***************************************************************************
V****
X;
X                .title  WHAT_BUILDUSERS
X;
X                $lnmdef                         ; Get logical name constants
X;
X                .psect  what_buildusers_data, con, lcl, noexe, noshr, pic, r
Vel, wrt
X;
Xtable_name:     .ascid  /LNM$FILE_DEV/          ; What table to translate lo
Vgical
X;
Xlog_name:       .ascii  /WHAT_USER_/            ; Prefix for logical name
Xincomming:      .blkb   256                     ; Reserve a mess of storage
V for incoming name
X;
Xlog_descr:      .long   10                      ; How long the logical name
V is
X                .address log_name               ; Where the logical name is
X;
Xequiv_name:     .byte   32`091255`093                 ; Temp place to store
V translation
Xequiv_len:      .long   0                       ; How long temp translation
V is
X;
Xindex:          .long   0                       ; Temporary index into trans
Vlations
Xmax_index:      .long   0                       ; Maximum number of translat
Vions
Xretlength:      .long   0                       ; Dummy return length
X;
Xtrnlnm_list:                                    ; SYS$TRNLNM item list
X                .word   4                       ; The current index is 4 byt
Ves
X                .word   LNM$_INDEX              ; We want to get this index
X                .address index                  ; Where the index is
X                .address retlength              ; Dummy return length
X;
X                .word   4                       ; The maximum index is 4 byt
Ves
X                .word   LNM$_MAX_INDEX          ; We want the maximum index
X                .address max_index              ; Where to put the maximum i
Vndex
X                .address retlength              ; Dummy return length
X;
X                .word   8                       ; How long our string can be
X                .word   LNM$_STRING             ; We want the equivalent str
Ving
X                .address equiv_name             ; Where to put the return st
Vring
X                .address equiv_len              ; Where to put the return le
Vngth
X;
X                .long   0                       ; End of our item list
X;
X;
X;
X;***************************************************************************
V****
X;* What_buildusers *
X;*      This procedure is intended to translate the logical name "WHAT_strin
Vg" *
X;* string being passed in, and return all the users that are associated with
V *
X;* it in the given buffer. *
X;* *
X;* Arguments - *
X;*              USERS - buffer to put the users returned from the logical na
Vme *
X;*                      by descriptor *
X;*              LOG_NAME - logical name string to translate, "WHAT_string" i
Vs *
X;*                         what actually gets translated. *
X;*                      by descriptor *
X;*              LEN - Length return of return string *
X;***************************************************************************
V****
X;
X                .psect  what_buildusers_code, con, exe, lcl, shr, nowrt, pic
V,rel
X;
X                .entry  what_buildusers, `094m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r
V11>
X;
X                movl    4(ap), r0               ; Where the node array is
X                movl    4(r0), r11              ; Save Address of beginning
V of string
X                movl    8(ap), r10              ; Save the logical name
X                movl    12(ap), r9              ; Save the address of the re
Vturn length
X                addw2   (r10), log_descr        ; Add the length of the stri
Vng to translate to the prefix
X                movc3   (r10), @4(r10), incomming ; Save the incomming strin
Vg
X;
X                clrl    index                   ; Initialize our index
X                clrl    max_index               ; For cleanliness, clear the
V maximum index out
X;
X                $trnlnm_s -
X                        tabnam = table_name, -  ; What table to translate un
Vder
X                        lognam = log_descr, -   ; Where our logical name is
X                        itmlst = trnlnm_list    ; Where our item list is
X                blbs    r0, 10$
X                brw     error                   ; Error, get out
X;
X10$:            cmpb    #-1, max_index          ; Are there any translations
X                bneq    20$
X                brw     error                   ; No there aren't, get out
X;
X20$:            movc3   equiv_len, equiv_name, (r11) ; Save first string
X                movb    #`094a/@/, (r3)+           ; Move in the dividor
X                incl    index                   ; Increment our index
X;
Xloop:           $trnlnm_s -
X                        tabnam = table_name, -  ; What table to translate un
Vder
X                        lognam = log_descr, -   ; Where our logical name is
X                        itmlst = trnlnm_list    ; Where our item list is
X                blbc    r0, error
X;
X                movc3   equiv_len, equiv_name, (r3) ; Save first string
X                movb    #`094a/@/, (r3)+           ; Move in the dividor
X;
X                aobleq  max_index, index, loop  ; Keep looping until index >
V max_index
X;
X                movb    #32, -(r3)              ; Clear the last dividor
X                subl3   r11, r3, (r9)           ; Save the length we have re
Vturned
X                movl    #1, r0                  ; We are successfull
X                ret                             ; End of What_buildusers
X;
Xerror:          movc3   (r10), @4(r10), (r11)   ; Just return user to work w
Vith
X                movw    (r10), (r9)             ; Save the length of our str
Ving
X                movl    #1, r0                  ; We are successfull
X                ret                             ; End of What_buildusers
X;
X                .end
$ CALL UNPACK WHAT_BUILDUSERS.MAR;1 1547515782
$ create/nolog 'f'
X`091environment('what_defs')`093module what_defs;
X
Xconst
X   SS$_NORMAL = 1;  `123 Normal successful completion `125
X   SS$_ENDOFFILE = 2160;  `123 End of Sort transmissions `125
X   SYI$_NODENAME = 4313;  `123 Function code get current node `125
X
Xtype
X   $uword = `091word`093 0..65535;
X   $uquad = `091quad`093 record
X               l0,
X               l1: unsigned;
X            end;
X
Xconst
X   DAE_M_CHANNEL = 128;  `123 Mask to return info over a given channel `125
X   DAE_M_STATUS = 64;  `123 Mask to just get the status from the node `125
X   DAE_M_USER = 32;  `123 Mask to get the users on the specified list `125
X   DAE_M_NODE = 16;  `123 Mask to return the node in information `125
X   DAE_M_FULL = 8;  `123 Mask to return info in full format `125
X   DAE_M_SILENT = 4;  `123 Mask to shut off signaling of node errors `125
X   DAE_M_ALL = 1;  `123 Mask to return all processes in what ever format `12
V5
X
X   DAE_V_CHANNEL = 7;  `123 Offset into function mask `125
X   DAE_V_STATUS = 6;  `123 Offset into function mask `125
X   DAE_V_USER = 5;  `123 Offset into function mask `125
X   DAE_V_NODE = 4;  `123 Offset into function mask `125
X   DAE_V_FULL = 3;  `123 Offset into function mask `125
X   DAE_V_SILENT = 2;  `123 Offset into function mask `125
X   DAE_V_ALL = 0;  `123 Offset into function mask `125
X
X   DAE_BRIEF = 0;  `123 Get interactive processes in brief format `125
+-+-+-+-+-+-+-+-  END  OF PART 12 +-+-+-+-+-+-+-+-

