Program IMU
c
c     IMU...  Identifier Management Utility
c             Program to manage rightslist identifiers
c    
c     Version 1.0            19-FEB-1986
c
c     G. Beau Williamson	
c     Rockwell International
c     1200 N. Alma Rd. M/S 406-280
c     Richardson, Texas 75081
c     (214) 996-5547
c
c

	implicit	none
	include		'($stsdef)'

	integer 	stat
	integer 	cli$dcl_parse		! Command Parser
	external	imu_table		! CLI table
	external	lib$get_input		! Input routine
	external 	cli$dispatch		! Command Dispatcher
	external	rms$_eof		! EOF status

c Get command

10	stat = cli$dcl_parse (%val(0), 
	1			imu_table,	! CLD module
	2			lib$get_input,	! Parameter input routine
	3			lib$get_input,	! Command input routine
	4			'IMU> ')	! Command prompt

c Input and process user's commands until EOF or "EXIT" command seen

	   if (stat) then
	      call cli$dispatch		! If no errors dispatch to routine
	   else 
	      if (stat .eq. %loc(rms$_eof) ) then
	         call exit		! If EOF seen then exit
	      else 
		 ! Dont resignal warning from cli$dcl_parse
	         if (ibits (stat, 0, 3) .ne. sts$k_warning)
	1             call lib$signal( %val(stat) )
	      end if
	   end if

	   goto 10			! Repeat until EOF or EXIT seen

	end

c
c ID_GRANT command subroutine
c
	subroutine id_grant()

	implicit	none

	include		'($kgbdef)'

	integer		stat
	integer		sys$asctoid
	integer		sys$add_holder
	integer		cli$present
	integer		write_access
	integer*2	idlen
	integer*2	holderlen
	integer*4	holderid(2)
	integer*4	id
	integer*4	attrib
	character*10	attr
	character*32	idname
	character*32	holdername
	external	imu_granterr

c
c Get the identifier name
c
	call cli$get_value('IDNAME', idname, idlen)
	call cli$get_value('USERNAME', holdername, holderlen)
c
c Check access rights to add holder to the identifier
c
	stat = write_access(idname)
c
c Translate identifier name to id value
c
	if (stat) stat = sys$asctoid(idname,id,attrib)
c 
c If id found then grant id to holder
c
	if (stat) then

	   stat = sys$asctoid(holdername, holderid(1), ) 	! Get holder id

	   if (stat) then
	      attrib = 0				! Assume no RESOURCE
	      if ( cli$present('ATTRIBUTE') ) then
		 call cli$get_value('ATTRIBUTE',attr)
		 if (attr(1:1) .eq. 'R') attrib = kgb$m_resource
	      end if
	      stat =sys$add_holder( %val(id) ,holderid, %val(attrib) )
	   end if

	end if

	if (.not. stat) 
	1     call lib$signal(	imu_granterr,
	1			%val(2),
	1			idname(1:idlen),
	1			holdername(1:holderlen),
	1			%val(stat) )

	end

c
c ID_REVOKE command subroutine
c
	subroutine id_revoke()

	implicit	none

	integer		stat
	integer		sys$asctoid
	integer		sys$rem_holder
	integer		write_access
	integer*2	idlen
	integer*2	holderlen
	integer*4	holderid(2)
	integer*4	id
	integer*4	attrib
	character*32	idname
	character*32	holdername
	external	imu_revokeerr

c
c Get the identifier name
c
	call cli$get_value('IDNAME', idname, idlen)
	call cli$get_value('USERNAME', holdername, holderlen)
c
c Check access rights to remove holder from the identifier
c
	stat = write_access(idname)
c
c Translate identifier name to id value
c
	if (stat) stat = sys$asctoid(idname,id,attrib)
c 
c If id found then revoke id from holder
c
	if (stat) then

	   stat = sys$asctoid(holdername, holderid(1), )

	   if (stat) then
	      holderid(2) = 0 
	      stat = sys$rem_holder( %val(id) ,holderid)
	   end if
	end if

	if (.not. stat)
	1     call lib$signal(	imu_revokeerr,
	1			%val(2),
	1			idname(1:idlen),
	1			holdername(1:holderlen),
	1			%val(stat) )

	end

c
c ID_LIST command subroutine
c
	subroutine id_list()

	implicit	none

	integer		stat
	integer		sys$asctoid
	integer		read_access
	integer		outlun
	integer*4	id
	integer*4	attrib
	character*32	idname
	character*64	list_file
	external	imu_listerr
	parameter	(outlun=10)
	parameter	(list_file='IDENTIFIERS.LIS')

c
c Get the identifier name
c
	call cli$get_value('IDNAME', idname,)
c
c Translate identifier name to id value
c
	stat = sys$asctoid(idname,id,attrib)
c
c Check access rights to read holders of the identifier
c
	if (stat) stat = read_access(idname)
c 
c If identifier found then list holders
c
	if (stat) then 
	   open (unit=outlun, file=list_file, status='NEW')
	   call print_holders(outlun, id, idname, attrib)
	   close (unit=outlun)
	   print *,'Identifier listing written to ', list_file
	else
	   call lib$signal(imu_listerr, %val(0), %val(stat))
        end if
	end

c
c ID_SHOW command subroutine
c
	subroutine id_show()

	implicit	none

	integer		stat
	integer		sys$asctoid
	integer		read_access
	integer		outlun
	integer*4	id
	integer*4	attrib
	character*32	idname
	external	imu_showerr
	parameter	(outlun=10)

c
c Get the identifier name
c
	call cli$get_value('IDNAME', idname,)
c
c Translate identifier name to id value
c
	stat = sys$asctoid(idname,id,attrib)
c
c Check access rights to read holders of the identifier
c
	if (stat) stat = read_access(idname)
c 
c If identifier found then show holders
c
	if (stat) then 
	   open (unit=outlun, file='SYS$OUTPUT', status='NEW')
	   call print_holders(outlun, id, idname, attrib)
	   close (unit=outlun)
	else
	   call lib$signal(imu_showerr, %val(0), %val(stat))
        end if
	end

c
c PRINT_HOLDERS subroutine
c
	subroutine print_holders(lun, id, idname, attrib)

	include		'($kgbdef)'

	integer		lun
	integer*4	id
	character*32	idname
	integer*4	attrib

	integer		context
	integer		stat
	integer		sys$find_holder
	integer*4	holderid(2)
	character*10	attr
	character*32	holdername
	external	ss$_nosuchid

c
c Print Identifier header 
c
	attr = '          '			! Assume no_resource 
	if ( btest(attrib,kgb$v_resource) ) attr = 'RESOURCE  '

	write (lun,100)
	write (lun,200) idname,id,attr
	write (lun,300) 
100	format ('   Name                            Value'
	1	,'           Attributes')
200	format ('   ',A32,'%X',Z8.8,'      ',A10)
300	format ('     Holder                          Attributes')
400	format ('     ',A32,A10)

c
c Find and print all holders
c
	context	=	0		! Initialize for holder search
	stat = 1			! Initialize for loop
	do while (stat)
	   stat = sys$find_holder(%val(id), holderid, attrib, context)

	   if (stat) then
	      call sys$idtoasc(%val(holderid(1)), , holdername, , ,)
	      attr = '          '			! Assume no_resource 
	      if ( btest(attrib,kgb$v_resource) ) attr = 'RESOURCE  '
	      write (lun,400) holdername, attr
	   end if

	end do
	if (stat .ne. %loc(ss$_nosuchid) )
	1	call lib$signal(imu_showerr, %val(0), %val(stat) )
	end

c
c HELP command subroutine
c
	subroutine help()

	include	'($hlpdef)'

	integer*2	keylen
	integer*4	help_flags
	character*80	keyword

	external	lib$get_input
	external	lib$put_output

c
c Get the keywords from the command line
c
	call cli$get_value('KEYWORDS', keyword, keylen)
c
c Pass keywords to Librarian for help output
c
	help_flags = hlp$m_prompt
	call lbr$output_help(	lib$put_output,
	1			,
	2			keyword(1:keylen),
	3			'IMUHELP',
	5			help_flags,
	6			lib$get_input)

	end

c
c QUIT command subroutine
c
	subroutine quit()

	call exit
	end


c
c WRITE_ACCESS function
c
	integer function write_access(idname)

	implicit	none
	include		'($ssdef)'
	include		'($fordef)'

	integer		idlun
	integer*4	io_stat
	integer*4	io_success
	character*32	idname
	parameter	(idlun = 10)
	parameter	(io_success = 0)
	external	imu_nowrite
	external	imu_noacl
	external	imu_nological

	open(	unit=idlun,
	1	file = idname,
	1	defaultfile = 'IMU$DIR:.ACL;1',
	1	status = 'OLD',
	1	iostat = io_stat)
	if (io_stat .ne. io_success) then
	   call errsns(,,,,write_access)	! Convert iostat to status
	   if      (write_access .eq. for$_opefai) then
	      write_access = %loc(imu_nowrite)	! Signal "No Write Access"
	   else if (write_access .eq. for$_filnotfou) then
	      write_access = %loc(imu_noacl)	! Signal "No ACL established"
	   else if (write_access .eq. for$_no_sucdev) then
	      write_access = %loc(imu_nological)! Signal "No ID_ACL logical"
	   end if
	else
	   write_access = ss$_normal
	end if
	close (idlun)
	end

c
c READ_ACCESS function
c
	integer function read_access(idname)

	implicit	none
	include		'($ssdef)'
	include		'($fordef)'

	integer		idlun
	integer*4	io_stat
	integer*4	io_success
	character*32	idname
	parameter	(idlun = 10)
	parameter	(io_success = 0)
	external	imu_noread
	external	imu_noacl
	external	imu_nological

	open(	unit=idlun,
	1	file = idname,
	1	defaultfile = 'IMU$DIR:.ACL;1',
	1	status = 'OLD',
	1	readonly,
	1	iostat = io_stat)
	if (io_stat .ne. io_success) then
	   call errsns(,,,,read_access)		! Convert iostat to status
	   if      (read_access .eq. for$_opefai) then
	      read_access = %loc(imu_noread)	! Signal "No Read Access"
	   else if (read_access .eq. for$_filnotfou) then
	      read_access = %loc(imu_noacl)	! Signal "No ACL established"
	   else if (read_access .eq. for$_no_sucdev) then
	      read_access = %loc(imu_nological)	! Signal "No ID_ACL logical"
	   end if
	else
	   read_access = ss$_normal
	end if
	close (idlun)
	end