From: SYSTEM_JM@UNODE2.NSWC.NAVY.MIL ("SYSTEM SUPPORT")
Newsgroups: comp.os.vms
Subject: IDENTIFIER
Date: 17 Aug 92 14:58:00 GMT
Distribution: world
Organization: The Internet

>From: HARTTREE@vax1.elon.edu (Matthew Harttree)
>!!!!!!!!SIDE QUESTION
>Is there a way (or utility/program) to create a list of users who hold the 
>same identifier.  I have looked at an elderly copy of WHO written by a guy 
>at xerox in palo alto but it falls short of doing this.  
>
>ANY HELP and ->NICE<- suggestions would be appreciated!!

Here's an undocumented (of course) FORTRAN program called IDENT that 
lists the holders of a specified identifier ($IDENT <identifier>) or
the identifers held by a specified user ($IDENT/USER=<username>).
I'm not sure who the original author was, but I believe it was Ken Long
-------------------------- cut here -------------------------------------- 
	program test2
      implicit none                                                      !#27652
      include '($lnmdef)' ! gives us the constants we need to talk       !#27652
      include '($psldef)' ! to $trnlnm.                                  !#27652
      include '($RMSdef)' ! to $trnlnm.                                  !#27652
      include '($SMGdef)' ! to $trnlnm.                                  !#27652
                                                       
	integer zero,zero2,attrib
	character*100 string,username
      integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
	integer*4 sys$asctoid
	external sys$asctoid
      integer*4 sys_status,sys_2
	integer*4 i,j
      integer holder(2),dholder(2)
      integer rvalue,length
      integer*2 w_buffer_length, w_item_code                             !#27652
      integer*4 string_address, return_address                           !#27652
!      common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
!     +string_address, return_address                                !#27652
	integer more_ids,more_users
	integer optiontype,opt,outunit
	character*255 optionfile,outfile
	data opt/50/,outunit/51/

	zero2=0
	zero=0                
!      string = 'CNTRL_PGE'
	more_ids=.true.
	more_users=.true.

	call break_up_cli_options (optionfile,optiontype,outfile) 
	call open_output_file (outfile,outunit)
	if (optiontype.gt.0) then                        
           call  open_option_file (optionfile,opt,optiontype)
	endif
	do while (more_ids)     
          if (optiontype.eq.1) then
            call get_string_from_option_file (opt,string,more_ids)
	  else                 
 	    call break_up_cli_string(string,more_ids)
	  endif
	  if (more_ids) then
	    sys_status= sys$asctoid(
     *            %descr(string(1:length(string))),
     *            rvalue,)
	    if (sys_status.eq.1) then
              call test(rvalue)
	    endif
	  endif
	enddo
d	type *,' between'

        do while (more_users)
          if (optiontype.eq.2) then
            call get_string_from_option_file (opt,username,more_ids)
	  else
	    call break_up_cli_users(username,more_users)
	  endif
          if (more_users) then
d            type *,'user=<',username(1:length(username)),'>'
              sys_status=sys$asctoid(
     *          %descr(username(1:length(username))),
     *          rvalue,)
	      if (sys_status.eq.1) then
                 call user(rvalue)
	      else
d	  type *,' Not valid user name'
 	      endif
	  endif
	enddo      
	if (optiontype.gt.0) then
	 close(opt)
	endif
	close(outunit)
      end

	subroutine open_output_file(filename,outunit)
	implicit none
        integer outunit
	character*(*) filename

	open (unit=outunit,status='unknown',file=filename
     *       ,carriagecontrol='LIST')
	return
	end                                        
                    
        subroutine open_option_file (optionfile,opt,optiontype)
	implicit none
	character*(*) optionfile
	integer opt,optiontype

        OPEN(FILE=optionfile,UNIT=opt,STATUS='OLD',ERR=300)
	return
300	optiontype=0
	return
	end

        subroutine get_string_from_option_file (opt,string,more_ids)
	implicit none
	character*(*) string
	integer opt,more_ids
100	format(a)

        read(opt,100,ERR=300,END=300) string
	more_ids=.true.
	return

300	more_ids=.false.
	string=' '
	return
	end

	subroutine testit(rvalue)
      implicit none
      include '($lnmdef)' ! gives us the constants we need to talk       !#27652
      include '($psldef)' ! to $trnlnm.                                  !#27652
      include '($RMSdef)' ! to $trnlnm.                                  !#27652
      include '($SMGdef)' ! to $trnlnm.                                  !#27652

	integer zero,zero2,attrib
	integer outunit
	data outunit/51/
	character*100 string
      integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      integer*4 sys_status,sys_2
	integer*4 i,j
      integer holder(2),dholder(2)
      integer rvalue
      integer*2 w_buffer_length, w_item_code                             !#27652
      integer*4 string_address, return_address                           !#27652
      common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
     +string_address, return_address                                !#27652
	zero2=0
	zero=0
	do while (sys_status.ne.8684)
      sys_status =                                                       !#27652
     +sys$find_held(holder , rvalue,attrib,zero)
	if (sys_status.eq.1) then
	  call test(rvalue)
	else if (sys_status.eq.8684) then
	else
	  write(outunit, *) ' <<<','sysstat=',sys_status
	endif
	enddo                   
      end
                    



	subroutine test(rvalue)
      implicit none
      include '($lnmdef)'
      include '($psldef)'
      include '($RMSdef)'
      include '($SMGdef)'

	integer zero,zero2,attrib
	character*100 string
      integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      integer*4 sys_status,sys_2
	integer*4 i,j
      integer holder(2),dholder(2)
      integer rvalue
      integer*2 w_buffer_length, w_item_code                             !#27652
      integer*4 string_address, return_address                           !#27652
      common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
     +string_address, return_address                                !#27652
	integer outunit
	data outunit/51/
	zero2=0
	zero=0
      string = ' '                                                       !#27652
      w_item_code = lnm$_string                                          !#27652
      w_buffer_length = len( string )                                    !#27652
      string_address = %loc( string )                                    !#27652
	sys_status= sys$idtoasc(%val(rvalue),w_buffer_length,
     *        %descr(string),,,)
	write (outunit,*) string(1:w_buffer_length),' :'
	sys_2=0
	do while(sys_2.ne.8684)
	sys_2 =                       
     +sys$find_holder (%val(rvalue),dholder,,zero2)
	if (sys_2.ne.8684) then    
	sys_status= sys$idtoasc(%val(dholder(1)),w_buffer_length,
     *        %descr(string),,,)
	write(outunit,*) '    ',string(1:w_buffer_length)
	endif
	enddo
      end                                                                !#27652
                    
	subroutine user(tval)
      implicit none                                                      !#27652
      include '($lnmdef)' ! gives us the constants we need to talk       !#27652
      include '($psldef)' ! to $trnlnm.                                  !#27652
      include '($RMSdef)' ! to $trnlnm.                                  !#27652
      include '($SMGdef)' ! to $trnlnm.                                  !#27652

	integer zero,zero2,attrib
	character*100 string
      integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
      integer*4 sys_status,sys_2
	integer*4 i,j
      integer holder(2),dholder(2)
      integer rvalue,tval
      integer*2 w_buffer_length, w_item_code                             !#27652
      integer*4 string_address, return_address                           !#27652
      common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
     +string_address, return_address                                !#27652
	integer outunit
	data outunit/51/

	zero2=0
	zero=0
	holder(1)=tval
      string = ' '                                                       !#27652
      w_item_code = lnm$_string                                          !#27652
      w_buffer_length = len( string )                                    !#27652
      string_address = %loc( string )                                    !#27652
	sys_status= sys$idtoasc(%val(holder(1)),w_buffer_length,
     *        %descr(string),,,)
	write (outunit,*) string(1:w_buffer_length),' :'
	sys_status=0
	zero=0
	do while (sys_status.ne.8684)
           sys_status =
     +         sys$find_held(holder , rvalue,attrib,zero)
	   if (sys_status.eq.1) then
	      sys_status= sys$idtoasc(%val(rvalue),w_buffer_length,
     *                    %descr(string),,,)
	      write (outunit,*) '    ',string(1:w_buffer_length)
	   else if (sys_status.eq.8684) then
c  do nothing
	   else
	      write (outunit,*) ' <<<','sysstat=',sys_status
	   endif
	enddo                   

      end
                                           
                           

	INTEGER FUNCTION length(line)
C
C	This function return the number of characters in the line
C	without trailing blanks or nulls.
C                        
	implicit none                             
	character*(*) line
	integer j

	j=len(line)
	do while (((line(j:j).eq.' ').or.
     *	           (line(j:j).eq.'
	   j=j-1
	enddo
	length=j
	return
	end

 	subroutine break_up_cli_options (optionname,optiontype,outfile)

	implicit none

	integer cli$get_value,cli$present
	character*(*) optionname,outfile
	integer optiontype
	integer status

	status= cli$get_value ('output', outfile)
	if (.not.status) then
	    outfile='SYS$output'
	endif
	
	optiontype=0
	status=cli$get_value ('option',optionname)
	if (status) then
d            type *,' option stat',status
	    status=cli$present ('identifier')
	    if (status) then
	       optiontype=1
	    else
	       optiontype=2
	    endif
	else
d            type *,' option stat',status
	  optiontype=0
	endif
	end

 	subroutine break_up_cli_users (username,more_users)

	implicit none

	integer cli$get_value
	character*(*) username
	integer more_users 
	integer status

	status=cli$get_value ('user',username)
	if (status) then
d            type *,' user stat',status
	  more_users=.true.
	else
d            type *,' user stat',status
	  more_users=.false.
	endif
	end


	subroutine break_up_cli_string (idname,more_ids)

	implicit none

        integer more_ids
	integer status,ustatus
	integer cli$get_value
	integer cli$present
	integer count
	data count/0/
	character*(*) idname

	status=cli$present ('p1')
	if (status.and. count.eq.0) then
d	type *,'status of p1',status
	  status=cli$get_value ('p1',idname)
          count=count+1
	  more_ids=.true.
	else
	  Ustatus=cli$get_value ('identifier',idname)
	  if (ustatus) then
d            type *,' id stat',ustatus
	    more_ids=.true.
	  else
d	   type *,' id* stat',ustatus
	   more_ids=.false.
	  endif            
        endif
	end
-------------------------- cut here -------------------------------------- 
!IDENT.CLD file. Substitute your default disk:[dir] names...

define verb ident
image "disk:[dir]ident.exe"
	parameter p1,  prompt="Identifier",value(type=$file)
	qualifier IDENTIFIER, value(list)
        qualifier USER,       value(list)
        qualifier OPTION,     value(default="ident.opt",type=$file)
	qualifier OUTPUT,     value(default="SYS$OUTPUT",type=$file)
disallow any2(p1,identifier,user)
disallow option AND NOT (identifier OR user)
-------------------------- cut here -------------------------------------- 
! And here's the HELP file...
1 IDENT

The IDENT command accesses the rights database to either:

    a) Return the identifier(s) held by the specified username(s).
    b) Return the username(s) which hold the specified identifier(s).

By default, the command expects the first parameter to be the name of
a single identifer.  For example,  

    $ IDENT identifier_name

To input multiple identifiers, use the /IDENTIFIER qualifier:

    $ IDENT /IDENTIFIER=(IDENT1,IDENT2)
 
To determine what identifier a specific username holds, use the /USER
qualifier:

    $ IDENT /USER=SMITH
    $ IDENT /USER=(SMITH,JONES)

You may not use the /IDENTIFIER and /USER qualifiers together.  Their
use is mutually exclusive.

2 Command Qualifiers

/IDENTIFIER
Returns the usernames(s) which hold the specified identifier(s). The
username records are returned in the order in which they were added
to the system and not alphabetically.

  FORMAT:
  $ IDENT /IDENTIFIER=<identifier>
  $ IDENT /IDENTIFIER=(ident1,ident2)

/USER

Return the identifier(s) held by the specified username(s).  The
identifiers are returned in the order in which they were granted.
                                                       
  FORMAT:
  $ IDENT /USER=SMITH
  $ IDENT /USER=(SMITH,JONES) 

/OPTION

The /OPTION qualifier allows the use of an input file which contains
EITHER identifiers OR usernames. Format of the file must be one name per
line, starting in column 1. Exactly one of the qualifiers, /IDENTIFIER
or /USER, must be specified along with the /OPTION qualifier for IDENT
to discern what kind of records are present in the option file.

  FORMAT:
  $ IDENT /OPTION=option_file.opt /IDENTIFIER
  $ IDENT /OPTION=option_file.opt /USER

/OUTPUT

Redirects the output of the IDENT program to a file. Default output
is SYS$OUTPUT.

  FORMAT:
  $ IDENT /other_options /OUTPUT=out.fil