home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / comp / os / vms / 13716 < prev    next >
Encoding:
Internet Message Format  |  1992-08-17  |  13.8 KB
  1. Path: sparky!uunet!cis.ohio-state.edu!ucbvax!UNODE2.NSWC.NAVY.MIL!SYSTEM_JM
  2. From: SYSTEM_JM@UNODE2.NSWC.NAVY.MIL ("SYSTEM SUPPORT")
  3. Newsgroups: comp.os.vms
  4. Subject: IDENTIFIER
  5. Message-ID: <9208171358.AA24848@ucbvax.Berkeley.EDU>
  6. Date: 17 Aug 92 14:58:00 GMT
  7. Sender: daemon@ucbvax.BERKELEY.EDU
  8. Distribution: world
  9. Organization: The Internet
  10. Lines: 436
  11.  
  12. >From: HARTTREE@vax1.elon.edu (Matthew Harttree)
  13. >!!!!!!!!SIDE QUESTION
  14. >Is there a way (or utility/program) to create a list of users who hold the 
  15. >same identifier.  I have looked at an elderly copy of WHO written by a guy 
  16. >at xerox in palo alto but it falls short of doing this.  
  17. >
  18. >ANY HELP and ->NICE<- suggestions would be appreciated!!
  19.  
  20. Here's an undocumented (of course) FORTRAN program called IDENT that 
  21. lists the holders of a specified identifier ($IDENT <identifier>) or
  22. the identifers held by a specified user ($IDENT/USER=<username>).
  23. I'm not sure who the original author was, but I believe it was Ken Long
  24. -------------------------- cut here -------------------------------------- 
  25.     program test2
  26.       implicit none                                                      !#27652
  27.       include '($lnmdef)' ! gives us the constants we need to talk       !#27652
  28.       include '($psldef)' ! to $trnlnm.                                  !#27652
  29.       include '($RMSdef)' ! to $trnlnm.                                  !#27652
  30.       include '($SMGdef)' ! to $trnlnm.                                  !#27652
  31.                                                        
  32.     integer zero,zero2,attrib
  33.     character*100 string,username
  34.       integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  35.       external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  36.     integer*4 sys$asctoid
  37.     external sys$asctoid
  38.       integer*4 sys_status,sys_2
  39.     integer*4 i,j
  40.       integer holder(2),dholder(2)
  41.       integer rvalue,length
  42.       integer*2 w_buffer_length, w_item_code                             !#27652
  43.       integer*4 string_address, return_address                           !#27652
  44. !      common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
  45. !     +string_address, return_address                                !#27652
  46.     integer more_ids,more_users
  47.     integer optiontype,opt,outunit
  48.     character*255 optionfile,outfile
  49.     data opt/50/,outunit/51/
  50.  
  51.     zero2=0
  52.     zero=0                
  53. !      string = 'CNTRL_PGE'
  54.     more_ids=.true.
  55.     more_users=.true.
  56.  
  57.     call break_up_cli_options (optionfile,optiontype,outfile) 
  58.     call open_output_file (outfile,outunit)
  59.     if (optiontype.gt.0) then                        
  60.            call  open_option_file (optionfile,opt,optiontype)
  61.     endif
  62.     do while (more_ids)     
  63.           if (optiontype.eq.1) then
  64.             call get_string_from_option_file (opt,string,more_ids)
  65.       else                 
  66.          call break_up_cli_string(string,more_ids)
  67.       endif
  68.       if (more_ids) then
  69.         sys_status= sys$asctoid(
  70.      *            %descr(string(1:length(string))),
  71.      *            rvalue,)
  72.         if (sys_status.eq.1) then
  73.               call test(rvalue)
  74.         endif
  75.       endif
  76.     enddo
  77. d    type *,' between'
  78.  
  79.         do while (more_users)
  80.           if (optiontype.eq.2) then
  81.             call get_string_from_option_file (opt,username,more_ids)
  82.       else
  83.         call break_up_cli_users(username,more_users)
  84.       endif
  85.           if (more_users) then
  86. d            type *,'user=<',username(1:length(username)),'>'
  87.               sys_status=sys$asctoid(
  88.      *          %descr(username(1:length(username))),
  89.      *          rvalue,)
  90.           if (sys_status.eq.1) then
  91.                  call user(rvalue)
  92.           else
  93. d      type *,' Not valid user name'
  94.            endif
  95.       endif
  96.     enddo      
  97.     if (optiontype.gt.0) then
  98.      close(opt)
  99.     endif
  100.     close(outunit)
  101.       end
  102.  
  103.     subroutine open_output_file(filename,outunit)
  104.     implicit none
  105.         integer outunit
  106.     character*(*) filename
  107.  
  108.     open (unit=outunit,status='unknown',file=filename
  109.      *       ,carriagecontrol='LIST')
  110.     return
  111.     end                                        
  112.                     
  113.         subroutine open_option_file (optionfile,opt,optiontype)
  114.     implicit none
  115.     character*(*) optionfile
  116.     integer opt,optiontype
  117.  
  118.         OPEN(FILE=optionfile,UNIT=opt,STATUS='OLD',ERR=300)
  119.     return
  120. 300    optiontype=0
  121.     return
  122.     end
  123.  
  124.         subroutine get_string_from_option_file (opt,string,more_ids)
  125.     implicit none
  126.     character*(*) string
  127.     integer opt,more_ids
  128. 100    format(a)
  129.  
  130.         read(opt,100,ERR=300,END=300) string
  131.     more_ids=.true.
  132.     return
  133.  
  134. 300    more_ids=.false.
  135.     string=' '
  136.     return
  137.     end
  138.  
  139.     subroutine testit(rvalue)
  140.       implicit none
  141.       include '($lnmdef)' ! gives us the constants we need to talk       !#27652
  142.       include '($psldef)' ! to $trnlnm.                                  !#27652
  143.       include '($RMSdef)' ! to $trnlnm.                                  !#27652
  144.       include '($SMGdef)' ! to $trnlnm.                                  !#27652
  145.  
  146.     integer zero,zero2,attrib
  147.     integer outunit
  148.     data outunit/51/
  149.     character*100 string
  150.       integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  151.       external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  152.       integer*4 sys_status,sys_2
  153.     integer*4 i,j
  154.       integer holder(2),dholder(2)
  155.       integer rvalue
  156.       integer*2 w_buffer_length, w_item_code                             !#27652
  157.       integer*4 string_address, return_address                           !#27652
  158.       common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
  159.      +string_address, return_address                                !#27652
  160.     zero2=0
  161.     zero=0
  162.     do while (sys_status.ne.8684)
  163.       sys_status =                                                       !#27652
  164.      +sys$find_held(holder , rvalue,attrib,zero)
  165.     if (sys_status.eq.1) then
  166.       call test(rvalue)
  167.     else if (sys_status.eq.8684) then
  168.     else
  169.       write(outunit, *) ' <<<','sysstat=',sys_status
  170.     endif
  171.     enddo                   
  172.       end
  173.                     
  174.  
  175.  
  176.  
  177.     subroutine test(rvalue)
  178.       implicit none
  179.       include '($lnmdef)'
  180.       include '($psldef)'
  181.       include '($RMSdef)'
  182.       include '($SMGdef)'
  183.  
  184.     integer zero,zero2,attrib
  185.     character*100 string
  186.       integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  187.       external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  188.       integer*4 sys_status,sys_2
  189.     integer*4 i,j
  190.       integer holder(2),dholder(2)
  191.       integer rvalue
  192.       integer*2 w_buffer_length, w_item_code                             !#27652
  193.       integer*4 string_address, return_address                           !#27652
  194.       common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
  195.      +string_address, return_address                                !#27652
  196.     integer outunit
  197.     data outunit/51/
  198.     zero2=0
  199.     zero=0
  200.       string = ' '                                                       !#27652
  201.       w_item_code = lnm$_string                                          !#27652
  202.       w_buffer_length = len( string )                                    !#27652
  203.       string_address = %loc( string )                                    !#27652
  204.     sys_status= sys$idtoasc(%val(rvalue),w_buffer_length,
  205.      *        %descr(string),,,)
  206.     write (outunit,*) string(1:w_buffer_length),' :'
  207.     sys_2=0
  208.     do while(sys_2.ne.8684)
  209.     sys_2 =                       
  210.      +sys$find_holder (%val(rvalue),dholder,,zero2)
  211.     if (sys_2.ne.8684) then    
  212.     sys_status= sys$idtoasc(%val(dholder(1)),w_buffer_length,
  213.      *        %descr(string),,,)
  214.     write(outunit,*) '    ',string(1:w_buffer_length)
  215.     endif
  216.     enddo
  217.       end                                                                !#27652
  218.                     
  219.     subroutine user(tval)
  220.       implicit none                                                      !#27652
  221.       include '($lnmdef)' ! gives us the constants we need to talk       !#27652
  222.       include '($psldef)' ! to $trnlnm.                                  !#27652
  223.       include '($RMSdef)' ! to $trnlnm.                                  !#27652
  224.       include '($SMGdef)' ! to $trnlnm.                                  !#27652
  225.  
  226.     integer zero,zero2,attrib
  227.     character*100 string
  228.       integer*4 sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  229.       external sys$trnlnm,sys$find_held,sys$find_holder,sys$idtoasc
  230.       integer*4 sys_status,sys_2
  231.     integer*4 i,j
  232.       integer holder(2),dholder(2)
  233.       integer rvalue,tval
  234.       integer*2 w_buffer_length, w_item_code                             !#27652
  235.       integer*4 string_address, return_address                           !#27652
  236.       common / mln_itmlst / w_buffer_length, w_item_code,                !#27652
  237.      +string_address, return_address                                !#27652
  238.     integer outunit
  239.     data outunit/51/
  240.  
  241.     zero2=0
  242.     zero=0
  243.     holder(1)=tval
  244.       string = ' '                                                       !#27652
  245.       w_item_code = lnm$_string                                          !#27652
  246.       w_buffer_length = len( string )                                    !#27652
  247.       string_address = %loc( string )                                    !#27652
  248.     sys_status= sys$idtoasc(%val(holder(1)),w_buffer_length,
  249.      *        %descr(string),,,)
  250.     write (outunit,*) string(1:w_buffer_length),' :'
  251.     sys_status=0
  252.     zero=0
  253.     do while (sys_status.ne.8684)
  254.            sys_status =
  255.      +         sys$find_held(holder , rvalue,attrib,zero)
  256.        if (sys_status.eq.1) then
  257.           sys_status= sys$idtoasc(%val(rvalue),w_buffer_length,
  258.      *                    %descr(string),,,)
  259.           write (outunit,*) '    ',string(1:w_buffer_length)
  260.        else if (sys_status.eq.8684) then
  261. c  do nothing
  262.        else
  263.           write (outunit,*) ' <<<','sysstat=',sys_status
  264.        endif
  265.     enddo                   
  266.  
  267.       end
  268.                                            
  269.                            
  270.  
  271.     INTEGER FUNCTION length(line)
  272. C
  273. C    This function return the number of characters in the line
  274. C    without trailing blanks or nulls.
  275. C                        
  276.     implicit none                             
  277.     character*(*) line
  278.     integer j
  279.  
  280.     j=len(line)
  281.     do while (((line(j:j).eq.' ').or.
  282.      *               (line(j:j).eq.'
  283.        j=j-1
  284.     enddo
  285.     length=j
  286.     return
  287.     end
  288.  
  289.      subroutine break_up_cli_options (optionname,optiontype,outfile)
  290.  
  291.     implicit none
  292.  
  293.     integer cli$get_value,cli$present
  294.     character*(*) optionname,outfile
  295.     integer optiontype
  296.     integer status
  297.  
  298.     status= cli$get_value ('output', outfile)
  299.     if (.not.status) then
  300.         outfile='SYS$output'
  301.     endif
  302.     
  303.     optiontype=0
  304.     status=cli$get_value ('option',optionname)
  305.     if (status) then
  306. d            type *,' option stat',status
  307.         status=cli$present ('identifier')
  308.         if (status) then
  309.            optiontype=1
  310.         else
  311.            optiontype=2
  312.         endif
  313.     else
  314. d            type *,' option stat',status
  315.       optiontype=0
  316.     endif
  317.     end
  318.  
  319.      subroutine break_up_cli_users (username,more_users)
  320.  
  321.     implicit none
  322.  
  323.     integer cli$get_value
  324.     character*(*) username
  325.     integer more_users 
  326.     integer status
  327.  
  328.     status=cli$get_value ('user',username)
  329.     if (status) then
  330. d            type *,' user stat',status
  331.       more_users=.true.
  332.     else
  333. d            type *,' user stat',status
  334.       more_users=.false.
  335.     endif
  336.     end
  337.  
  338.  
  339.     subroutine break_up_cli_string (idname,more_ids)
  340.  
  341.     implicit none
  342.  
  343.         integer more_ids
  344.     integer status,ustatus
  345.     integer cli$get_value
  346.     integer cli$present
  347.     integer count
  348.     data count/0/
  349.     character*(*) idname
  350.  
  351.     status=cli$present ('p1')
  352.     if (status.and. count.eq.0) then
  353. d    type *,'status of p1',status
  354.       status=cli$get_value ('p1',idname)
  355.           count=count+1
  356.       more_ids=.true.
  357.     else
  358.       Ustatus=cli$get_value ('identifier',idname)
  359.       if (ustatus) then
  360. d            type *,' id stat',ustatus
  361.         more_ids=.true.
  362.       else
  363. d       type *,' id* stat',ustatus
  364.        more_ids=.false.
  365.       endif            
  366.         endif
  367.     end
  368. -------------------------- cut here -------------------------------------- 
  369. !IDENT.CLD file. Substitute your default disk:[dir] names...
  370.  
  371. define verb ident
  372. image "disk:[dir]ident.exe"
  373.     parameter p1,  prompt="Identifier",value(type=$file)
  374.     qualifier IDENTIFIER, value(list)
  375.         qualifier USER,       value(list)
  376.         qualifier OPTION,     value(default="ident.opt",type=$file)
  377.     qualifier OUTPUT,     value(default="SYS$OUTPUT",type=$file)
  378. disallow any2(p1,identifier,user)
  379. disallow option AND NOT (identifier OR user)
  380. -------------------------- cut here -------------------------------------- 
  381. ! And here's the HELP file...
  382. 1 IDENT
  383.  
  384. The IDENT command accesses the rights database to either:
  385.  
  386.     a) Return the identifier(s) held by the specified username(s).
  387.     b) Return the username(s) which hold the specified identifier(s).
  388.  
  389. By default, the command expects the first parameter to be the name of
  390. a single identifer.  For example,  
  391.  
  392.     $ IDENT identifier_name
  393.  
  394. To input multiple identifiers, use the /IDENTIFIER qualifier:
  395.  
  396.     $ IDENT /IDENTIFIER=(IDENT1,IDENT2)
  397.  
  398. To determine what identifier a specific username holds, use the /USER
  399. qualifier:
  400.  
  401.     $ IDENT /USER=SMITH
  402.     $ IDENT /USER=(SMITH,JONES)
  403.  
  404. You may not use the /IDENTIFIER and /USER qualifiers together.  Their
  405. use is mutually exclusive.
  406.  
  407. 2 Command Qualifiers
  408.  
  409. /IDENTIFIER
  410. Returns the usernames(s) which hold the specified identifier(s). The
  411. username records are returned in the order in which they were added
  412. to the system and not alphabetically.
  413.  
  414.   FORMAT:
  415.   $ IDENT /IDENTIFIER=<identifier>
  416.   $ IDENT /IDENTIFIER=(ident1,ident2)
  417.  
  418. /USER
  419.  
  420. Return the identifier(s) held by the specified username(s).  The
  421. identifiers are returned in the order in which they were granted.
  422.                                                        
  423.   FORMAT:
  424.   $ IDENT /USER=SMITH
  425.   $ IDENT /USER=(SMITH,JONES) 
  426.  
  427. /OPTION
  428.  
  429. The /OPTION qualifier allows the use of an input file which contains
  430. EITHER identifiers OR usernames. Format of the file must be one name per
  431. line, starting in column 1. Exactly one of the qualifiers, /IDENTIFIER
  432. or /USER, must be specified along with the /OPTION qualifier for IDENT
  433. to discern what kind of records are present in the option file.
  434.  
  435.   FORMAT:
  436.   $ IDENT /OPTION=option_file.opt /IDENTIFIER
  437.   $ IDENT /OPTION=option_file.opt /USER
  438.  
  439. /OUTPUT
  440.  
  441. Redirects the output of the IDENT program to a file. Default output
  442. is SYS$OUTPUT.
  443.  
  444.   FORMAT:
  445.   $ IDENT /other_options /OUTPUT=out.fil
  446.  
  447.  
  448.