$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user FAUCONNET
$! on 11-OCT-1989 12:19:21.04.
$!
$! It contains the following 4 files:
$!        README.DOC
$!        WDOG.FOR
$!        COMMONS.FOR
$!        WDOG.COM
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail 
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip 
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip 
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip 
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) 
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line 
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START: 
$ FILE_IS = "README.DOC"
$ CHECKSUM_IS = 756913285
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X                 Installation et mise en service de WATCHDOG
X                 -------------------------------------------
X
XVersion 01.01-00 20 Juillet 1989
X
X
VWATCHDOG est un programme FORTRAN assurant les memes fonctions que le program
Xme
VSPIRIT  de  DEC,  c'est  a  dire  le  LOGOUT force de processes interactifs n
Xon
Vparents  de  sous  processes,  ne  consommant  ni  temps CPU, ni I/O pendant
X un
Xcertain delai.
X
XIl apporte de plus :
X
X- plus de precisions dans les messages OPCOM
X- la possibilite de proteger de WATCHDOG un certain nombre d'utilisateurs
X- la possibilite de ne pas LOGOUTer les processes executant des images ayant
X  un "contexte" : EDT, LISP etc.
X- le respect des processes "disconnected" qui ne sont pas surveilles.
X- la possibiliter de configurer certains parametres du programme
X
VLa  version  de  WATCHDOG  courante  ne  dispose  pas   encore   de   certain
Xes
Xfonctionnalites prevues :
X
X- delai de deconnexion dependant des utilisateurs (SYSTEM...)
X- eviction des processes plus progressive (forced exit puis delete process)
X- gestions correcte des processes en SET HOST (pour l'instant la seule
X  possibilite est de les proteger)
X
X
X`009Construction
X`009------------
X
XWATCHDOG est compose de deux sources Fortran : WDOG.FOR et COMMONS.FOR.
X
VWDOG.FOR  contient  le  code principal, COMMONS.FOR contient la declaration d
Xes
Vstructures,  des  commons et des parametres du programme. Ce dernier est incl
Xus
Vpar   WDOG.FOR,   il   n'y   a   donc  pas  de  compilation  separee  a  fair
Xe.
X
XIl peut etre necessaire de modifier COMMONS.FOR pour changer certains
Xparametres du programme :
X
X- nombre maximum de processes traites (MaxProcesses)
X- nombre maximum d'images protegees (MaxSafeImages)
X- nombre maximum d'utilisateurs proteges  (MaxSafeUsers)
X
XReportez-vous a COMMONS.FOR pour voir quelle sont les valeurs courantes.
XDans une release future, ces parametres seront modifiables sans
Xrecompilation...
X
XCeci fait, la compilation et l'edition de liens du programme se resume a:
X
X$ FORTRAN WDOG
X$ LINK WDOG
X
X`009Installation et demarrage
X`009-------------------------
X
VWATCHDOG  est  concu  pour  fonctionner  en  process  detache.  Le  fichier
X  de
Vconfiguration est lu au lancement de l'image. Il s'agit de WDOG_CONFIG.DAT da
Xns
Vla  directory  courante  ou  du  fichier pointe par le nom logique WDOG_CONFI
XG.
X
XLes lignes lues peuvent avoir l'un des quatre formats suivants :
X
X! commentaire...
X
Xnom-sans-directory.EXE
X
Xusername
X
Xparametre = valeur
X
VLes  lignes  ne  contenant  pas  un  "="  sont  interpretees  comme le nom d'
Xun
Xutilisateur ou d'une image a proteger de WatchDog.
X
VTout ce qui se termine par  ".EXE"  est  considere  comme  nom  d'une  image
X  a
Vproteger. Le reste est considere comme nom d'un utilisateur a proteger, sauf
X si
Vla ligne commence par  un  "!"  qui  annonce  un  commentaire  non  traite  p
Xar
XWATCHDOG.
X
XUne ligne contenant un "=" definit une valeur pour un parametre de WatchDog.
XCes parametres sont :
X
VLOGOFFLIMIT  :  Il  exprime  en minutes le delai d'inactivite au bout duquel
X un
Vprocess  interactif  utilisateur  est  tue.  WatchDog  envoie  sur  le termin
Xal
Vappartenant  a un process inactif un avertissement a la moitie et aux 3/4 de
X la
Xvaleur de LOGOFFLIMIT, qui est par defaut 60 minutes.
X
VMINCPU : Il exprime (en unites de 10 ms) le temps CPU minimum consomme  par
X  un
Vprocess entre deux passes de WATCHDOG (une  minute)  pour  qu'un  process  so
Xit
Vconsidere  comme  actif.  Sa  valeur  par  defaut  est  10   (soit   100   ms
X).
X
VLa  procedure WDOG.COM est a lancer depuis le compte SYSTEM (ou un autre comp
Xte
Vcomportant  tous  les  privileges).  Le  plus  facile  est  de  l'appeler  da
Xns
VSYSTARTUP.COM. La procedure lance un process detache "WatchDog" qui effectue
X la
Xsurveillance.
X
VDans   le   WDOG.COM   fourni,   on   suppose   que  l'image  de  WATCHDOG  e
Xst
VSYS$SYSROOT:[WDOG]WDOG.EXE.  Les  eventuels  messages affiches par WATCHDOG (
Xen
Vdehors   des   messages   normaux   envoyes   par   OPCOM)   sont  ecrits  da
Xns
XSYS$SYSROOT:[WDOG]WDOG.LOG.
X
XVoici un exemple de fichier WDOG_CONFIG.DAT :
X
X! Fichier de configuration WATCHDOG
X!
X! Images protegees
X!
XEDT.EXE`009`009! Perte du contexte si LOGOUT force
XTPU.EXE
XLISP.EXE
XLOGINOUT.EXE`009! Recommande pour DECwindows
XRTPAD.EXE`009! Evite de tuer les processes en SET HOST
X!
X! Utilisateurs proteges (susceptibles !)
X!
XRALEUR
XCHEF
XMOI
X!
X! Valeur du delai d'inactivite maximum, ici une heure
X!
XLOGOFFLIMIT=60
$ GOSUB UNPACK_FILE

$ FILE_IS = "WDOG.FOR"
$ CHECKSUM_IS = 1933608607
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X************************************************************************
X*                                                                      *
X*    WATCHDOG -- LOOK FOR IDLE TERMINALS AND KILL                      *
X*                ASSOCIATED PROCESSES                                  *
X*                                                                      *
X*    AUTHOR : Alain Fauconnet / INSERM U194                            *
X*    DESIGN : This program was modeled after the 'Spirit' program      *
X*             by Digital Equipment Corporation                         *
X*                                                                      *
X************************************************************************
X*                                                                      *
X*    FILE : WDOG.FOR -- Main file                                      *
X*                                                                      *
X************************************************************************
X
X*
X* Modification history
X* --------------------
X*
X*   A.0-0`00924-SEP-1987`009Initial alpha test release
X*   B.0-0`00922-JAN-1987`009Beta test release
X*`009`009Added checking for processes associated to a
X*`009`009disconnected virtual terminal.
X*`009`009Fixed bug in $SNDACC invocation.
X*`009`009Changed call to $GETJPI to asynchronous.
X*`009`009Improved input file handling: comments everywhere,
X*`009`009images and usernames may be mixed, images should
X*`009`009include '.EXE'. Blank lines no longer needed.
X*`009`009Improved error handling.
X*   B.1-0       18-MAY-1988     Beta bug fixes
X*               Restored call to $SNDOPR which had disappeared in
X*               previous release !
X*               Changed call to obsolete $SNDACC to $SNDJBC
X*   B.2-0       19-MAY-1988     Added timeout configuration
X*               Added feature to read logout inactivity timeout in
X*               configuration file. Corresponding line should be :
X*               LOGOFFLIMIT = nn
X*`009`009where nn is the value in minutes.
X*               First and second warning respectively issued at
X*               1/2 and 3/4 of timeout delay.
X*
X*   1.0-0`00912-JUL-1989`009First released version
X*`009`009Configuration now read from a file instead
X*`009`009of SYS$INPUT. WatchDog looks for WDOG_CONFIG.DAT
X*`009`009in the current directory or whatever the logical
X*`009`009WDOG_CONFIG: points to. File is open SHARED which
X*`009`009allows multiple WatchDog processes to share the
X*`009`009same configuration file in a cluster.
X*`009`009Added MINCPU = nn parameter in configuration
X*`009`009file. Sets minimum CPU time (in 10 ms units) consumed
X*`009`009during passes for the process to be considered active.
X*`009`009Default value is 10.
X*`009`009Protected users checking now done on usernames rather
X*`009`009than UICs.
X*`009`009Process entry is now updated after warning by WatchDog
X*`009`009because this may cause some CPU and/or IOs to be charged
X*`009`009to the target process, thus preventing it from being
X*`009`009eventually deleted.
X*
X*   1.1-0`00921-JUL-1989`009Some fixes and cleanup
X*`009`009Changed some criteria in process check routine: process
X*`009`009no longer need to have an associated terminal to be
X*`009`009a potential target for WatchDog. Instead of that, WatchDog
X*`009`009now checks the process mode for being INTERACTIVE.
X*`009`009This allows idle SPAWNed DCL processes to be killed.
X*`009`009Now configuration file is closed when no longer needed.
X*
X`009Program Watchdog
X`032
X`009Implicit None`009`009! Pretend I'm a pro
X
X*
X* System parameters
X* -----------------
X*
X `009Include '($JPIDEF)'`009! Get Job/Process request definitions
X `009Include '($OPCDEF)'`009! Definitions for $SNDOPR system service
X`009Include '($FSCNDEF)'`009! Definitions for $FILESCAN s.s.
X`009Include '($DVIDEF)'`009! Definitions for $GETDVI s.s.
X
X*
X* Main program
X* ------------
X*
X* Commons
X*
X`009Include 'COMMONS.FOR'
X*
X* Main program variables
X*
X`009Integer*4 Status
X`009Real OneMinute /60./
X`009Character*80 Buffer
X`009Character*80 Line
X`009Character*40 ParameterName
X`009Integer*4 ImageI, UserI, Temp, LineLength
X*
X* Code
X*                                      `032
X
X`009If (.not. Debug) goto 1
X`009OneMinute = 5.
X        FirstWarning = 1
X`009SecondWarning = 2
X`009LogoffLimit = 3
X
X* Setup item values in $GETJPI request block
X
X1`009Code1 = JPI$_ACCOUNT
X`009Code2 = JPI$_BUFIO
X`009Code3 = JPI$_CPUTIM
X`009Code4 = JPI$_DIRIO
X`009Code5 = JPI$_FILCNT
X`009Code6 = JPI$_FILLM                                   `032
X`009Code7 = JPI$_GRP
X`009Code8 = JPI$_IMAGNAME
X`009Code9 = JPI$_PID
X`009Code10 = JPI$_PRCCNT
X`009Code11 = JPI$_TERMINAL
X`009Code12 = JPI$_UIC
X`009Code13 = JPI$_USERNAME
X`009Code14 = JPI$_MODE
X`009Code15 = JPI$_PRCNAM
X
X* Setup pointer fields in $GETJPI request block
X              `032
X`009Ptr11 = %loc(Account)`009
X`009Ptr21 = %loc(BufIO)
X`009Ptr31 = %loc(CPUTime)
X`009Ptr41 = %loc(DirIO)                                `032
X`009Ptr51 = %loc(FilCnt)
X`009Ptr61 = %loc(FilLm)
X`009Ptr71 = %loc(Group)
X`009Ptr81 = %loc(ImageName)
X`009Ptr82 = %loc(ImageNameLength)
X`009Ptr91 = %loc(PID)
X`009Ptr101 = %loc(PrcCnt)
X`009Ptr111 = %loc(TermName)
X`009Ptr112 = %loc(TermNameLength)
X`009Ptr121 = %loc(UIC)
X`009Ptr131 = %loc(UserName)
X`009Ptr132 = %loc(UserNameLength)
X`009Ptr141 = %loc(Mode)
X`009Ptr151 = %loc(ProcessName)
X`009Ptr152 = %loc(ProcessNameLength)
X
X
X* Setup item codes in $GETDVI request block
X                                         `032
X`009DCode1 = DVI$_TT_DISCONNECT
X`009DCode2 = DVI$_TT_PHYDEVNAM
X
X* Setup pointer fields in $GETDVI request block
X
X`009DPtr11 = %loc(IsDisconnectable)
X`009DPtr21 = %loc(PhyTermName)
X`009DPtr22 = %loc(PhyTermNameLength)
X
X* Load tables with values read from file
X
X`009Open(UNIT=1,STATUS='OLD',SHARED,FILE=ConfigFile,
X`0091    CARRIAGECONTROL='NONE',ERR=500,DEFAULTFILE='.DAT',
X`0092    READONLY,RECORDTYPE='VARIABLE')
X
X`009ImageI = 1
X`009UserI = 1
X5`009Read(1,1000,end=13,err=13) Line
X`009If (Line .eq. ' ') goto 5
X`009Do 6,Temp = 1,80
X6`009If (Line(Temp:Temp) .ne. ' ' .and. Line(Temp:Temp) .ne. char(9))
X`0091`009goto 7
X7`009Call STR$UPCASE(Buffer,Line(Temp:80))
X`009Temp = Index(Buffer,'!')
X`009If (Buffer .eq. ' ' .or. Temp .eq. 1) goto 5
X`009If (Temp .ne. 0) Buffer = Buffer(1:Temp - 1)
X`009Call STR$TRIM(Buffer,Buffer,LineLength)
X`009Temp = Index(Buffer,'.EXE')
X`009If (Temp .ne. 0) goto 9
X`009Temp = Index(Buffer,'=')
X`009If (Temp .ne. 0) goto 200
X`009If (UserI .gt. MaxSafeUsers) goto 11
X`009SafeUsersTable(UserI) = Buffer(1:LineLength)
X`009UserI = UserI + 1
X`009Goto 5
X
X200`009ParameterName = Buffer(1:Temp - 1)
X`009If (ParameterName .ne. 'LOGOFFLIMIT') goto 220
X`009Read(Buffer(Temp + 1:80),1050) LogoffLimit
X`009FirstWarning = LogoffLimit / 2
X`009SecondWarning = (LogoffLimit + FirstWarning) / 2
X`009Goto 5
X
X220`009If (ParameterName .ne. 'MINCPU') goto 5
X`009Read(Buffer(Temp + 1:80),1050) MinCPU`009
X1050`009Format(BN,I)
X`009Goto 5
X
X9`009If (ImageI .gt. MaxSafeImages) goto 12
X`009SafeImagesTable(ImageI) = Buffer(1:Temp-1)
X`009ImageI = ImageI + 1
X`009Goto 5
X
X11`009Write(*,1020)
X1020`009Format(/' %WDOG-E-USRTFULL, safe users table full'/)
X`009goto 5
X
X12`009Write(*,1030)
X1030`009Format(/' %WDOG-E-IMGTFULL, safe images table full'/)
X`009goto 5
X
X13`009Close (1)
X`009If (UserI .le. MaxSafeUsers) SafeUsersTable(UserI) = ' '
X`009If (ImageI .le. MaxSafeImages) SafeImagesTable(ImageI) = ' '
X`009
X* Clear process table
X
X14`009Do 15, Temp = 1, MaxProcesses`009! Clear found flag in all entries
X`009Processtable(Temp).NeverUsed = .true.
X15`009ProcessTable(Temp).InUse = .false.
X `032
X20`009Call CheckTerms`009`009`009! Do one pass
X`009Call LIB$WAIT(OneMinute)
X`009Goto 20
X
X500`009Write(*,1040) ConfigFile
X1040`009Format(/' %WDOG-F-FNF, configuration file /'A'/ not found'/)
X`009Stop
X* Formats
X                                  `032
X1000`009Format (a)`009                   `032
X`009End
X*
V* CheckTerms -`009Checks all interactive processes and watches their activity
X.
X* ----------
X*
X* Entry:
X* Exit:
X*
X
X`009Subroutine CheckTerms
X
X`009Implicit None`009`009! Pretend I'm a pro
X
X*
X* System parameters
X* -----------------
X*
X`009Include '($SSDEF)'`009! System services statuses
X `009Include '($SJCDEF)'`009! Defintions for $SNDJBC
X `009Include '($JPIDEF)'`009! Get Job/Process request definitions
X `009Include '($OPCDEF)'`009! Definitions for $SNDOPR system service
X`009Include '($FSCNDEF)'`009! Definitions for $FILESCAN s.s.
X*
X* Common datas
X*
X`009Include 'COMMONS.FOR'
X*                   `032
X* Variables
X*
X`009Integer Index
X`009Integer Offset
X`009Integer Status            `032
X`009Integer FreeSlot
X  `009Integer*4 LastPID
X`009Logical`009FirstLoop
X `032
X        Integer*2 WItemList(6)`009`009`009! Used by $FILESCAN
X`009Integer*4 LItemList(3)
X`009Equivalence(WItemList,LItemList)
X
X`009Character*80 MsgBuf,MsgBuf2
X`009Character*18 DateTime /'dd-mmm-yy hh:mm:ss'/
X
X`009Integer*2 WSndJbcBuf(8)   `009`009! $SNDJBC buffer
X`009Integer*4 LSndJbcBuf(4)
X`009Equivalence(WsndJbcBuf,LSndJbcBuf)
X
X`009Integer*4 LSndOprBuf(22)`009`009! $SNDOPR buffer
X`009Character*88 CSndOprBuf
X`009Equivalence(LSndOprBuf,CSndOprBuf)
X`009Integer*4 DSndOprBuf(2)`009`009`009! $SNDOPR descriptor
X
X* Setup for wild card $GETJPI request
X
X`009Do 10, Index = 1, MaxProcesses`009! Clear found flag in all entries
X10`009ProcessTable(Index).FoundInLastScan = .false.
X`009WildPID = -1
X`009LastPID = 0     `032
X        FirstLoop = .true.
X
X* Search a valid process to look at
X
X20`009Status = SYS$GETJPI(%val(1),WildPID,,Len1,IOSB,,) ! Ask system
X`009If (.not. Status) goto 560`009! Branch if error
X`009Call SYS$WAITFR(%val(1))`009! Wait for completion
X`009Status = IOSB(1)
X `009If (.not. Status) goto 560      ! Branch if error
X
X* Check if $GETJPI looping on same process. If so, exit loop.
X
X`009If (.not. FirstLoop) goto 25
X`009FirstLoop = .false.
X`009goto 27
X25`009If (PID .eq. LastPID) goto 570
X
X* Save returned PID
X
X27`009LastPID = PID
X                                                       `032
X* Is this an interactive process ?
X
X`009If (Mode .ne. JPI$K_INTERACTIVE) goto 20 ! Skip if not
X
X* Is the terminal disconnected ?
X
X`009If (TermNameLength .ne. 0) then       `032
X`009 Status = SYS$GETDVIW(,,%descr(TermName),DLen1,DIOSB,,,)
X`009 If (.not. Status) goto 20`009       `009! Skip this one if failed
X`009 If (.not. DIOSB(1)) goto 20
X  `009 If (IsDisconnectable .and. (PhyTermNameLength .eq. 0)) goto 20
X`009Endif`009`009`009`009`009! Skip disc. terminal
X
X* Is this the root of a sub-process tree ?
X
X`009If (PrcCnt .ne. 0) goto 20`009`009! Yes, next one
X
X* Is the user one of the 'safe' Users ?
X
X* Correct username for blank suppression
X       `032
X`009Do 50 while (UserName(UserNameLength:UserNameLength) .eq. ' ')
X50`009UserNameLength = UserNameLength - 1
X                                      `032
X`009Do 30 Index=1,MaxSafeUsers
X`009If (SafeUsersTable(Index) .eq. ' ') goto 32    ! End of table hit
X30`009If (SafeUsersTable(Index) .eq. UserName(1:UserNameLength))
X`0091   goto 20 `009`009`009`009! Found, ignore it
X
X* Is this process running one of the 'safe' images ?
X* Handle the file name returned by $GETJPI to $FILESCAN to extract
X* file name without device, directory or type
X* First compute correct image name length (remove blanks)
X`032
X`009Do 51 while (ImageName(ImageNameLength:ImageNameLength) .eq. ' ')
X51`009ImageNameLength = ImageNameLength - 1
X`009If (ImageNameLength .eq. 0) goto 40`009! No image running
X32`009MsgBuf = ImageName`009`009`009! Copy in temp buffer
X`009WItemList(2) = FSCN$_NAME               ! Setup for $FILESCAN
X`009LItemList(3) = 0`009`009`009! Terminator
X`009Call SYS$FILESCAN(MsgBuf, LItemList,)
X
X* Now LItemList(2) points to start of file name and WItemList(1)
X* contains its length
X
X`009Offset = LItemList(2) - %loc(MsgBuf)
X`009Do 35 Index=1,WitemList(1)
X35`009ImageName(Index:Index) = MsgBuf(Index + Offset:Index + Offset)
X`009ImageNameLength = WItemList(1)
X
X`009Do 36 Index = ImageNameLength + 1, 64`009! Pad with blanks
X36`009ImageName(Index:Index) = ' '`009
X`009Do 37 Index=1,MaxSafeImages
X`009If (SafeImagesTable(Index) .eq. ' ') goto 40 ! End of table hit
X37`009If (SafeImagesTable(Index) .eq. ImageName) goto 20 ! Found, ignore it
X
X* Compute activity checksum = BufIO + DirIO + (FilLm - FilCnt)
X
X40`009Count = BufIO + DirIO + FilLm - FilCnt
X                                      `032
X* Correct processname for trailing blanks supression
X
X`009Do 55 while
X`0091      (ProcessName(ProcessNameLength:ProcessNameLength) .eq. ' ')
X
X55`009ProcessNameLength = ProcessNameLength - 1
X
X* Same for terminal name...
X
X`009Do 56 while
X`0091      (TermName(TermNameLength:TermNameLength) .eq. ' ')
X
X56`009TermNameLength = TermNameLength - 1
X
X* We've got a process, look for it in out table
X
X`009FreeSlot = 0`009`009`009! NULL value
X`009Do 100 Index = 1, MaxProcesses
X                                      `032
X* Remember first empty slot visited
X
X`009If (.not. ProcessTable(Index).InUse) goto 60
X
X* Scan till matching PID found
X
X`009If (ProcessTable(Index).ProcessPID .ne. PID) goto 100
X
X* Found : set flag indicating this situation
X
X`009ProcessTable(Index).FoundInLastScan = .true.    `032
X`009goto 120
X
X60`009If (FreeSlot .eq. 0) FreeSlot = Index ! Remember free entry
X
X* Exit as soon as an entry which was never used
X
X   `009If (ProcessTable(Index).NeverUsed) goto 110
X
X100`009Continue `032
X
X* Not found, add in a free slot if one available
X`009
X`009If (FreeSlot .eq. 0) goto 510`009`009! Table full, bad news...
X110`009ProcessTable(FreeSlot).ProcessPID = PID`009! Setup entry
X`009ProcessTable(FreeSlot).ProcessActivityCRC = Count
X`009ProcessTable(FreeSlot).ProcessCPUTime = CPUTime
X`009ProcessTable(FreeSlot).ProcessTimer = 0
X`009ProcessTable(FreeSlot).Inuse = .true.
X`009ProcessTable(FreeSlot).NeverUsed = .false.
X`009ProcessTable(FreeSlot).FoundInLastScan = .true.
X`009ProcessTable(FreeSlot).WarnedOnce = .false.
X`009ProcessTable(FreeSlot).WarnedTwice = .false.
X`009
X`009Goto 20`009`009`009`009! Next process
X
X* Let's take a close look at that process:
X* Any IOs done since last scan ?
X
X120`009If (Count .ne. ProcessTable(Index).ProcessActivityCRC) goto 200
X
X* Any significant work (CPU time) done ?
X
X`009If (CPUTime - ProcessTable(Index).ProcessCPUTime .ge. MinCPU)
X`0091   goto 200
X
X* No significant work done, check inactivity timer
X        `032
X`009ProcessTable(Index).ProcessTimer =
X`0091   ProcessTable(Index).ProcessTimer + 1
X`009ProcessTable(Index).ProcessCPUTime = CPUTime`009! Update CPU value
X                                          `032
X`009If (ProcessTable(Index).ProcessTimer .lt. LogoffLimit) goto 140
X
X* Passed logoff limit : has last warning been given ?
X              `032
X`009If (.not. ProcessTable(Index).WarnedTwice) goto 150
X
X* No mercy...
X* Issue logout message and kill process
X                        `032
X`009Call DATE(DateTime(1:9))
X`009Call TIME(DateTime(11:18))
X`009Write(MsgBuf,1000) DateTime,UserName(1:UserNameLength),
X`0091   ProcessName(1:ProcessNameLength),
X`0092   TermName(1:TermNameLength)
X`009Call TellUser(MsgBuf,' ',TermName)
X`009Call SYS$DELPRC(PID,,)
X`009ProcessTable(Index).InUse = .false.`009! Free corresp. slot
X
X* Send a message to operator
X
X`009LSndOprBuf(1) = ISHFT(OPC$M_NM_OPER12,8) + OPC$_RQ_RQST
X`009LSndOprBuf(2) = 0
X`009CSndOprBuf(9:88) = MsgBuf
X`009DSndOprBuf(1) = 88`009`009`009! Build descriptor
X`009DSndOprBuf(2) = %loc(LsndOprBuf)
X
X`009Status = SYS$SNDOPR(DSndOprBuf,)
X`009`009
X* Send a message to accounting file to record this
X              `032
X`009WSndJbcBuf(2) = SJC$_ACCOUNTING_MESSAGE
X`009WSndJbcBuf(1) = 80
X`009LSndJbcBuf(2) = %loc(MsgBuf)
X`009LSndJbcBuf(3) = 0
X`009LsndJbcBuf(4) = 0
X`009Status = SYS$SNDJBCW(,%val(SJC$_WRITE_ACCOUNTING),,WSndJbcBuf,,,)
X
X`009Goto 20
X                        `032
X140`009If (ProcessTable(Index).ProcessTimer .lt. SecondWarning) goto 160
X
X* Second warning passed : ensure message has been given
X
X`009If (ProcessTable(Index).WarnedTwice) goto 20 ! Already done
X150`009Call DATE(DateTime(1:9))
X`009Call TIME(DateTime(11:18))
X`009Write(MsgBuf,1001) DateTime,UserName(1:UserNameLength),
X`0091   ProcessName(1:ProcessNameLength)
X`009Write(MsgBuf2,1002)LogoffLimit - SecondWarning
X`009Call TellUser(MsgBuf,MsgBuf2,TermName)
X`009ProcessTable(Index).WarnedTwice = .true.
X`009Goto 170
X
X160`009If (ProcessTable(Index).ProcessTimer .lt. FirstWarning) goto 20
X
X* First warning passed : ensure message has been given
X
X     `009If (ProcessTable(Index).WarnedOnce) goto 20 ! Already done
X`009Call DATE(DateTime(1:9))
X`009Call TIME(DateTime(11:18))
X`009Write(MsgBuf,1001) DateTime,UserName(1:UserNameLength),
X`0091   ProcessName(1:ProcessNameLength)
X`009Write(MsgBuf2,1002)LogoffLimit - FirstWarning
X`009Call TellUser(MsgBuf,MsgBuf2,TermName)
X`009ProcessTable(Index).WarnedOnce = .true.
X
X* Update process entry
X* This is done because when running some applications, broadcasting
X* a message may cause the process to be charged from some CPU
X* and/or IOs
X
X170`009Status = SYS$GETJPI(%val(1),PID,,Len1,IOSB,,) ! Ask system
X`009If (.not. Status) goto 560`009! Branch if error
X`009Call SYS$WAITFR(%val(1))`009! Wait for completion
X`009Status = IOSB(1)
X `009If (.not. Status) goto 560      ! Branch if error
X
X`009ProcessTable(Index).ProcessCPUTime = CPUTime
X`009Count = BufIO + DirIO + FilLm - FilCnt`009
X`009ProcessTable(Index).ProcessActivityCRC = Count
X`009Goto 20
X
X* The checked process has had some activity since last scan
X* Update its slot and reset timer
X
X200`009ProcessTable(Index).ProcessCPUTime = CPUTime`009
X`009ProcessTable(Index).ProcessActivityCRC = Count
X`009ProcessTable(Index).ProcessTimer = 0
X`009ProcessTable(Index).WarnedOnce = .false.
X`009ProcessTable(Index).WarnedTwice = .false.
X`009Goto 20
X
X* Handle 'process table full' condition
X
X510`009Call LIB$STOP(%val(SS$_VASFULL))
X`009
X* Handle $GETJPI error status
X                                     `032
X560`009If (Status .eq. SS$_NONEXPR) goto 20`009! Next one if deleted
X`009If (Status .eq. SS$_SUSPENDED) goto 20`009! Same if suspended
X`009If (Status .eq. SS$_NOMOREPROC)`009goto 570 ! End of process table ?
X`009Call LIB$STOP(%val(Status))`009`009! Abort if not
X
X* Scanned all existing processes, let's remove dead entries from our table
X
X570`009Do 580 Index = 1,MaxProcesses
V`009If (ProcessTable(Index).FoundInLastScan) goto 580`009! Next one if entry
X found
X`009ProcessTable(Index).InUse = .false.`009  `009! Clear in use flag
X580`009Continue
X`009Return`009`009`009`009`009! Nothing to do, return
X                                                 `032
X* Formats
X
X1000`009Format('Watchdog ',A18,' -- ',A,' (',A,') on ',A,' logged out')
X1001`009Format('Watchdog warning ',A18,' -- ',A,' (',A,')')
X1002`009Format('will be logged out in ',I2,' minutes if inactive.')
X
X`009End         `032
X
X*
X* TellUser -`009Broadcast a one or two line long message on a given terminal
X* --------
X*
X* Entry:`009Line1,Line2 are message buffers
X*`009`009Terminal is a char string containing the name of
X*`009`009the target terminal
X*
X*
X`009Subroutine TellUser(Line1,Line2,Terminal)
X
X`009Implicit None`009`009! Pretend I'm a pro
X
X`009Include '($BRKDEF)'`009! $BRKTHRU definitions
X
X`009Character*(*) Line1,Line2,Terminal
X                          `032
X`009Character*165 TellBuf
X `032
X`009TellBuf = ' '
X`009TellBuf(1:1) = char(7)`009`009`009! Add a BELL
X`009TellBuf(2:2) = char(13) `009`009! CR+LF
X`009TellBuf(3:3) = char(10)
X`009TellBuf(4:82) = Line1(1:79)
X`009TellBuf(83:83) = char(13) `009`009! CR+LF
X`009TellBuf(84:84) = char(10)
X`009If (Line2 .eq. ' ') goto 20
X`009TellBuf(85:163) = Line2(1:79)
X`009TellBuf(164:164) = char(13)
X`009TellBuf(165:165) = char(10)`032
X
X20`009Call SYS$BRKTHRU(,TellBuf,Terminal,%val(BRK$C_DEVICE),,,,,
X`0091                 %val(30),,)
X`009Return
X`009End
$ GOSUB UNPACK_FILE

$ FILE_IS = "COMMONS.FOR"
$ CHECKSUM_IS = 1110174902
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X************************************************************************
X*                                                                      *
X*    WATCHDOG -- LOOK FOR IDLE TERMINALS AND KILL                      *
X*                ASSOCIATED PROCESSES                                  *
X*                                                                      *
X*    AUTHOR : Alain Fauconnet / INSERM U194                            *
X*    DESIGN : This program was modeled after the 'Spirit' program      *
X*             by Digital Equipment Corporation                         *
X*                                                                      *
X************************************************************************
X*                                                                      *
X*    FILE : COMMONS.FOR -- Common data structures and buffers          *
X*                                                                      *
X************************************************************************
X
X*
X* Structures
X*
X
X* This program's internal process table entry
X
X`009Structure /ProcessEntry/
X`009    Integer*4 ProcessPID
X`009    Integer*4 ProcessActivityCRC
X`009    Integer*4 ProcessCPUTime
X`009    Logical InUse
X`009    Logical FoundInLastScan
X`009    Logical WarnedOnce
X`009    Logical WarnedTwice
X`009    Logical NeverUsed
X`009    Integer*4 ProcessTimer
X`009End Structure
X*
X* Configuration tables
X*
X
X* Tables dimensions
X
V`009Integer*2 MaxProcesses /200/`009`009! Max # of processes handled by this
X program
V`009Integer*2 MaxSafeUsers /50/`009`009! Max # of Users protected from this p
Xrogram
V`009INteger*2 MaxSafeImages /20/`009`009! Max # of images not aborted by this
X program
X
X* Table of Users whose processes are left alone by WatchDog
X
X`009Character*32 SafeUsersTable(50)
X
X* Table of image names which should not be aborted
X
X`009Character*64 SafeImagesTable(20)
X*
X* Process Table
X*
X`009Record /ProcessEntry/ ProcessTable(200)
X
X`009Common /Processes/ ProcessTable
X*
X* Miscellanous parameters
X*
X
X* Minimum CPU time consumed by a process in one minute for this
X* program to consider it working
X
X`009Integer*4 MinCPU /10/
X
X* Time values in minutes
X
X`009Integer*4 FirstWarning /30/ `032
X`009Integer*4 SecondWarning /45/
X`009Integer*4 LogoffLimit /60/
X
X* Miscellanous
X
X `009Logical Debug /.False./
X`009Logical Monitor /.True./
X`009Character*16 ConfigFile /'WDOG_CONFIG'/
X
X`009Common /Configuration/ MaxSafeUsers,SafeUsersTable,
X`0091`009`009       MaxSafeImages,SafeImagesTable,`032
X`0092`009`009       MinCPU, FirstWarning,
X`0093`009`009       SecondWarning, LogoffLimit,`032
X`0094`009`009       MaxProcesses,
X`0095                      Debug, Monitor, ConfigFile
X*
X* Buffers for values returned by $GETJPI
X*                `032
X`009Integer*4 IOSB(2)`009`009! $GETJPI IO Status Block
X`009Integer*4 WildPID               ! $GETJPI wild PID
X`009Integer*4 Count                 ! Checksum of BufIO+DirIO+(FIlLm-FilCnt)
X`009Integer*4 BufIO`009`009`009! # of buffered IOs
X`009Integer*4 CPUTime`009`009! CPU time used
X`009Integer`009DirIO`009     `009`009! # of direct IOs
X`009Integer*4 FilCnt`009`009! Open files count
X`009Integer*4 FilLm`009 `009`009! Maximum # of open files
X`009Integer*4 Group`009`009`009! UIC group #
X`009Integer*4 UIC`009`009`009! Full UIC
X`009Integer*4 Mode`009`009`009! Process mode
X`009Character*64 ImageName          ! Name of image running
X`009Integer*4 ImageNameLength`009! Its length
X`009Integer*4 PID`009`009`009! Process PID
X`009Integer*4 PrcCnt`009`009! # of subprocesses
X`009Character*7 TermName            ! Associated terminal name
X`009Integer*4 TermNameLength`009! Its length
X`009Integer*4 TerminalPtr`009`009! Pointer to terminal name
X`009Character*8 Account`009`009! Account name
X`009Character*12 UserName`009`009!
X`009Integer*4 UserNameLength`009!
X`009Character*16 ProcessName`009! Buffer for process name
X`009Integer*4 ProcessNameLength`009! Its length
X
X`009Common /GETJPI/ IOSB,WildPID,Count,BufIO,CPUTime,DirIO,
X`0091      FilCnt,FilLm,Group,UIC,Mode,ImageName,ImageNameLength,
X`0092      PID,PrcCnt,TermName,TermNameLength,TerminalPtr,Account,
X`0093      UserName,UserNameLength,ProcessName,ProcessNameLength
X*                      `032
X* $GETJPI Parameter block
X*
X`009Integer*2 Len1 /8/
X`009Integer*2 Code1`032
X`009Integer*4 Ptr11
X`009Integer*4 Ptr12 /0/
X
X`009Integer*2 Len2 /4/
X`009Integer*2 Code2`032
X`009Integer*4 Ptr21
X`009Integer*4 Ptr22 /0/
X
X`009Integer*2 Len3 /4/
X`009Integer*2 Code3`032
X`009Integer*4 Ptr31
X`009Integer*4 Ptr32 /0/
X
X`009Integer*2 Len4 /4/
X`009Integer*2 Code4`032
X`009Integer*4 Ptr41
X`009Integer*4 Ptr42 /0/
X
X`009Integer*2 Len5 /4/
X`009Integer*2 Code5`032
X`009Integer*4 Ptr51
X`009Integer*4 Ptr52 /0/
X
X`009Integer*2 Len6 /4/
X`009Integer*2 Code6`032
X`009Integer*4 Ptr61
X`009Integer*4 Ptr62 /0/
X
X`009Integer*2 Len7 /4/
X`009Integer*2 Code7`032
X`009Integer*4 Ptr71
X`009Integer*4 Ptr72 /0/
X
X`009Integer*2 Len8 /64/
X`009Integer*2 Code8`032
X`009Integer*4 Ptr81
X`009Integer*4 Ptr82
X
X`009Integer*2 Len9 /4/
X`009Integer*2 Code9`032
X`009Integer*4 Ptr91
X`009Integer*4 Ptr92 /0/
X
X`009Integer*2 Len10 /4/
X`009Integer*2 Code10`032
X`009Integer*4 Ptr101
X`009Integer*4 Ptr102 /0/
X
X`009Integer*2 Len11 /7/
X`009Integer*2 Code11            `032
X`009Integer*4 Ptr111
X`009Integer*4 Ptr112
X
X`009Integer*2 Len12 /4/
X`009Integer*2 Code12`032
X`009Integer*4 Ptr121
X`009Integer*4 Ptr122 /0/
X
X`009Integer*2 Len13 /12/
X`009Integer*2 Code13`032
X`009Integer*4 Ptr131
X`009Integer*4 Ptr132                             `032
X
X`009Integer*2 Len14 /4/
X`009Integer*2 Code14`032
X`009Integer*4 Ptr141
X`009Integer*4 Ptr142 /0/
X
X`009Integer*2 Len15 /16/
X`009Integer*2 Code15
X`009Integer*4 Ptr151
X`009Integer*4 Ptr152
X
X`009Integer*4 Terminator /0/
X
X`009Common /RequestBlock/ Len1,Code1,Ptr11,Ptr12,Len2,Code2,
X`0091      Ptr21,Ptr22,Len3,Code3,Ptr31,Ptr32,Len4,Code4,
X`0092      Ptr41,Ptr42,Len5,Code5,Ptr51,Ptr52,Len6,Code6,
X`0093      Ptr61,Ptr62,Len7,Code7,Ptr71,Ptr72,Len8,Code8,
X`0094      Ptr81,Ptr82,Len9,Code9,Ptr91,Ptr92,Len10,Code10,
X`0095      Ptr101,Ptr102,Len11,Code11,Ptr111,Ptr112,Len12,
X`0096      Code12,Ptr121,Ptr122,Len13,Code13,Ptr131,Ptr132,
X`0097      Len14,Code14,Ptr141,Ptr142,Len15,Code15,Ptr151,
X`0098      Ptr152,Terminator
X
X*
X* Buffer for values returned by $GETDVI
X*
X
X`009Character*64 PhyTermName  `009! Physical terminal name
X`009Integer*4 PhyTermNameLength`009! Its length
X`009Integer*4 IsDisconnectable`009! TERM/DISCONNECT flag
X`009Integer*4 DIOSB(2)
X
X`009Common /GETDVI/ PhyTermName, PhyTermNameLength, IsDisconnectable,
X`0091`009`009DIOSB
X
X*                      `032
X* $GETDVI Parameter block
X*
X`009Integer*2 DLen1 /4/
X`009Integer*2 DCode1`032
X`009Integer*4 DPtr11
X`009Integer*4 DPtr12 /0/
X                                                       `032
X`009Integer*2 DLen2 /64/
X`009Integer*2 DCode2`032
X`009Integer*4 DPtr21
X`009Integer*4 DPtr22
X
X`009Integer*4 DTerminator /0/
X
X`009Common /DReqBlock/ Dlen1,DCode1,Dptr11,Dptr12,Dlen2,Dcode2,
X`0091`009`009   Dptr21,DPtr22,DTerminator
X                       `032
X
X*
X* Declaration of external functions used
X*
X`009Integer*4 SYS$GETJPI, SYS$GETJPIW, SYS$GETDVIW,
X`0091`009  SYS$SNDOPR, SYS$SNDJBCW
$ GOSUB UNPACK_FILE

$ FILE_IS = "WDOG.COM"
$ CHECKSUM_IS = 1880063826
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$!`009WDOG.COM - Runs WatchDog program as a detached subprocess
X$!
X$`009ON ERROR THEN GOTO EXIT
X$`009ON CONTROL_Y THEN GOTO EXIT
X$`009RUN SYS$SYSROOT:[WDOG]WDOG.EXE -
X`009`009/PROCESS_NAME = "WatchDog" -
X`009`009/UIC = [1,4] -
X`009    `009/PRIORITY = 4 -
X`009`009/INPUT = _NLA0: -
X`009`009/OUTPUT = SYS$SYSROOT:[WDOG]WDOG_OUT.LOG -
X`009`009/ERROR = SYS$SYSROOT:[WDOG]WDOG_ERR.LOG -
X`009`009/BUFFER_LIMIT = 65535 -
X`009`009/NOACCOUNTING -
X`009`009/AST_LIMIT = 100 -
X`009`009/IO_BUFFERED = 12 -
X`009`009/IO_DIRECT = 12 -
X`009`009/FILE_LIMIT = 20 -
X`009`009/WORKING_SET = 100 -
X`009`009/MAXIMUM_WORKING_SET = 512 -
X`009`009/PAGE_FILE = 20480 -
X`009    `009/QUEUE_LIMIT = 64 -
X`009`009/SUBPROC_LIMIT = 64 -
X`009`009/PRIVILEGES = -
X`009`009`009(ACNT,ALLSPOOL,ALLSPOOL,ALTPRI,BUGCHK,BYPASS, -
X`009`009`009CMEXEC,CMKRNL,DETACH,DIAGNOSE,EXQUOTA,GROUP, -
X`009`009`009GRPNAM,LOG_IO,MOUNT,NETMBX,OPER,NOPFNMAP, -
X`009`009`009PHY_IO,PRMCEB,PRMGBL,PRMMBX,PSWAPM,SETPRV, -
X`009`009`009NOSHMEM,SYSGBL,SYSNAM,SYSPRV,TMPMBX,VOLPRO, -
X`009`009`009WORLD)
X$ EXIT:
X$`009EXIT
$ GOSUB UNPACK_FILE
$ EXIT