******************************************************************************
*
*	D I S K M O N
*
*	DISKMON is a monitor that checks all system-wide disks, mounted
*	with read/write access, and sends out warnings when the space
*	drops too low.  This is done in two stages:
*
*	Stage 1:  Space drops below the first danger level (parameter
*	WARNING).  At this point, all users with operator privilege,
*	or authorized to have operator privilege, will be notified.
*	No further notifications will be made, unless space drops a
*	certain level below the point where the last message was sent
*	out (parameter THRESH), or if space increases, then drops again
*	into the warning area.
*
*	Stage 2: Space drops below the second danger level (parameter
*	CRITICAL).  At this point, messages are sent out, not only to
*	operators, but also to all users with quota entries on the
*	given disk.  Messages will be sent once a minute from this point
*	on if space continues to fall.  No messages are sent as long as
*	space does not continue to be used, or rises.
*
*	Important Magic Numbers:
*
*		MAXDISKS - sets the number of disks that will be checked
*			   for space problems.
*		WARNING  - percentage of first danger level to disk
*			   space availability.
*		CRITICAL - percentage of free space considered to be really
*			   dangerous for users.
*		THRESH   - space use interval for WARNING stage, keeps
*			   the operators from getting too annoyed with
*			   the messages beeping 
*		INSIGNIF - If the user's space used is less than this number,
*			   don't bother him - he can't contribute much, anyway.
*		STRSIZE  - buffer size for logical disk name returned
*
*	Privileges required:
*		CMKRNL - to walk through the I/O database
*		OPER   - to notify the users about disk problems
*		WORLD  - to find those users' terminal addresses
*		SYSPRV - to find out which users have disk quotas
*			 a given disk
*
*	Note that routine DISKSPACE is extremely version-sensitive and
*	will probably have to be reworked with each major release of VAX/VMS.
*
*	Eric F. Richards
*	29-Jul-85
*
******************************************************************************
	program diskmon
	implicit none

	parameter crlf	   = char(13)//char(10)	! formatting aid

	parameter nodelog  = 'SYS$NODE'	! logical name to determine node name

	parameter maxdisks = 32		! max disks to wrry about at once

	parameter warning  = 2.0	! %age to send first warning is
	parameter critical = 1.0	! %age to really start worrying
	parameter thresh   = 0.1	! %age drop in space to send warnings

	parameter insignif = 20		! < this used: don't bother to warn him

	parameter strsize  = 64		! disk logical name buff size
	character diskname(maxdisks)*64	! logical name buffer - change here too
	character prevname(maxdisks)*64	! previous logical name - sanity check

	integer   diskspace		! get disk info routine
	integer   n			! number of disks retrieved in a lookup
	integer   dvl(maxdisks)		! logical name length buffer
	integer   maxblks(maxdisks)	! maximum blocks
	integer   freeblks(maxdisks)	! free blocks
	integer   prevfree(maxdisks)	! free blocks last time we checked
	real	  percentfree(maxdisks)	! calculated %age free
	real	  nextwarn(maxdisks)	! %age free last time we warned
	logical   set_thresh(maxdisks)	! reset an element of the above array?

	logical   scan_users		! do we have to worry 'bout anything?
	logical   urgent		! class of operator messages
	integer   i			! Loop variable
	integer   istat			! system service status
	integer   getquota		! quota lookup routine
	integer   qstat			! disk quota lookup status
	integer	  qused			! amount of quota used

	integer	  logstat		! logical name translation status
	integer	  trnlnm		! logical name translation function
	integer	  nodelen		! node name length
	character nodename*80		! node name return buffer

	integer   warn			! notify user/oper about situation
	integer	  opcom			! leave a note on the op console
	integer   getjpi		! external routine for GETJPI lookup
	integer   srchpid		! Wild card PID for GETJPI loookup
	character free*4		! character string of %age free
	character terminal*15		! terminal name
	integer   tlen			! terminal name length
	integer   group, member		! UIC buffers
	integer   pid			! Process ID buffer
	logical	  operpriv		! does he have oper priv
	logical   notify		! something is wrong. does anyone know?

	include	  '($ssdef)/nolist'	! system service def'ns

*
*	Get disk data
*

	do while(.true.)		
	  notify = .false.
	  call sys$setprn('Spy In The Sky')
	  istat=diskspace (maxdisks, 
     &			   n,
     &			   strsize,
     &			   dvl,
     &			   %ref(diskname),
     &			   maxblks,
     &			   freeblks)
	  if ( (istat .and. 1) .ne. 1) call lib$signal(%val(istat))

*
*	Calculate the percentage free space for the disks and
*	find out if it is necessary to notify people about the
*	disk space. Perform sanity check, and if it fails (due
*	to a dismount or starting the program up) reinit the
*	"history" information. (kludge!)
*
	  scan_users = .false.

	  do i=1,n
	    if (prevname(i) .ne. diskname(i)) then	! Sanity check
	      prevfree(i) = 99999999			! some big integer
	      nextwarn(i) = 200.0			! more than 100%
	      prevname(i) = diskname(i)			! All set!
	    end if

	    percentfree(i) = 100.0 * freeblks(i) / maxblks(i)
	    set_thresh(i) = .false.
	    if ( (percentfree(i) .le. warning) .and.
     &		 (prevfree(i) .gt. freeblks(i)) ) scan_users = .true.
	  end do
	
*
*	Scan all users, to notify the appropriate people about
*	the disk storage situation.
*
	  if (scan_users) then
*
*	What DECNET node, if any, are we running on?
*
	    logstat = trnlnm(nodelog, nodename, nodelen)
	    if ((logstat .and. 1) .eq. 1) then
	      nodename = 'Node '//nodename(:nodelen)//crlf
	      nodelen  = nodelen + 7
	    else
	      nodename = ' '
	      nodelen  = 1
	    end if
*
*	Start wild-card searching
*
	    srchpid = -1
	    istat = getjpi(srchpid, terminal, tlen,
     &			   group, member, operpriv, pid)
	    if ( (istat .and. 1) .ne. 1) call lib$signal(%val(istat))

	    do while(istat .ne. ss$_nomoreproc)
*
*	Notify only the interactive users
*
	      if ((terminal .ne. ' ') .and. (tlen .ne. 0)) then
	        do i = 1, n
	          if (freeblks(i) .lt. prevfree(i)) then		

*
*	Is this user an operator? do we notify him?
*
	            if (operpriv .and. (percentfree(i) .lt. warning)) then
		      urgent = .false.
		      if (percentfree(i) .lt. critical) urgent = .true.
		      if  (urgent .or. (percentfree(i) .lt. nextwarn(i))) then

*
*	Yes! notify him of the situation
*
		        write(free,100) percentfree(i)
		        if ((warn(diskname(i)(:dvl(i)),
     &				  freeblks(i),
     &				  free, terminal(:tlen),
     &				  urgent, nodename(:nodelen))
     &			    .and. 1) .eq. 1) then
			  set_thresh(i) = .true.
			  notify = .true.
			end if		! warning tries

	 	      end if		! %free < critical or thresh

		    else		! not oper or %free > warning

		      if ( (.not. operpriv) .and.
     &			   (percentfree(i) .lt. critical)) then

*
*	Is this user a non-operator, with a quota on this disk?
*	Does he have enough space occupied to make it worth notifying him?
*

	                qstat = getquota(diskname(i)(:dvl(i)),
     &					 group, member, qused)

		        if ( ((qstat .and. 1) .eq. 1) .and.
     &			     (qused .gt. insignif) ) then

		          write(free,100) percentfree(i)
		          if (1 .eq. (1 .and. warn(diskname(i)(:dvl(i)),
     &				    freeblks(i),
     &				    free, terminal(:tlen), .false., 
     &		'Please delete any files you no longer need'//crlf))) then
			    notify = .true.
			  end if

			end if        ! quota entry

		      end if        ! non-oper and %free <  critical

		    end if
	          else

*
*	Remember to reset this threshold value - more space is available
*
		    set_thresh(i) = .true.
	          end if        ! freeblks < prevfree
	        end do        ! loop for each device
	      end if        ! interactive job

*
*	Pick up next user on the list
*
	      istat = getjpi(srchpid, terminal, tlen,
     &			     group, member,
     &			     operpriv, pid)

	    end do        ! until ss$_nomoreproc

*
*	Did anyone find out about the disk situation?  If not, then
*	send a message to the op console so there is SOME record of
*	the problem and when/where it happened
*
	    if (.not. notify) then
	      do i = 1, n

		if ( (freeblks(i) .lt. prevfree(i)) .and.
     &		    ( (percentfree(i) .lt. critical) .or.
     &		     ( (percentfree(i) .lt. nextwarn(i) ) .and.
     &		      (percentfree(i) .lt. warning) ) ) ) then

		  write(free,100) percentfree(i)
		  if ((opcom(diskname(i) (:dvl(i)), freeblks(i), free)
     &		       .and. 1) .eq. 1) set_thresh(i) = .true.

		end if		    ! criteria for notification
	      end do		  ! scan disk list
	    end if		! notification
	  end if              ! scan_users

*
*	Reset threshold, if necessary, and reset previous free value
*

	  do i = 1, n
	    if (set_thresh(i)) nextwarn(i) = percentfree(i) - thresh
	    prevfree(i) = freeblks(i)

	  end do        ! resetting threshold


*
*	Go to sleep for a minute and then loop through again...
*
	  call sys$setprn('Eye In The Sky')
	  call delay60
	end do        ! main loop

100	format(f4.2)
	end
