[INHERIT('SYS$LIBRARY:STARLET')]PROGRAM argus3(OUTPUT);


{
      ARGUS3...  Program to kill inactive processes. Requires the
      QUADMATH package, which provides 64-bit arithmetic for
      messing with system times.
     
      Version 1.0            5/11/84

      David A. Johnson
      Synertek, Inc.    MS 37
      3001 Stender Way
      Santa Clara, CA 95054
      (408) 988-5839
                                                                   }

CONST

  interval = 5;            { Five-minute interval }
  system_group  = 5;       { Groups "system_group" & lower exempt }

  io_threshold = 5;        { Buffered IO's }
  cpu_threshold = 30;      { In 10-millisecond TICKs }

  n_to_warning = 4;        { Number of intervals before warning }
  n_to_kill = 6;           { Number of intervals before kill }

TYPE

  longword = INTEGER;
  byte     = [BYTE] -128..127;
  word     = [WORD] -32768..32767;
  name     = PACKED ARRAY [1..23] OF CHAR;
  str      = PACKED ARRAY [1..128] OF CHAR;
  quadword = PACKED ARRAY [1..2] OF INTEGER;
  alfa5    = PACKED ARRAY [1..5] OF CHAR;
  alfa12   = PACKED ARRAY [1..12] OF CHAR;
  alfa23   = PACKED ARRAY [1..23] OF CHAR;

  ans_type = (lword, string, flag_word);
  flag_type = (pcb00, pcb01, pcb02, pcb03, pcb04, pcb05, pcb06, pcb07,
               pcb08, pcb09, pcb10, pcb11, pcb12, pcb13, batch_run, pcb15,
               pcb16, pcb17, pcb18, pcb19, pcb20, network_run, pcb22, pcb23,
               pcb24, pcb25, pcb26, pcb27, pcb28, pcb29, pcb30, pcb31);

  sts_word  = SET OF flag_type;

  item_type= PACKED RECORD
    bl,item_code:word;
    CASE ans_type OF
       lword:(pdata:^longword;
               pld:^longword);
      string:(pstrg:^str;
               pls:^longword);
   flag_word:(fdata:^sts_word;
               fls:^longword);
  END;

  list_type= PACKED RECORD
        itm:ARRAY [1..20] OF item_type;
        END;

  ref = ^proc_data_type;

  proc_data_type = RECORD
            ppid:longword;
            fptr:ref;
            user:alfa12;
       owner_pid:longword;
            term:alfa5;
            stat:sts_word;
       cpu,delta_cpu,delta_io,io,grp,mem,proc_cnt,idle_count
                :longword;
         present:BOOLEAN;
  END;
{&****************************************}

VAR

  i,j,k,sstat,efn,st:INTEGER;
  kstat,wstat:INTEGER;
  len:word;
  logname:name;
  table:byte;
  debug:BOOLEAN;
  grpnum,memnum,pid:[VOLATILE]INTEGER;
  bufio,prccnt,owner:[VOLATILE]INTEGER;
  seedpid:[VOLATILE]INTEGER;
  imagname,terminal,username:[VOLATILE]str;
  pl,ulen,ilen:[VOLATILE]longword;
  cputim:[VOLATILE]longword;
  status:[VOLATILE]sts_word;
  item_list:list_type;
  quit,first_flag:BOOLEAN;
  t2:alfa23;
  qdelta,last_time,next_time:quadword;
  p,free,root,sentinel:ref;
  flcount,active_count:longword;
  warn_msg1,warn_msg2:VARYING[64] OF CHAR;
  kill_msg1,kill_msg2:VARYING[64] OF CHAR;
  tty:alfa5;
  victim:INTEGER;

PROCEDURE LIB$GET_EF(VAR efn:INTEGER);EXTERN;

PROCEDURE quadiv(a,b:quadword;VAR c:quadword);EXTERN;

PROCEDURE quamul(a,b:quadword;VAR c:quadword);EXTERN;

PROCEDURE quaadd(a,b:quadword;VAR c:quadword);EXTERN;

{&******************************************* }

PROCEDURE init_item_list;
BEGIN

WITH item_list.itm[1] DO BEGIN bl :=  7;  item_code := jpi$_terminal;
  pstrg := ADDRESS(terminal);  pls := ADDRESS(pl);  END;
WITH item_list.itm[2] DO BEGIN bl :=  4;  item_code := jpi$_cputim;
  pdata := ADDRESS(cputim);  END;
WITH item_list.itm[3] DO BEGIN bl :=  4;  item_code := jpi$_sts;
  fdata := ADDRESS(status);  END;
WITH item_list.itm[4] DO BEGIN bl :=  4;  item_code := jpi$_pid;
  pdata := ADDRESS(pid);  END;
WITH item_list.itm[5] DO BEGIN bl :=  4;  item_code := jpi$_grp;
  pdata := ADDRESS(grpnum);  END;
WITH item_list.itm[6] DO BEGIN bl := 12;  item_code := jpi$_username;
  pstrg := ADDRESS(username);  pls := ADDRESS(ulen);  END;
WITH item_list.itm[7] DO BEGIN bl :=  4;  item_code := jpi$_bufio;
  pdata := ADDRESS(bufio);  END;
WITH item_list.itm[8] DO BEGIN bl := 24;  item_code := jpi$_imagname;
  pstrg := ADDRESS(imagname);  pls := ADDRESS(ilen);  END;
WITH item_list.itm[9] DO BEGIN bl :=  4;  item_code := jpi$_prccnt;
  pdata := ADDRESS(prccnt);  END;
WITH item_list.itm[10] DO BEGIN bl :=  4;  item_code := jpi$_owner;
  pdata := ADDRESS(owner);  END;
WITH item_list.itm[11] DO BEGIN bl :=  4;  item_code := jpi$_mem;
  pdata := ADDRESS(memnum);  END;
item_list.itm[12].item_code := 0;     item_list.itm[12].bl := 0;
END;

{&******************************************* }

PROCEDURE update_entry(w:ref);

BEGIN
WITH w^ DO
  BEGIN
  delta_cpu := cputim - cpu;
  cpu := cputim;
  delta_io := bufio - io;
  io := bufio;
  proc_cnt := prccnt;
  present := TRUE;

  IF ( delta_cpu > cpu_threshold ) OR
     ( delta_io  >  io_threshold ) OR
     ( proc_cnt > 0 )        THEN idle_count := 0
  ELSE idle_count := idle_count + 1;
  END;
END;

{&******************************************* }

PROCEDURE new_entry;

VAR
  w:ref;
  k:INTEGER;

BEGIN

active_count := active_count + 1;

{ Obtain a record from the free list. If the Free List is
  empty, then get a new one from the Heap...              }

IF free <> sentinel THEN 
  BEGIN
  w := free;
  free := w^.fptr;
  flcount := flcount - 1;
  END
ELSE
  new(w);
{  Now fill in the new record.  }
w^.ppid := pid;
IF pl = 0 THEN w^.term := '*NT*:'
          ELSE FOR k := 1 TO 5 DO w^.term[k] := terminal[k];
w^.stat := status;
FOR k := 1 TO 12 DO w^.user[k] := username[k];
w^.cpu := cputim;
w^.delta_cpu := cputim;
w^.io := bufio;
w^.delta_io := bufio;
w^.grp := grpnum;
w^.mem := memnum;
w^.owner_pid := owner;
w^.proc_cnt := prccnt;
w^.idle_count := 0;
w^.present := TRUE;

{ Now enter it in the active list. }

w^.fptr := root;
root := w;

END;


{&******************************************* }

PROCEDURE search(spid:longword;VAR w:ref);


BEGIN
w := root;     sentinel^.ppid := spid;
WHILE w^.ppid <> spid DO w := w^.fptr;
END;







{ ******************************************* }

PROCEDURE mark_not_present;

VAR
  w:ref;

BEGIN
w := root;
WHILE w <> sentinel DO
  BEGIN
  w^.present := FALSE;
  w := w^.fptr;
  END;
END;

{&******************************************* }

PROCEDURE time_synch;

VAR

  a,b,c:quadword;
  s1:INTEGER;
  tx:alfa23;

BEGIN
IF first_flag THEN
  BEGIN
  first_flag := FALSE;
  a[1] := 10000000;      { One second in 100-nsec increments }
  a[2] := 0;
  b[1] := 60*interval;   { interval in seconds }
  b[2] := 0;

  quamul(a, b, qdelta);  { Interval in system time format }
  s1 := $asctim(,tx);
  s1 := $bintim(tx, c);    { Current time }
  quadiv(c, qdelta, a);
  quamul(a, qdelta, next_time);
  END;

last_time := next_time;
quaadd (last_time, qdelta, next_time);
$schdwk(,, next_time);
$hiber;
END;

{&******************************************* }

PROCEDURE remove(VAR a,z:ref);
VAR 
  tmp:ref;
BEGIN
IF a = root THEN root := a^.fptr
            ELSE z^.fptr := a^.fptr;
tmp := a^.fptr;  a^.fptr := free;  free := a;  a := tmp;
active_count := active_count - 1;
flcount := flcount + 1;
END;


{ ******************************************* }

PROCEDURE warn_user(w:ref);

VAR
  pd:longword;
  target:ref;
  idle_t, t_to_go:INTEGER;

BEGIN
idle_t := w^.idle_count*interval;
t_to_go := n_to_kill*interval - idle_t;
target := w;
WHILE target^.owner_pid <> 0 DO
  BEGIN
  pd := target^.owner_pid;
  search( pd, target );
  IF target = sentinel THEN halt;
  END;
tty := target^.term;

  IF target = w THEN WRITEV(warn_msg1, '    This terminal',
                  ' has been idle for ', idle_t:2, ' minutes,')
                ELSE WRITEV(warn_msg1, ' Subprocess ', HEX(w^.ppid, 8, 8),
                           ' has been idle for ', idle_t:2, ' minutes,');
  WRITEV(warn_msg2, '         and will be killed in ', 
                    t_to_go:2, ' minutes.');

  $brdcst('         ****WARNING****', tty);
  $brdcst( warn_msg1, tty );
  $brdcst( warn_msg2, tty );

WITH w^ DO
  BEGIN
  WRITE('  WARNING ', user, ' PID:');
  WRITE(HEX(ppid, 8, 8), ', Term:', tty);
  WRITE(' ', t2, ' ');
  IF owner_pid <> 0 THEN   WRITE(' S');
  WRITELN;
  END;

END;

{&******************************************* }

PROCEDURE kill_process(w:ref);

VAR
  pd:longword;
  target:ref;
  idle_t:INTEGER;

BEGIN
idle_t := w^.idle_count * interval;
target := w;

WHILE target^.owner_pid <> 0 DO
  BEGIN
  pd := target^.owner_pid;
  search(pd, target);
  IF target = sentinel THEN halt;
  END;
tty := target^.term;

IF target=w THEN WRITEV(kill_msg1, ' This process killed by ARGUS.')
            ELSE WRITEV(kill_msg1, ' Subprocess ', HEX(w^.ppid, 8, 8),
                                   ' killed by ARGUS.');
WRITEV(kill_msg2, '   (Inactive for', idle_t:3, ' minutes.)' );

$brdcst(kill_msg1, tty);
$brdcst(kill_msg2, tty);
victim := w^.ppid;
$delprc(victim);

WITH w^ DO
  BEGIN
  WRITE('**KILLING ', user, ' PID:');
  WRITE(HEX(ppid, 8, 8), ', Term:', tty);
  WRITE(' ', t2, ' ');
  IF owner_pid <> 0 THEN   WRITE(' S');
  WRITELN;
  END;

END;

{&******************************************* }

PROCEDURE analyze;
VAR
  w,wlast:ref;
  killed:BOOLEAN;

BEGIN
wlast := NIL;
w:= root;
WHILE w <> sentinel DO
 BEGIN
  IF w^.present THEN
    BEGIN
    killed := FALSE;
     WITH w^ DO
      BEGIN
      IF debug THEN
        BEGIN
        WRITE (' ', HEX(w, 8, 8) );
        WRITE (' ', hex(ppid, 8, 8) );
        WRITE ( ' ', user, ' ');
        WRITE ( term, ' ');
        WRITE ( cpu:8, ' ', io:8, ' ');
        WRITE ( delta_cpu:6, ' ', delta_io:6);
        WRITE ( '  **', idle_count:3, '**');
        WRITELN;
        END;
      IF (idle_count >= n_to_warning)
         AND (idle_count < n_to_kill) THEN warn_user(w)
      ELSE
        IF idle_count >= n_to_kill THEN
          BEGIN
          kill_process( w );
          remove(w, wlast);
          killed := TRUE;
          END;
      END;
    IF NOT killed THEN
      BEGIN
      wlast := w;
      w := w^.fptr;
      END;
    END
  ELSE
    remove(w, wlast);
 END;
END;

{&******************************************* }

PROCEDURE debug_print;

BEGIN
    WRITE( ' ', HEX(pid, 8, 8), ' ');

    IF ulen <= 0 THEN WRITE (' No user')
    ELSE
      FOR I := 1 TO ulen DO WRITE(username[i]);

    IF pl = 0 THEN WRITE('Nterm')
    ELSE
      FOR i := 1 TO pl DO WRITE(terminal[i]);
    WRITE(' [', OCT(grpnum, 3, 3), ',', OCT(memnum, 3, 3), ']');
    WRITE(' CPU: ', cputim:8);
    WRITE(' PRC-');
    IF prccnt > 0 THEN WRITE(' Parent ');
    IF owner <> 0 THEN WRITE('  Child ');
    IF (owner=0) AND (pl=0) AND (NOT (batch_run IN status)) THEN
        WRITE(' Detach ');
    IF batch_run IN status THEN WRITE(' Batch job.');
    IF network_run IN status THEN WRITE(' Network job.');
    WRITELN;
END;

{&******************************************* }
{              Main Program                   }
{ ******************************************* }

BEGIN

flcount := 0;     active_count := 0;

new(sentinel);   free := sentinel;   root := sentinel;

first_flag := TRUE;
init_item_list;
LIB$GET_EF(efn);
REPEAT
seedpid := -1;
st := $trnlog('ARGUS_DEBUG', len, logname, table,,5);
IF SUBSTR(logname, 1, 4) = 'TRUE' THEN debug := TRUE
                                  ELSE debug := FALSE;
time_synch;
sstat := 0;
kstat := $asctim(, t2, next_time);
{   WRITELN(' Current Time: ', t2);       }

{ Initialize all records to "not present" }

mark_not_present;

WHILE sstat <> SS$_NOMOREPROC DO
  BEGIN
  sstat := $getjpi(efn, seedpid,, item_list);
  wstat := $waitfr(efn);
  IF (grpnum > system_group)
       AND ( NOT (batch_run IN status) )
       AND (sstat <> ss$_suspended )
       AND (sstat <> ss$_nomoreproc) THEN
    BEGIN
    search(pid, p);
    IF p = sentinel THEN new_entry
                    ELSE update_entry(p);

    IF debug THEN debug_print;

    END;
  END;
analyze;

UNTIL quit;
END.