From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP 11-AUG-1988 18:37
To:	ARISIA::EVERHART
Subj:	STATUS, part 1 of 7 parts


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Wed, 10 AUG 88 11:27:29 PDT
Received: from uwavm.acs.washington.edu (oly.acs.washington.edu) by KL.SRI.COM with TCP; Wed, 10 Aug 88 11:13:22 PDT
Received: from UWAVM.ACS.WASHINGTON.EDU by uwavm.acs.washington.edu ; Wed, 10 Aug 88 11:11:48 PDT
Received: from UWAVM.ACS.WASHINGTON.EDU by UWAVM.ACS.WASHINGTON.EDU (Mailer
 X1.24) with BSMTP id 8234; Wed, 10 Aug 88 11:11:43 PDT
P1-Message-Id: US**EDU;UWAVM.ACS.WASHINGTON.EDU:LTh5MdG@
Date:         Wed, 10 Aug 88 11:10-0700
X400-Trace:   US**EDU; arrival Wed, 10 Aug 88 11:10-0700 action Relayed
X400-Trace:   US**EDU; arrival Wed, 10 Aug 88 11:11-0700 action Relayed
From:         Joe Meadows</ADMD=/PRMD=BITNET/O=FHCRCVAX/PN=JOE/@US>
Subject:      STATUS, part 1 of 7 parts
To:           <info-vax@kl.sri.COM>
Message-Id:   <UWAVM.ACS.WASHINGTON.EDU:LTh5MdG@*>
X-VMS-To: IN%"info-vax@kl.sri.com"

        STATUS is a utility to display process info. It is quite flexible,
although quite a bit verbose. It can create displays that match SHOW SYSTEM
or SHOW USERS, or any of a zillion variations. This program requires a server
process to be started (at system startup would be good), which then handles
incoming DECnet requests. The Server process of course requires privileges.
The seven parts should be appended together to create a single large file,
i.e. STATUS_ARCHIVE.COM, which, when executed will create a large single file
called STATUS.SHAR. Move STATUS.SHAR to an empty directory someplace and then
execute it. To compile and link you may either use the included Makefile, or
execute COMPILE.COM.

        There are a million things in this, and another million to add.
Please forward enhancements to me, and I will include them for future use.

        For examples of its use, see WHO.COM, or SHOW*.COM. It's a bit ...
overwhelming (gross maybe?), in that you have to specify quite a lot of
things to get results, but, heck, what price for flexibility?

Each part should begin and end with something similar to:
+-+-+-+ Beginning of part 2 +-+-+-+
-+-+-+-+-+ End of part 2 +-+-+-+-+-
(except part 1, which skips the 'Beginning of' message.. If you
can read this message, you obviously got the beginning okay!)

...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-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 JOE
$! on  August 9th, 1988
$!
$! ATTENTION: To keep each article below 61 blocks (31232 bytes), this
$!            program has been transmitted in 7 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@)that file.
$!
$! It contains the following 1 file:
$!        STATUS.SHAR
$!
$!=============================================================================
=
$ 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.00 26-May-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"; 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 detectedwhile 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 = "STATUS.SHAR"
$ CHECKSUM_IS = 448275362
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ create/log AAAREADME.TXT
X$DECK
X`009STATUS is a monitor/finger/whatever type program, which
Xallows you to specify exactly what you want to see and how you
Xwant to see it. You can specify any GETJPI (or one of several GETSYI
Xitems) to be displayed (or selected upon), plus a few extras. See
XSTATUS.HLP for more info. See WHO.COM for some general examples,
XSHOWSYS.COM for an example that looks quite like SHOW SYSTEM, and
XSHOWUSERS.COM for an example that looks quite like SHOW USERS.
X
XIt has been written in such a way as to be easily modified, and added to.
XSee the file MODIFY.DOC for more info on how.
X
XTo use:
X`009Either edit STATUS.CLD so that the IMAGE clause points to where
Xyou are storing the image, or define a logical name EXE$DIR to point to
Xwhere you are storing the image. Then do SET COMMAND STATUS.
X
XFrom an appropriately privileged account execute STATUS.COM, which will
Xstart the DECnet server task (SERVER.EXE). You will then be able to use
Xthe STATUS command.
X
XThere are probably some bugs yet to be stamped out, they usually manifest
Xthemselves by causing the user of STATUS to hang. You can usually tell if
Xthe server is hung by examining its mode, if it is in the LEF state when
Xnoone is using it, then it is probably hung. You should delete the process
Xand start it over. I would like to hear about problems with it, since this
Xshouldn't happen.
X
XTo restrict use:
X`009If you don't want users to be able to see certain items, you can
Xcomment them out of KEYWORDS.DAT (or remove them entirely). Then run MAKE
Xto recompile the program. Users will no longer be able to access those
Xitems. Simple eh?
X
XA MAKEFILE is included. If you do not have MAKE, you can execute the
XCOMPILE.COM procedure. If you just need to relink, you can execute the
XLINK.COM procedure. Note that if you change KEYWORDS.DAT you will need
Xto recompile almost everything.
X
XTo use the WHERE item, you should consider creating an indexed file
Xstoring the terminal name, followed by its location. If the database
Xisn't created (it can be created with TERMINALS.FDL), then the WHERE
Xitem will simply display the 'physical' terminal name, for LAT terminals
Xthis includes the server name/port name, for remote terminals this
Xincludes the originating node name. If you are using the CMU TCP/IP
Xpackage (pre version 6.3) than the remote node name will be displayed.
X
XThe IMAGE item checks for RTPAD (set host command), and displays
Xwhere the outgoing connection is being made. If you have CMU TCP/IP
Xthen the same will happen for TELNET and FTP.
X
XThere is also a WHO item, which can do an indexed file lookup if you set
Xone up, followed by a call to SYS$GETUAI to retrieve the Owner field out
Xof the authorization file if it doesn't succeed in the indexed file lookup.
XIt builds an internal tree so that it doesn't have to repeatedly call
XSYS$GETUAI (because it's SO ssllooww!). You might consider commenting this
Xitem out of KEYWORDS.DAT if you use the owner field for something else.
X
XFuture enhancements:
X`009Add support for the /SORT qualifier.
X
X`009Add a /HIGHLIGHT option for enabling highlighting of
Xchanged items in a continuous display. At the same time, add
Xsupport for bolding/reverse/flashing/underlining in the text
Xvia ^b, ^r, ^f, ^u, and ^n (for normal). Allow any of these
Xto occur anywhere, plus allow the highlighting option to set
Xof these to use. Only GETJPI items will support highlighting.
X
X`009Add smarts for a trusted client? I.E. User X from Node
XY is allowed to see this class of item. All local users can see
Xthis class of item. Local user SYSTEM is allowed to see these?
XSort of a classification level for items, and a way to map incoming
Xrequests to a classification level.. Any ideas out there? I'm not that
Xfamiliar with DECnet yet, but I imagine I can find out things like
Xincoming request is from User X on Node Y, and if that is the local
Xnode, perhaps the PID so I can check their privs?
X
X`009Support for other networks: TCP/IP, BITNET etc.
X
XIf you are compiling with an older version of the C run time library
Xyou may not have the mem functions (memcpy, memmove, memset), if you
Xdon't, you can compile (and link with) MEM.MAR, which will provide similar
Xfunctionality. These aren't functionally equivalent to the Unix or the VMS
Xrun time library versions, but they are close enough for my use of them..
X$EOD
X$ create/log BUILD.C
X$DECK
X#include descrip
X#include ctype
X#include "server.h"
X
X/* this builds up the items for this links "header" list */
Xbuild_header(indx)
X  int indx;
X{
X  char *buff;
X  int len;
X
X#ifdef DEBUG
Xprintf("in build_header(%d)\n",indx);
X#endif
X
X  len = gbl_links[indx].iosb.length - 1;
X  buff = gbl_links[indx].buffer+1;
X  buff[len] = '\0';
X
X  build_string_list(indx,buff,len,&gbl_headers[indx]);
X
X#ifdef DEBUG
Xprintf("out build_header(%d)\n",indx);
X#endif
X}
X
Xbuild_display(indx)
X  int indx;
X{
X  char *buff;
X  int len;
X
X#ifdef DEBUG
Xprintf("in build_display(%d)\n",indx);
X#endif
X
X  len = gbl_links[indx].iosb.length - 1;
X  buff = gbl_links[indx].buffer+1;
X  buff[len] = '\0';
X
X  build_string_list(indx,buff,len,&gbl_displays[indx]);
X
X#ifdef DEBUG
Xprintf("out build_display(%d)\n",indx);
X#endif
X}
X
Xbuild_select(indx)
X  int indx;
X{
X  char *buff;
X  int len;
X
X#ifdef DEBUG
Xprintf("in build_select(%d)\n",indx);
X#endif
X
X  len = gbl_links[indx].iosb.length - 1;
X  buff = gbl_links[indx].buffer+1;
X  buff[len] = '\0';
X  build_item_list(indx,buff,len,&gbl_select[indx]);
X
X#ifdef DEBUG
Xprintf("out build_select(%d)\n",indx);
X#endif
X}
X
Xbuild_reject(indx)
X  int indx;
X{
X  char *buff;
X  int len;
X
X#ifdef DEBUG
Xprintf("in build_reject(%d)\n",indx);
X#endif
X
X  len = gbl_links[indx].iosb.length - 1;
X  buff = gbl_links[indx].buffer+1;
X  buff[len] = '\0';
X  build_item_list(indx,buff,len,&gbl_reject[indx]);
X
X#ifdef DEBUG
Xprintf("out build_reject(%d)\n",indx);
X#endif
X}
X
Xbuild_sort(indx)
X  int indx;
X{
X  char *buff;
X  int len;
X
X#ifdef DEBUG
Xprintf("in build_sort(%d)\n",indx);
X#endif
X
X  len = gbl_links[indx].iosb.length - 1;
X  buff = gbl_links[indx].buffer+1;
X  buff[len] = '\0';
X  build_item_list(indx,buff,len,&gbl_sort[indx]);
X
X#ifdef DEBUG
Xprintf("out build_sort(%d)\n",indx);
X#endif
X}
X
Xbuild_string_list(indx,buff,len,items)
X  int indx;
X  char *buff;
X  int len;
X  struct FmtItemsList *items;
X{
X  int start = 0, itmlen;
X
X#ifdef DEBUG
Xprintf("in build_string_list(%d,%s,%d,%08X)\n",indx,buff,len,items);
X#endif
X
X  while (len > 0) {
X    itmlen = get_fmt_item(&buff[start],len, items, indx);
X    start += itmlen;
X    len -= itmlen;
X  };
X
X#ifdef DEBUG
Xprintf("out build_string_list(%d,-,%d,%08X)\n",indx,len,items);
X#endif
X}
X
Xbuild_item_list(indx,buff,len,items)
X  int indx;
X  char *buff;
X  int len;
X  struct FmtItemsList *items;
X{
X  int start = 0, itmlen;
X
X#ifdef DEBUG
Xprintf("in build_item_list(%d,%s,%d,%08X)\n",indx,buff,len,items);
X#endif
X
X  while (len > 0) {
X    itmlen = get_raw_item(&buff[start],len, items, indx);
X    start += itmlen;
X    len -= itmlen;
X  }
X
X#ifdef DEBUG
Xprintf("out build_item_list(%d,-,%d,%08X)\n",indx,len,items);
X#endif
X}
X
Xget_fmt_item(buff,len,itemlist,indx)
X  char *buff;
X  int len;
X  struct FmtItemsList *itemlist;
X  int indx;
X{
X  int i=0,j;
X  struct FmtItems *item;
X
X  item = &(itemlist->item[itemlist->maxitems]);
X  item->address = 0;
X  item->size = 0;
X  item->flags.type = 0;
X
X  if (buff[i] == '%') {
X    ++i;
X    /* get item justification */
X    item->just = -1; /* left justify */
X    switch (buff[i]) {
X      case '+':
X        item->just = -1; /* left justify */
X        ++i;
X        break;
X      case '-':
X        item->just = 1; /* right justify */
X        ++i;
X        break;
X      case '.':
X        item->just = 0;  /* center justify */
X        ++i;
X        break;
X    };
X    /* get item width */
X    item->width = get_number(buff,&i);
X
X    /* get starting value */
X    if (buff[i] == '.')
X      ++i;
X    item->start = 0;
X    switch (buff[i]) {
X      case '-':
X        ++i;
X        item->start = get_number(buff,&i);
X        item->start *= -1; /* start in from right */
X        break;
X      case '+':
X        ++i; /* fall through to the next part deliberately */
X      default:
X        item->start = get_number(buff,&i);
X        break;
X    };
X    /* get item name, can contain alpha, digit (not at start), and '_' */
X    j = i;
X    buff[j] = toupper(buff[j]);
X    ++j; /* assume firt character is legit.. if it aint, we'll find out */
X    while (isalnum(buff[j]) || (buff[j] == '_'))
X    {
X       buff[j] = toupper(buff[j]);
X       ++j;
X    };
X    if ((item->keyindx = lookup(&buff[i],j - i)) < 0) {
X      /* turn this into a TEXT item, using the name as the item */
X      item->address = save_string(&buff[i],j-i);
X      item->width = j-i;
X      item->size = j-i;
X      item->keyindx = max_keywords;
X      ++itemlist->maxitems;
X      if (j >= len) {
X        item = &(itemlist->item[itemlist->maxitems]);
X        /* need to save off \n here, and set up item */
X        item->address = save_string("\n",1);
X        item->flags.type = FLAGTYPEABS;
X        item->width = 1;
X        item->size = 1;
X        item->start = 0;
X        item->just = -1;
X        item->keyindx = max_keywords;
X        ++itemlist->maxitems;
X      };
X    } else {
X      /* call the init routine... */
X      (*keywords[item->keyindx].init_routine)
X`009`009(itemlist,itemlist->maxitems,indx);
X      if (j >= len) {
X        item = &(itemlist->item[itemlist->maxitems]);
X        /* need to save off \n here, and set up item */
X        item->address = save_string("\n",1);
X        item->flags.type = FLAGTYPEABS;
X        item->width = 1;
X        item->size = 1;
X        item->start = 0;
X        item->just = -1;
X        item->keyindx = max_keywords;
X        ++itemlist->maxitems;
X      };
X    }
X  } else {
X    /* this is a text item, go to next '%', or to end of string,
X       if last char is not '-' then add a newline */
X    item->just = -1; /* left justify */
X    item->start = 0; /* left justify */
X    while ((buff[i] != '%') && (++i < len));
X    j = i; /* number of chars sucked from string */
X    if (i == len) { /* got to end of string ? */
X      if (buff[i - 1] != '-') { /* add a newline to end unless dashed  */
X        buff[i++] = '\n';
X      } else {
X        --i;
X      };
X    };
X    /* need to save off text here, and set up item */
X    item->address = save_string(buff,i);
X    item->flags.type = FLAGTYPEABS;
X    item->width = i;
X    item->size = i;
X    item->keyindx = max_keywords;
X    ++itemlist->maxitems;
X  };
X
X  return(j);
X}
X
Xget_raw_item(buff,len,itemlist,indx)
X  char *buff;
X  int len;
X  struct FmtItemsList *itemlist;
X  int indx;
X{
X  int i=0,j=0,k=0,parens=0,repeating;
X  struct LinkedList *list, *temp;
X  struct FmtItems *item;
X
X  item = &(itemlist->item[itemlist->maxitems]);
X
X  while ((buff[i] != '=') && (buff[i] != ':') && (i < len)) {
X    buff[i] = toupper(buff[i]);
X    ++i;
X  };
X
X  if ((item->keyindx = lookup(buff,i)) >= 0) {
X    /* call the init routine */
X    (*keywords[item->keyindx].init_routine)
X`009`009(itemlist,itemlist->maxitems,indx);
X    if (buff[++i] == '(') {
X      ++i;
X      parens = -1;
X    };
X
X    repeating = -1;
X    while (repeating) {
X      j = i;
X      while ((buff[j] != ',') && (buff[j] != ')') && (j < len)) {
X        ++j;
X      };
X
X      if ((buff[j] == ')') || ((j + 1) >= len))
X        parens = 0;
X
X      repeating = parens;
X
X      /* save enough space for struct LinkedList , plus string */
X      list = malloc(j - i + sizeof(struct LinkedList));
X      temp = item->list;
X      item->list = list;
X      list->next = temp;
X      list->length = j - i;
X      list->string = (int)list + sizeof(struct LinkedList);
X
X      for (k = 0; k < (j - i); k++)
X        list->string[k] = buff[i + k];
X
X      i = j + 1;
X    };
X  }
X  else
X  {
X    i = len;
X  }
X
X  return(i);
X}
X
Xsave_string(string,length)
X  char *string;
X  int length;
X{
X  /* this dynamic string gets deliberately lost */
X  /* it should get recovered during cleanup, if I remember to do it.. */
X  struct dsc$descriptor dynamic = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
X  struct dsc$descriptor s1 = {length,DSC$K_DTYPE_T,DSC$K_CLASS_S,string};
X
X  str$copy_dx(&dynamic, &s1);
X
X  return(dynamic.dsc$a_pointer);
X}
X
Xlookup(key,keylen)
X  char *key;
X  int keylen;
X{
X  int compare, ambig = 0, mid, start = 0, fini = max_keywords;
X
X  while (start <= fini)
X  {
X    mid = (start + fini)/2;
X    compare = strncmp(key, keywords[mid].name, keylen);
X    if (compare < 0)
X      fini = mid - 1;
X    else if (compare > 0)
X      start = mid + 1;
X    else
X    {
X      if (keylen == strlen(keywords[mid].name))
X      {
X        return(mid);
X      };
X      start = mid;
X      while ((--start >= 0)
X             && (strncmp(key, keywords[start].name, keylen) == 0))
X        if (keylen == strlen(keywords[start].name))
X        {
X          return(start);
X        }
X        else
X          ambig = -1;
X
X      fini = mid;
X      while ((++fini < max_keywords)
X             && (strncmp(key, keywords[fini].name, keylen) == 0))
X        if (keylen == strlen(keywords[fini].name))
X        {
X          return(fini);
X        }
X        else
X          ambig = -1;
X
X      if (ambig)
X      {
X        return(-2); /* ambiguous */
X      }
X      else
X      {
X        return(mid);
X      };
X    };
X  };
X
X  return(-1);
X}
X
Xget_number(buff,i)
X  char *buff;
X  int *i;
X{
X  int number = 0;
X
X  while (isdigit(buff[*i]))
X  {
X    number = (number * 10) + (buff[*i] - '0') ;
X    ++*i;
X  };
X
X  return(number);
X}
X$EOD
X$ create/log C.OPT
X$DECK
Xsys$share:vaxcrtl.exe/share
X$EOD
X$ create/log CLEANUP.C
X$DECK
X#include descrip
X#include "server.h"
X
Xcleanup(indx)
X  int indx;
X{
X  struct dsc$descriptor dynamic = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
X  struct LinkedList *list, *temp;
X  int i;
X
X#ifdef DEBUG
Xprintf("in cleanup(%d)\n",indx);
X#endif
X
X  for (i = 0; i < gbl_headers[indx].maxitems; ++i) {
X    /* if the item was a text item, free the space grabbed via lib$copy_dx */
X    if (gbl_headers[indx].item[i].keyindx == max_keywords) {
X      dynamic.dsc$w_length = gbl_headers[indx].item[i].width;
X      dynamic.dsc$a_pointer = gbl_headers[indx].item[i].address;
X      lib$sfree1_dd(&dynamic); /* free the space we grabbed earlier */
X    }
X    else
X    {
X      if (gbl_headers[indx].item[i].flags.type == FLAGTYPEJPI)
X      {
X        remove_jpi(gbl_headers[indx].item[i].jpicod_index);
X      }
X    }
X  }
X  gbl_headers[indx].maxitems = 0;
X
X  for (i = 0; i < gbl_displays[indx].maxitems; ++i) {
X    /* if the item was a text item, free the space grabbed via lib$copy_dx */
X    if (gbl_displays[indx].item[i].keyindx == max_keywords) {
X      dynamic.dsc$w_length = gbl_displays[indx].item[i].width;
X      dynamic.dsc$a_pointer = gbl_displays[indx].item[i].address;
X      lib$sfree1_dd(&dynamic); /* free the space we grabbed earlier */
X    }
X    else
X    {
X      if (gbl_displays[indx].item[i].flags.type == FLAGTYPEJPI)
X      {
X        remove_jpi(gbl_displays[indx].item[i].jpicod_index);
X      }
X    }
X  }
X  gbl_displays[indx].maxitems = 0;
X
X  for (i = 0; i < gbl_select[indx].maxitems; ++i) {
X    if (gbl_select[indx].item[i].keyindx != -1) {
X      list = gbl_select[indx].item[i].list;
X      while (list) {
X        temp = list;
X        list = list->next;
X        free(temp);
X      }
X    }
X    if (gbl_select[indx].item[i].flags.type == FLAGTYPEJPI)
X    {
X      remove_jpi(gbl_select[indx].item[i].jpicod_index);
X    }
X    gbl_select[indx].item[i].list = 0;
X    gbl_select[indx].item[i].keyindx = 0;
X  }
X  gbl_select[indx].maxitems = 0;
X
X  for (i = 0; i < gbl_reject[indx].maxitems; ++i) {
X    if (gbl_reject[indx].item[i].keyindx != -1) {
X      list = gbl_reject[indx].item[i].list;
X      while (list) {
X        temp = list;
X        list = list->next;
X        free(temp);
X      }
X    }
X    if (gbl_reject[indx].item[i].flags.type == FLAGTYPEJPI)
X    {
X      remove_jpi(gbl_reject[indx].item[i].jpicod_index);
X    }
X    gbl_reject[indx].item[i].list = 0;
X    gbl_reject[indx].item[i].keyindx = 0;
X  }
X  gbl_reject[indx].maxitems = 0;
X
X  if (syi_items[indx][0].bufadr) {
X    free(syi_items[indx][0].bufadr);
X    for (i = 0; syi_items[indx][i].code != 0; i++) {
X      syi_items[indx][i].bufadr = 0;
X      syi_items[indx][i].code = 0;
X      syi_items[indx][i].length = 0;
X    }
X  }
X
X#ifdef DEBUG
Xprintf("out cleanup(%d)\n",indx);
X#endif
X}
X
Xremove_jpi(index)
X  int index;
X{
X  int i,jpicod,last;
X
X  jpicod = JpiCodes[index].itemcode;
X
X  --system_jpi.refcnt[index];
X  if (system_jpi.refcnt[index] > 0)
X  {
X    return; /* we have no more to do .. */
X  }
X
X  /* oops, we zonked the last item, let's remove it.. */
X  switch (JpiCodes[index].avail)
X  {
X    case 0: /* remove from system_jpi.pcb_items[], decrement pcb_itemcnt */
X      for (i = 0; (i < system_jpi.pcb_itemcnt)
X                 && (system_jpi.pcb_items[i].code != jpicod); i++);
X
X      last = system_jpi.pcb_itemcnt;
X      --system_jpi.pcb_itemcnt;
X
X      system_jpi.pcb_items[i].code = system_jpi.pcb_items[last].code;
X      system_jpi.pcb_items[i].length = system_jpi.pcb_items[last].length;
X      system_jpi.pcb_items[i].bufadr = system_jpi.pcb_items[last].bufadr;
X
X      system_jpi.pcb_items[last].code = 0;
X      system_jpi.pcb_items[last].length = 0;
X      system_jpi.pcb_items[last].bufadr = 0;
X      break;
X    case 1: /* remove from system_jpi.phd_items[], decrement phd_itemcnt */
X      for (i = 0; (i < system_jpi.phd_itemcnt)
X                 && (system_jpi.phd_items[i].code != jpicod); i++);
X
X      last = system_jpi.phd_itemcnt;
X      --system_jpi.phd_itemcnt;
X
X      system_jpi.phd_items[i].code = system_jpi.phd_items[last].code;
X      system_jpi.phd_items[i].length = system_jpi.phd_items[last].length;
X      system_jpi.phd_items[i].bufadr = system_jpi.phd_items[last].bufadr;
X
X      system_jpi.phd_items[last].code = 0;
X      system_jpi.phd_items[last].length = 0;
X      system_jpi.phd_items[last].bufadr = 0;
X      break;
X    case 2: /* remove from system_jpi.ctl_items[], decrement ctl_itemcnt */
X      for (i = 0; (i < system_jpi.ctl_itemcnt)
X                 && (system_jpi.ctl_items[i].code != jpicod); i++);
X
X      last = system_jpi.ctl_itemcnt;
X      --system_jpi.ctl_itemcnt;
X
X      system_jpi.ctl_items[i].code = system_jpi.ctl_items[last].code;
X      system_jpi.ctl_items[i].length = system_jpi.ctl_items[last].length;
X      system_jpi.ctl_items[i].bufadr = system_jpi.ctl_items[last].bufadr;
X
X      system_jpi.ctl_items[last].code = 0;
X      system_jpi.ctl_items[last].length = 0;
X      system_jpi.ctl_items[last].bufadr = 0;
X      break;
X  };
X}
X$EOD
X$ create/log COMPARE.C
X$DECK
X#include descrip
X
Xcompare(a,b,l)
X  char *a, *b;
X  short int l;
X{
X  struct dsc$descriptor s1={strlen(a), DSC$K_DTYPE_T, DSC$K_CLASS_S, a};
X  struct dsc$descriptor s2={l, DSC$K_DTYPE_T, DSC$K_CLASS_S, b};
X  int status;
X
X#ifdef DEBUG
Xprintf("in compare(%s, %.*s)\n",a,l,b);
X#endif
X
X  str$upcase(&s1, &s1);
X  status = str$match_wild(&s1, &s2);
X
X#ifdef DEBUG
Xprintf("out compare(%s, %.*s) (%d)\n",a,l,b, status & 1);
X#endif
X
X  return (status & 1);
X}
X$EOD
X$ create/log COMPILE.COM
X$DECK
X$!
X$ cc/debug status
X$ cc/debug window
X$!
X$ cc/debug order_keywords
X$ link order_keywords,c/option
X$ run order_keywords
X$!
X$ cc/debug jpicodes
X$ link jpicodes,c/option
X$ run jpicodes
X$!
X$ cc/debug globaldef
X$ cc/debug server
X$ cc/debug build
X$ cc/debug cleanup
X$ cc/debug compare
X$ cc/debug decnet
X$ cc/debug format
X$ cc/debug get
X$ cc/debug init
X$ cc/debug parse
X$ cc/debug readport
X$ cc/debug lookup_terminal
X$ cc/debug lookup_who
X$ cc/debug pseudo
X$ cc/debug rtpad
X$ cc/debug telnet
X$!
X$ macro/debug devices
X$ macro/debug terminal
X$ macro/debug epid_to_ipid
X$!
X$ @link
X$EOD
X$ create/log DECNET.C
X$DECK
X#include descrip
X#include iodef
X
X#define NFB$C_FC_SHOW`0090x00000022
X#define NFB$M_NOUPD`0090x00000004 /* don't update the database`009`009*/
X#define NFB$C_DB_LLI`0090x00000008 /* logical link information database */
X#define NFB$C_OP_EQL`0090x00000000 /* match the key exactly             */
X#define NFB$C_LLI_LLN`0090x08010012 /* the key is a logical link number  */
X#define NFB$C_WILDCARD`0090x00000001 /* search the whole database         */
X#define NFB$C_LLI_PNN`0090x08020043 /* partner's node name               */
X#define NFB$C_ENDOFLIST`0090x00000000
X
XGet_DECnet_Node(link,site)
X  unsigned short int link;
X  char *site;
X{
X  $DESCRIPTOR(Net,"Net:");
X
X  struct {
X    unsigned char nfb$b_fct;
X    unsigned char nfb$b_flags;
X    unsigned char nfb$b_database;
X    unsigned char nfb$b_oper;
X    long int nfb$l_srch_key;
X    long int nfb$l_srch2_key;
X    unsigned char nfb$b_oper2;
X    unsigned char nfb$b_mbz1;
X    short int nfb$w_cell_size;
X    long int nfb$l_fldid; /* first of the fields */
X    long int f2;
X  } nfb =
X    {
X      NFB$C_FC_SHOW, NFB$M_NOUPD, NFB$C_DB_LLI, NFB$C_OP_EQL,
X      NFB$C_LLI_LLN, NFB$C_WILDCARD,
X      0, 0, 0,
X      NFB$C_LLI_PNN, NFB$C_ENDOFLIST
X    };
X
X  struct {
X    short int len;
X    char name[10];`009/* shucks, how big can a nodename be? isn't it 6? */
X  } buf;
X
X  struct {
X    long int k1;
X    long int k2;
X  } key = {0,link};
X
X  struct dsc$descriptor nfbdesc = {sizeof(nfb), 0, 0, &nfb};
X  struct dsc$descriptor keydesc = {sizeof(key), 0, 0, &key};
X  struct dsc$descriptor bufdesc = {sizeof(buf), 0, 0, &buf};
X
X  int status;
X  short int chan, iosb[4];
X
X  site[0] = '\0';
X
X  status = sys$assign (&Net, &chan, 0, 0);
X  if (!( status & 1))
X  {
X    lib$signal(status);
X    return(status);
X  }
X
X  buf.len = 0;
X
X  status = sys$qiow (0,chan,IO$_ACPCONTROL,iosb,0,0,
X`009`009`009&nfbdesc,&keydesc,0,&bufdesc,0,0);
X  sys$dassgn(chan);
X  if (status & 1) status = iosb[0];
X  if (!( status & 1))
X  {
X    lib$signal(status);
X    return(status);
X  }
X
X  strncpy(site,buf.name,buf.len);
X  site[buf.len] = '\0';
X  return(1);
X}
X$EOD
X$ create/log DEVICES.MAR
X$DECK
X`009.Title`009devices - Get all device names of a given class
X`009.Ident`009/V01.001/
X`009.Enable`009SUP
X`009.Default Displacement,Word
X`009.Subtitle Introduction
X;+
X;
X; ----- devices - Get all device names of a given class
X;
X;
X; Facility:
X;
X;`009VAX/VMS system programming
X;
X; Abstract:
X;
X;`009This module provides a routine which can be called from any
X;`009VAX native  language to obtain all the device names of a specific
X;`009class.
X;
X; Environment:
X;
X;`009VAX/VMS native mode, VMS V4.2 or later, CMKRNL privilege.
X;
X; Version:`009V01.001
X; Date:`009`00912-Apr-1988
X;
X;
X; Modifications:
X;
X;
X;-
X
X`009.Page
X`009.Subtitle Local definitions
X
X`009.Library "SYS$LIBRARY:LIB"
X`009`009;Get special macros from here
X`009.Link`009"SYS$SYSTEM:SYS.STB"/Selective_Search
X`009`009;Ease the link process a bit
X
X`009.NoCross`009;Save a tree
X
X`009$DCDEF`009`009`009`009;Device class & type definitions
X`009$DDBDEF`009`009`009`009;Device data block offsets
X`009$IPLDEF`009`009`009`009;interrupt priority level
X`009$SBDEF`009`009`009`009;System Block
X`009$SSDEF`009`009`009`009;System service codes
X`009$TTYUCBDEF`009`009`009;Terminal UCB offsets
X`009$UCBDEF`009`009`009`009;UCB offsets
X
X`009.Cross`009`009`009`009;Turn CREF back on
X
X
X`009.Page
X`009.Subtitle`009device names
X
X;+
X;
X; ----- devices - Get device names
X;
X;
X; The calling program must have  CMKRNL privilege and  must be linked
X; with SYS.STB.
X;
X; Call sequence:
X;
X;  status.wlv = devices (device-class, pid, num-elemnts, elemnt-size, array)
X;`009device-class = -1 means all devices, else, specifies class of device
X;`009pid = if -1, match on any pid other than zero, if 0 match on anything
X;`009`009else match on pid
X;`009num-elemnts = number of elements in array
X;`009elemnt-size = size of each element in array
X;`009`009note: includes 4 bytes for PID, 2 bytes for length, and string
X;`009array = address of array
X;
X; Inputs:
X;
X;`0094(AP)`009- address of the device class
X;`0098(AP)`009- address of flags
X;`00912(AP)`009- number of elements in device name array
X;`00916(AP)`009- size of elements in device name array
X;
X; Outputs:
X;
X;`00920(AP)`009- Address of a device name array
X;
X;`009R0`009- SS$_NOPRIV:`009 No CMKRNL privilege.
X;`009`009- SS$_ACCVIO:`009 One of the arguments is not accessible.
X;`009`009- SS$_NORMAL:`009 Success.
X;
X;-
XARGS = 5
X`009.Psect`009devices`009EXE,RD,NOWRT,PIC,SHR,PAGE
X
X`009.Entry`009devices,^M<>`009;Entry here
X
X  `009$CMKRNL_S ROUTIN=B^20$,-`009;Do this
X`009`009ARGLST=(AP)`009`009; in kernel mode
X
X10$:`009RET`009`009`009`009;Done, status in R0
X
X; Here in kernel mode to do all of the actual work.
X
X20$:`009.Word`009^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X`009`009;Here in kernel mode to get some info
X
X; First, check to see if we can read the argument list.
X
X`009MOVL`009#SS$_ACCVIO,R0`009`009;Presume we can't
X`009IFNORD`009#<<ARGS+1>*4>,(AP),10$`009`009;Probe the argument list
X
X; Check the number of arguments
X
X`009MOVL`009#SS$_INSFARG,R0`009`009;Presume we have too few arguments
X`009CMPB`009#ARGS,(AP)`009`009;Do we have enough arguments?
X`009BNEQ`00910$`009`009`009;If NEQ no, it's wrong somehow
X`009
-+-+-+-+-+ End of part 1 +-+-+-+-+-

