        PROGRAM PORT_WATCH
C
        PARAMETER VERSION = 'PORT_WATCH V2.0 / 24-Jul-1985'
C
C       Program to prevent terminals being left idle for too long a period.
C       The users are warned at various intervals, each interval of time
C       being determined by the values FIRST_WARNING, SECOND_WARNING,
C       and TERMINATION.  These time inteveral are multiples of the wake-up
C       interval; refer to the TIME variable.  In any case, a message is sent
C       to the operators log.
C
C       modified for VMS version 4.x by Mike Kosta 9-MAY-1985.
C              changed $getjpi & process index routine
C
C       AUTHOR:   UNKNOWN - This version obtained from Mike Kosta - DEC-ED
C       MODIFIED: J. B. FISCHER / MDSI
C
C       VERSION DATE        WHO COMMENT
C       ------- ----------- --- -------
C        V1.0   17-Jun-1985 JBF Obtained from Mike, added some comments
C                               and change some comment formats to make
C                               the code easier to review and modify.
C        v2.0   12-Aug-1985 JBF Changed FIRST_WARNING, SECOND_WARNING, and
C                               TERMINATION to variables whose values are taken
C                               from the logical name PORTWATCH_PARAMATERS.
C                               In preparation of release, some significant BUGS
C                               were fixed.
C

        INCLUDE '($SSDEF)/NOLIST'
        INCLUDE '($JPIDEF)/NOLIST'
        PARAMETER MAXUSER          = 256
        PARAMETER OPC$M_NM_CENTRL  =   1
        PARAMETER OPC$_RQ_RQST     =   3
        PARAMETER SYSGRP           =   8
C
        INTEGER*4    LIB$SYS_TRNLOG
        INTEGER*4    LIB$FREE_EF
        INTEGER*4    LIB$GET_EF
        INTEGER*4    SYS$DELPRC
        INTEGER*4    SYS$GETJPIW
        INTEGER*4    SYS$HIBER
        INTEGER*4    SYS$PURGWS
        INTEGER*4    SYS$SCHDWK
        INTEGER*4    SYS$SETPRN
        INTEGER*4    SYS$SNDOPR
        INTEGER*4    SYS$WAITFR
        INTEGER*4    SYS$BINTIM
C
        BYTE OPMESS_BUILD(8)
C
        CHARACTER*8  ACCNAM
        CHARACTER*30 HEADER_MESS
        CHARACTER*85 MESSAGE
        CHARACTER*95 OPER_MESS
        CHARACTER*13 TIME
        CHARACTER*7  TTYNUM
        CHARACTER*12 USRNAM
        CHARACTER*21 VALUE
C
        INTEGER*2    JPIBUF (68)
        INTEGER*2    TERM_JPIBUF (68)
        INTEGER*2    SEQ (MAXUSER)
        INTEGER*2    SEQN (2)
C
        INTEGER*4    TIME_STAMP_COUNT
        INTEGER*4    FIRST_WARNING
        INTEGER*4    SECOND_WARNING
        INTEGER*4    TERMINATION
        INTEGER*4    ACCADDR
        INTEGER*4    ACCLEN
        INTEGER*4    BIOADDR
        INTEGER*4    BIOLEN
        INTEGER*4    BUFIOC (MAXUSER)
        INTEGER*4    CODE
        INTEGER*4    CPULEN
        INTEGER*4    CPUTADDR
        INTEGER*4    CPUTIM (MAXUSER)
        INTEGER*4    E
        INTEGER*4    EFN
        INTEGER*4    GRPADDR
        INTEGER*4    GRPLEN
        INTEGER*4    INDEX
        INTEGER*4    INDPID
        INTEGER*4    INDXADDR
        INTEGER*4    INDXLEN
        INTEGER*4    LOGINADDR
        INTEGER*4    LOGINLEN
        INTEGER*4    LOGINT (2)
        INTEGER*4    PIDADDR
        INTEGER*4    PIDLEN
        INTEGER*4    PID_L
        INTEGER*4    PRCCADDR
        INTEGER*4    PRCCLEN
        INTEGER*4    SEEDPID
        INTEGER*4    TERMADDR
        INTEGER*4    TERMLEN
        INTEGER*4    TRMADDR
        INTEGER*4    TRMLEN
        INTEGER*4    TTYNUM_L
        INTEGER*4    USERADDR
        INTEGER*4    USERLEN
        INTEGER*4    WARN (MAXUSER)
        INTEGER*4    ACCNAM_L
        INTEGER*4    GRPNUM
        INTEGER*4    GRPNUM_L
        INTEGER*4    LOGINT_L
        INTEGER*4    NEWCPU
        INTEGER*4    NEWCPU_L
        INTEGER*4    NEWIOC
        INTEGER*4    NEWIOC_L
        INTEGER*4    OWNERPID
        INTEGER*4    OWNER_PID
        INTEGER*4    OWNER_LEN
        INTEGER*4    OWNR_PID
        INTEGER*4    OWNR_LEN
        INTEGER*4    PID
        INTEGER*4    RANGE (2)
        INTEGER*4    SUBCOUNT
        INTEGER*4    TIME_STAMP
        INTEGER*4    USRNAM_L
        INTEGER*4    WATIME (2)
C
        BYTE         TARGET
        BYTE         TYPE
        LOGICAL      HOLD (MAXUSER)
C
        COMMON /MSG_THRESH/ FIRST_WARNING, SECOND_WARNING, TERMINATION

C
C    Define the STRUCTURE of the request buffer
C
        EQUIVALENCE  (PIDADDR, JPIBUF(3))
        EQUIVALENCE  (PIDLEN, JPIBUF(5))
C
        EQUIVALENCE  (CPUTADDR, JPIBUF(9))
        EQUIVALENCE  (CPULEN, JPIBUF(11))
C
        EQUIVALENCE  (BIOADDR, JPIBUF(15))
        EQUIVALENCE  (BIOLEN, JPIBUF(17))
C
        EQUIVALENCE  (LOGINADDR, JPIBUF(21))
        EQUIVALENCE  (LOGINLEN, JPIBUF(23))
C
        EQUIVALENCE  (USERADDR, JPIBUF(27))
        EQUIVALENCE  (USERLEN, JPIBUF(29))
C
        EQUIVALENCE  (ACCADDR, JPIBUF(33))
        EQUIVALENCE  (ACCLEN, JPIBUF(35))
C
        EQUIVALENCE  (TERMADDR, JPIBUF(39))
        EQUIVALENCE  (TERMLEN, JPIBUF(41))
C
        EQUIVALENCE  (GRPADDR, JPIBUF(45))
        EQUIVALENCE  (GRPLEN, JPIBUF(47))
C
        EQUIVALENCE  (PRCCADDR, JPIBUF(51))
        EQUIVALENCE  (PRCCLEN, JPIBUF(53))
C
        EQUIVALENCE  (INDXADDR, JPIBUF(57))
        EQUIVALENCE  (INDXLEN, JPIBUF(59))
C
        EQUIVALENCE  (OWNER_PID, JPIBUF(63))
        EQUIVALENCE  (OWNER_LEN, JPIBUF(65))
C
C       Define request buffer for getting terminal of parent process
C
        EQUIVALENCE  (TRMADDR, TERM_JPIBUF(3))
        EQUIVALENCE  (TRMLEN, TERM_JPIBUF(5))
C
        EQUIVALENCE  (OWNR_PID, TERM_JPIBUF(9))
        EQUIVALENCE  (OWNR_LEN, TERM_JPIBUF(11))
C
        EQUIVALENCE  (TYPE, OPMESS_BUILD(1))
        EQUIVALENCE  (TARGET, OPMESS_BUILD(2))
        EQUIVALENCE  (OPMESS_BUILD, OPER_MESS)
        EQUIVALENCE  (MESSAGE, OPER_MESS(11:))
        EQUIVALENCE  (SEQN(1), INDEX)

C
C    Fill in the GETJPI request buffer with values
C
        JPIBUF(2) = JPI$_PID  !Request PID
        JPIBUF(1) = 4
        PIDADDR   = %LOC(PID)
        PIDLEN    = %LOC(PID_L)
C
        JPIBUF(8) = JPI$_CPUTIM  !Request the cpu time used
        JPIBUF(7) = 4
        CPUTADDR  = %LOC(NEWCPU)
        CPULEN    = %LOC(NEWCPU_L)
C
        JPIBUF(14) = JPI$_BUFIO  !Request BUF_IO (terminal activity)
        JPIBUF(13) = 4
        BIOADDR    = %LOC(NEWIOC)
        BIOLEN     = %LOC(NEWIOC_L)
C
        JPIBUF(20) = JPI$_LOGINTIM  !Request the login time
        JPIBUF(19) = 8
        LOGINADDR  = %LOC(LOGINT)
        LOGINLEN   = %LOC(LOGINT_L)
C
        JPIBUF(26) = JPI$_USERNAME  !Request the USERNAME
        JPIBUF(25) = 12
        USERADDR   = %LOC(USRNAM)
        USERLEN    = %LOC(USRNAM_L)
C
        JPIBUF(32) = JPI$_ACCOUNT  !Request the account name
        JPIBUF(31) = 8
        ACCADDR    = %LOC(ACCNAM)
        ACCLEN     = %LOC(ACCNAM_L)
C
        JPIBUF(38) = JPI$_TERMINAL  !Request the terminal id
        JPIBUF(37) = 7
        TERMADDR   = %LOC(TTYNUM)
        TERMLEN    = %LOC(TTYNUM_L)
C
        JPIBUF(44) = JPI$_GRP  !Request the users group number
        JPIBUF(43) = 4
        GRPADDR    = %LOC(GRPNUM)
        GRPLEN     = %LOC(GRPNUM_L)
C
        JPIBUF(50) = JPI$_PRCCNT  !Request the number of subprocess'
        JPIBUF(49) = 4
        PRCCADDR   = %LOC(SUBCOUNT)
        PRCCLEN    = 0
C
        JPIBUF(56) = JPI$_PROC_INDEX  !Request the process index
        JPIBUF(55) = 4
        INDXADDR   = %LOC(INDEX)
        INDXLEN    = 0
C
        JPIBUF(62) = JPI$_OWNER !Request the owner process PID
        JPIBUF(61) = 4
        OWNER_PID  = %LOC(OWNERPID)
        OWNER_LEN  = 0
C
        JPIBUF(67) = JPI$C_LISTEND  !end of list
C
C       SETUP FOR SECONDARY GETJPI
C
        TERM_JPIBUF(1) = JPI$_TERMINAL  !Request the terminal id
        TERM_JPIBUF(2) = 7
        TRMADDR   = %LOC(TTYNUM)
        TRMLEN    = %LOC(TTYNUM_L)
C
        TERM_JPIBUF(7) = JPI$_OWNER !Request the owner process PID
        TERM_JPIBUF(8) = 4
        OWNR_PID  = %LOC(OWNERPID)
        OWNR_LEN  = 0
        TERM_JPIBUF(13) = JPI$C_LISTEND  !end of list
C
        TYPE = OPC$_RQ_RQST        !SET UP FOR THE SYS$SNDOPR
        TARGET = OPC$M_NM_CENTRL
        OPER_MESS(9:9) = CHAR(7)
        OPER_MESS(10:10) = CHAR(7)
        HEADER_MESS = CHAR(7)//'PORT_WATCH message: '//CHAR(7)
C
        RANGE(1) = 0
        RANGE(2) = '7FFFFFFF'X
        MINTIM   = 5
C
        DO I = 1, MAXUSER
          HOLD (I)   = .FALSE.
          WARN (I)   = 0
          SEQ  (I)   = 0
          BUFIOC (I) = 0
          CPUTIM (I) = 0
        ENDDO

C
C       DECLARATIONS DONE, LETS ANNOY SOME USERS
C
        CODE = SYS$SETPRN('PORT_WATCH')
        CALL BUG(CODE)
C
        TIME_STAMP = 0
        OPER_MESS(11:56) = '%PORT_WATCH-I-INITMSG, Initialized and Running'
        CODE = SYS$SNDOPR(OPER_MESS,)
        CALL BUG(CODE)
C
        DO WHILE (.TRUE.)             !Forever, 'til we're told to stop.
          TIME_STAMP = TIME_STAMP + 1
C
          CODE = LIB$SYS_TRNLOG ('PORTWATCH_PARAMETERS', LENGTH, VALUE, , , 0)
          IF (CODE .EQ. SS$_NOTRAN) VALUE = '0 00:07:00.00 3 3 4 5'
          READ (VALUE,'(A13,4I2)') TIME, TIME_STAMP_COUNT, FIRST_WARNING,
     *                                SECOND_WARNING, TERMINATION
          CODE = SYS$BINTIM(TIME,WATIME)
          CALL BUG(CODE)
C
C         Send occassional TIME STAMP to OPA0:
C
          IF (TIME_STAMP .EQ. TIME_STAMP_COUNT) THEN
            OPER_MESS(11:94) = '%PORT_WATCH-I-TIMSTMP, Time Stamp'
            CODE = SYS$SNDOPR(OPER_MESS,)
            CALL BUG(CODE)
            TIME_STAMP = 0         ! Reset TIME_STAMP counter for next timestamp
          ENDIF
C
          SEEDPID = -1
          E = 0
C
          DO WHILE (E .NE. SS$_NOMOREPROC) ! Loop until all users examined once
            E = SYS$GETJPIW ( , SEEDPID, , JPIBUF, , , )
            IF ((E .NE. SS$_NOPRIV) .AND.       ! If it an unexpected error,
     *          (E .NE. SS$_NONEXPR) .AND.      !  then stop this process with
     *          (E .NE. SS$_SUSPENDED) .AND.    !    appropriate error message
     *          (E .NE. SS$_NOMOREPROC)) CALL BUG(E)
C
            IF (E .EQ. SS$_NORMAL) THEN
C
C             Get the low 16 bits of users process index, the high order bits
C             are the sequence number (Under 3.x this was called the PID!).
C
              INDPID = SEQN(1)
              WARN (INDPID) = WARN (INDPID) + 1
C
C             If the sequence number has changed since we last logged in, we
C             have a new user. Reset all the use counts, and don't bother him.
C
              IF (SEQ (INDPID).NE.SEQN(2)) THEN
                SEQ (INDPID)    = SEQN(2)       !A new user - rest counts
                CPUTIM (INDPID) = 0
                BUFIOC (INDPID) = 0
                WARN (INDPID)   = 0
                HOLD (INDPID)   = .FALSE.
              ENDIF
C
C             Leave the system processes alone, things break otherwise.
C
              IF (ACCNAM(1:ACCNAM_L).EQ.'SYSTEM') WARN (INDPID) = 0
              IF (GRPNUM .LE. SYSGRP) WARN (INDPID) = 0 !Leave sys staff alone.
C
C             If he has no tty but has an owner process, then he's a subjob,
C             and subjobs should do work.
C
CCC              THESE NEXT THREE LINES ARE COMMENTED OUT 'CAUSE THEY DON'T WORK
CCC              DO WHILE ((TTYNUM_L.EQ.0) .AND. (OWNERPID .NE. 0))
CCC                E = SYS$GETJPIW ( , OWNERPID, , TERM_JPIBUF, , , )
CCC              ENDDO
C
C             If he has no tty and no owner process, then he is a batch job,
C             or an acp or something like that. So don't bother the process.
C
              IF (TTYNUM_L.EQ.0) WARN (INDPID) = 0
C
C             Normal user, he can be saved by doing an i/o, or using 50ms of cpu
C
              IF (BUFIOC (INDPID).LT.NEWIOC) THEN
                WARN (INDPID) = 0
                BUFIOC (INDPID) = NEWIOC
              ENDIF
              IF (CPUTIM (INDPID) + MINTIM.LE.NEWCPU) THEN
                WARN (INDPID) = 0
                CPUTIM (INDPID) = NEWCPU
              ENDIF
C
C             If he has some subprocesses running then he may be waiting,
C             so don't blow him away (if he's really idle we'll catch him 
C             after we blow off the idle subjob).
C
              IF (SUBCOUNT .GT. 0) THEN
                HOLD (INDPID) = .TRUE.
                WARN (INDPID) = FIRST_WARNING
              ELSE
                HOLD (INDPID) = .FALSE.
              ENDIF
C
C             We now know the turkey's state; let's decide what to do with him
C
              IF (.NOT. HOLD (INDPID)) THEN ! if he's an idle parent job,
C                                             then let him be, but don't forget
C                                             the fact that he's idle.
C
                IF ((WARN (INDPID) .EQ. FIRST_WARNING)  .OR.
     *              (WARN (INDPID) .EQ. SECOND_WARNING) .OR.
     *              (WARN (INDPID) .EQ. TERMINATION)) THEN
                  CALL WARNUSER(MESSAGE,WARN (INDPID),TTYNUM,TTYNUM_L,
     *                          USRNAM,USRNAM_L)
                  CODE = SYS$SNDOPR(OPER_MESS,)
                  CALL BUG(CODE)
                  CALL BRDCST(HEADER_MESS,TTYNUM)
                  CALL BRDCST(OPER_MESS(9:),TTYNUM)
                  IF (WARN (INDPID) .EQ. TERMINATION) THEN
                    CODE = SYS$DELPRC(%REF(PID),)
                    CALL BUG(CODE)
                  ENDIF
                  CPUTIM (INDPID) = NEWCPU
                  BUFIOC (INDPID) = NEWIOC
                ENDIF
              ENDIF
            ENDIF
          ENDDO
C
          CODE = SYS$SCHDWK(,,WATIME,) !Schedule a wake up call
          CALL BUG(CODE)
C
C         THE RANGE FIELD PROVIDES FOR PURGING ALL OF THE ADDRESS SPACE
C
          E = SYS$PURGWS(%REF(RANGE)) !don't waste memory while waiting
          CALL BUG(E)
C
          CODE = SYS$HIBER() !HIBERNATE 'til the sceduled wake-up
        ENDDO
        END

        SUBROUTINE BRDCST (MESSAGE, TERMINAL)
        CHARACTER*(*) MESSAGE, TERMINAL
        INCLUDE '($BRKDEF)/NOLIST'
        INTEGER*4 SYS$BRKTHRUW, SENDTYP
        INTEGER*2 IOSB (4)
        SENDTYP = BRK$C_DEVICE
        ICODE = SYS$BRKTHRUW ( , MESSAGE, TERMINAL, %VAL(SENDTYP), IOSB,
     *                         , , , %VAL(6), , )
        type *, message, terminal, icode
        RETURN
        END

        SUBROUTINE WARNUSER (MESSAGE,  LEVEL, TTYNUM,
     *                       TTYNUM_L, USRNAM, USRNAM_L)
C
        COMMON /MSG_THRESH/ FIRST_WARNING, SECOND_WARNING, TERMINATION
        INTEGER*4 FIRST_WARNING, SECOND_WARNING, TERMINATION
C
        INTEGER*2 MESSAGE_L
        INTEGER*2 TTYNUM_L
        INTEGER*2 USRNAM_L
C
        CHARACTER*85 MESSAGE
        CHARACTER*8  TIMBF
        CHARACTER*7  TTYNUM
        CHARACTER*12 USRNAM
C
        MESSAGE = ' '   ! clear the message buffer
C
        CALL TIME (TIMBF) !get the time of day
C
C       ASSEMBLE THE MESSAGE
C
        MESSAGE(1:8) = TIMBF
        MESSAGE_L = 10
        MESSAGE(MESSAGE_L:USRNAM_L + MESSAGE_L) = USRNAM
        MESSAGE_L = MESSAGE_L + USRNAM_L + 1
        MESSAGE(MESSAGE_L:MESSAGE_L + TTYNUM_L) = TTYNUM
        MESSAGE_L = MESSAGE_L + TTYNUM_L + 1
C
        IF (LEVEL .EQ. FIRST_WARNING)  MESSAGE (MESSAGE_L:MESSAGE_L + 54) = 
     *                        ' Inactive Process - FIRST warning.'
        IF (LEVEL .EQ. SECOND_WARNING) MESSAGE (MESSAGE_L:MESSAGE_L + 54) =
     *                        ' Inactive Process - SECOND warning.'
        IF (LEVEL .EQ. TERMINATION)    MESSAGE (MESSAGE_L:MESSAGE_L + 54) =
     *                        ' Inactive Process - TERMINATION notice.'
C
        RETURN      !We've got a nice note; now go back and send it to him
        END

        SUBROUTINE BUG (E)
C
        INCLUDE '($SSDEF)/NOLIST'
C
        INTEGER*4 E
        INTEGER*4 LIB$SIGNAL
C
        IF (E .NE. SS$_NORMAL) CALL LIB$STOP(%VAL(E))
        RETURN
        END
