program FINGER


C
C  The FINGER command lists information about users that are
C  currently logged on.
C
C  Format:
C
C    FINGER [user[,...]]
C
C  Parameters:
C
C   user[,...]
C    Specifies one or more users to display information about.
C    If no users are specified, then information is displayed
C    about all users currently logged on.
C
C  The following information is displayed about each user process:
C
C	1) Username
C       2) Process 
C	3) Image name
C	4) State of process
C	5) Working set
C	6) Cpu time (in seconds)
C	7) Terminal number
C	8) Location of terminal
C
C  Except for terminal location, this information comes from $GETJPI.
C  I decided not to display the user's real name in order to avoid the
C  overhead of accessing the UAF.
C
C
C  To build this program issue the following commands:
C
C	$MACRO GETJPI
C	$FORTRAN FINGER
C	$LINK FINGER,GETJPI
C
C  FINGER must be installed with the WORLD privelege.
C
C  FINGER reads the file SYS$SYSDISK:[SYSMGR]WHO.WHR to obtain the
C  locations of the terminals.  The file should contain one line for
C  each terminal in the system.  Columns 1-5 should have the device
C  name of the terminal(no colons); i.e. TTA1.  Columns 6-23 should
C  contain the location and type of the terminal; i.e. Machine room VT52.
C
C
C  Author:  Ira Winston
C	    Computer Science Department
C	    University of Pennsylvania
C	    200 South 33rd Street
C	    Philadelphia, Pennsylvania  19104
C	    (215)-243-4707
C
C  Date:    October 1980


	implicit integer (a-z)

	parameter MAXTERMS = 64		    ! Maximum number of terminals
	parameter MAXUSERS = 64		    ! Maximum number of user on a
					    ! command line

	PARAMETER pcb$v_batch = 14	    ! Batch bit in process status

	external ss$_normal		    ! Normal return code
	external ss$_nomoreproc		    ! No more processes
	integer retcode			    ! Return code from system services

	character*512 command		    ! Command line
	integer command_length		    ! Command line length

	character*12 user_list(MAXUSERS)    ! Users specified on command line
	integer user_list_length	    ! Number of users specified

	character*5 loc_term(MAXTERMS)	    ! Terminal names
	character*18 loc_location(MAXTERMS) ! Terminal locations
	integer loc_count		    ! Number of terminals

	integer gpgcnt			    ! Global page count in ws
	integer ppgcnt			    ! Process page count in ws
	character*80 imagename		    ! Filename of current image
	integer sts			    ! Process status
	integer owner			    ! PID of process owner

	integer info_state		    ! Process state
	integer info_cputime		    ! Cpu time used
	integer info_pid		    ! Process id
	integer info_size		    ! Working set size
	character*8 info_account	    ! Account name
	character*9 info_imagename	    ! Program name
	character*6 info_terminal	    ! Device name of terminal
	integer termname_length		    ! Length of terminal name
	character*18 info_location	    ! Location of terminal
	character*12 info_username	    ! Username
	integer username_length		    ! Length of username

	logical match			    ! Username search function
	logical first			    ! First match flag

	character*5 states(14)
	data states/'COLPG','MWAIT',' CEF ',' PFW ',' LEF ',' LEFO',' HIB ',
	1	    ' HIBO',' SUSP','SUSPO',' FPG ',' COM ',' COMO',' CUR '/


C  Get command line

	retcode = lib$get_foreign (command,,command_length)
	if (retcode .ne. %loc(ss$_normal)) go to 9900


C  Parse command string on commas

	user_list_length = 0
	loc = 1
	do while (loc .le. command_length .and.
	1         user_list_length .lt. MAXUSERS)
	  commaloc = index(command(loc:command_length),',')
	  if (commaloc .eq. 0) commaloc = command_length - loc + 2		
	  user_list_length = user_list_length + 1
	  user_list(user_list_length) = command(loc:(loc+commaloc-2))
	  loc = loc + commaloc
	end do


C  Get process info for each non-system process

	first = .true.

	retcode = %loc(ss$_normal)
 	pid = -1       

	do while (retcode .ne. %loc(ss$_nomoreproc))


C  Get info about this process

	  retcode = getjpi (pid, %REF(info_username), username_length,
	1		    %REF(imagename), %REF(info_terminal),
	2		    termname_length, %REF(info_account), info_state,
	3		    info_cputime, ppgcnt, gpgcnt, sts, owner,
	4		    info_pid)


C  See if this is a user process

	  if (retcode .eq. %loc(ss$_normal) .and.
	1     ichar(info_account(1:1)) .gt. ichar(' ')) then


C  See if this user has been selected

	    if (match(info_username,user_list,user_list_length)) then


C  Read location file if first find

	      if (first) then
	        open (unit=1, type='old', name='SYS$SYSDISK:[SYSMGR]WHO.WHR',
	1	      readonly, err=50)
		loc_count = 0
		do while (loc_count .lt. MAXTERMS)
	  	  read(1,90001,end=100,err=50) loc_term(loc_count+1),
	1				 	 loc_location(loc_count+1)
90001	  	  format(a5,a18)
	  	  loc_count = loc_count + 1
		end do


C  Error reading file

50		continue
		loc_count = 0

100		continue
	      end if


C  Get working set size

	      info_size = ppgcnt + gpgcnt


C  Convert username to lowercase

	      info_username = info_username(:username_length)
	      do i = 2,username_length
	        if (ichar(info_username(i:i)) .ge. ichar('A') .and.
	1	    ichar(info_username(i:i)) .le. ichar('Z'))
	2	  info_username(i:i) = char(ichar(info_username(i:i)) + 
	3				    ichar('a') - ichar('A'))
	      end do


C  Clean up image name

	      bracloc = index(imagename,']')
	      if (bracloc .ne. 0) then
	        dotloc = index(imagename(bracloc+1:),'.') + bracloc
	        info_imagename = imagename(bracloc+1:dotloc-1)
	      else
	        info_imagename = ' '
	      end if


C  Get terminal name

	      info_location = ' '
	      if (owner .ne. 0) then	! Subprocess
	        info_terminal = 'Sub'

	      else if ((ishft(sts,-pcb$v_batch) .and. 1) .ne. 0) then
	        info_terminal = 'Batch'	! Batch job

	      else if (termname_length .eq. 0) then
	        info_terminal = 'Det'   ! Detached process

	      else			! Real terminal

	        termname_length = index(info_terminal,':') - 1
	        info_terminal = info_terminal(:termname_length)
	        do i = 1, loc_count
	          if (info_terminal .eq. loc_term(i)) then
	            info_location = loc_location(i)
		    go to 200
		  end if
	        end do
200		continue
	      end if  ! terminal


C  	Display information about this user

C  Print header the first time thru

	      if (first) then
	        type 90002
90002		format(1x,'Username',t15,'Pid',t25,'Program',t35,'State',
	1	       t42,'Size',t48,'Cpu time',t58,'TTY',t64,'Location')
		first = .false.
	      end if

	      type 90003,info_username,info_pid,info_imagename,
	1	         states(info_state),info_size,(info_cputime/100.0),
	2	         info_terminal,info_location
90003	      format(1x,a,t15,z8.8,t25,a,t35,a,t42,i4,t48,f8.2,t58,a,
	1	     t64,a)

	    end if  ! match(username)	
	  end if  ! user process
	end do	! while more processes
	call exit


C  Error from get command line

9900	continue
	call lib$stop(retcode)
	end


	logical function match (username,user_list,user_list_length)

C  Returns true if this user was specified on the command line or
C  if an empty command line was entered

	implicit integer (a-z)

	character*12 username, user_list(1000)

	if (user_list_length .eq. 0) then
	  match = .true.
	  return
	end if

	match = .false.
	do i = 1,user_list_length
	  length = index(user_list(i),' ') - 1
	  if (length .eq. 0) length = 12
	  if (user_list(i) .eq. username(:length)) then
	    match = .true.
	    return
	  end if
	end do
	return
	end