1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 ckauth: proc;
 12 
 13 /* CKAUTH - check for file authored by given user */
 14 
 15 
 16 dcl  path char (168) aligned,                               /* root of tree */
 17      ctime char (24) aligned,
 18     (co, dp) char (64) aligned,                             /* titles for report */
 19     (c1, char1) char (1) aligned,
 20     (i, j, k, l, m, n) fixed bin,
 21     (t1, t2) fixed bin,
 22      rolder (0: 90) fixed bin,
 23      folder (0: 90) fixed bin,
 24      movelen fixed bin,
 25      slp ptr,
 26      lth fixed bin (24),
 27      NL char (1) aligned,
 28      kk fixed bin,
 29      ap ptr,
 30      al fixed bin,
 31      bchr char (al) unaligned based (ap),
 32      ec fixed bin,
 33      total fixed bin int static,
 34      name char (32) aligned int static init ("Dumper.SysDaemon.a"),
 35      an fixed bin init (2),
 36      modsw bit (1) init ("1"b),
 37     (p, q, p1, q1, p2, q2) ptr;
 38 
 39 dcl  clock_ ext entry returns (fixed bin (71)),
 40      com_err_ entry options (variable),
 41      ioa_$rsnnl entry options (variable),
 42      cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin),
 43      sweep_disk_ ext entry (char (168) aligned, entry),
 44      expand_path_ ext entry (ptr, fixed bin, ptr, ptr, fixed bin),
 45      ioa_ entry options (variable),
 46      date_time_ entry (fixed bin (71), char (*) aligned),
 47      hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (24),
 48      fixed bin (2), ptr, fixed bin),
 49      get_wdir_ entry returns (char (168) aligned),
 50      hcs_$get_author entry (char (*) aligned, char (*) aligned, fixed bin, char (*) aligned, fixed bin),
 51      hcs_$get_bc_author entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin),
 52      hcs_$acl_add1 entry (char (*) aligned, char (*) aligned, char (*) aligned,
 53      fixed bin (5), (3) fixed bin (3), fixed bin),
 54      hcs_$terminate_noname entry (ptr, fixed bin);
 55 
 56 dcl  bcs char (262144) aligned based (slp);
 57 
 58 dcl (divide, substr, addr, null, index, fixed) builtin;
 59 
 60 dcl 1 movetable based aligned,
 61     2 moveary (movelen) fixed bin (35);
 62 
 63 /* --------------------- */
 64 
 65           total = 0;
 66           call cu_$arg_ptr (1, ap, al, ec);
 67           if ec ^= 0 then path = ">";
 68           else path = bchr;
 69 
 70 arglp:    call cu_$arg_ptr (an, ap, al, ec);
 71           if ec = 0 then do;
 72                if substr (bchr, 1, 1) = "-" then do;
 73                     if bchr = "-author" | bchr = "-at" then do;
 74                          modsw = "0"b;
 75                     end;
 76                     else do;
 77                          call com_err_ (0, "ckauth", "unknown option ^a", bchr);
 78                          return;
 79                     end;
 80                end;
 81                else do;                                     /* not control arg, must be access name */
 82                     name = bchr;
 83                     if index (name, ".") = 0 then do;
 84                          call com_err_ (0, "ckauth", "no period in access control name ^a", name);
 85                          return;
 86                     end;
 87                end;
 88                an = an + 1;
 89                go to arglp;
 90           end;
 91 
 92 /* Now, go to work. Call disk sweeper program */
 93 
 94           call sweep_disk_ (path, counter);
 95           call ioa_ ("Total ^d", total);
 96 
 97           return;
 98 
 99 counter:  proc (sdn, sen, lvl, een, bptr, nptr);
100 
101 dcl  sdn char (168) aligned,                                /* superior dir name */
102      sen char (32) aligned,                                 /* dirname */
103      lvl fixed bin,                                         /* distance from root */
104      een char (32) aligned,                                 /* entry name */
105      bptr ptr,                                              /* ptr to info structure */
106      nptr ptr;                                              /* ptr to names structure */
107 
108 dcl  xp char (168) aligned,
109      xi fixed bin,
110      hisid char (32) aligned,
111      mode fixed bin (5);
112 
113 dcl 1 branch based (bptr) aligned,                          /* thing returned by star_long */
114     2 type bit (2) unal,
115     2 nname bit (16) unal,
116     2 nindex bit (18) unal,
117     2 dtm bit (36) unal,
118     2 dtu bit (36) unal,
119     2 mode bit (5) unal,
120     2 pad bit (13) unal,
121     2 records bit (18) unal;
122 
123 dcl 1 links based (bptr) aligned,
124     2 type bit (2) unal,                                    /* 00b */
125     2 nname bit (16) unal,
126     2 nindex bit (18) unal,
127     2 dtm bit (36) unal,
128     2 dtd bit (36) unal,
129     2 pln bit (18) unal,
130     2 pnindex bit (18) unal;
131 
132 dcl  names (100) char (32) based (nptr);
133 
134           xi = fixed (branch.type);
135           if xi ^= 1 then return;
136                call ioa_$rsnnl ("^a>^a", xp, xi, sdn, sen);
137                if modsw then call hcs_$get_bc_author (xp, een, hisid, ec);
138                else call hcs_$get_author (xp, een, 0, hisid, ec);
139                if ec ^= 0 then do;
140                     call com_err_ (ec, "ckauth", "^a>^a", xp, een);
141                end;
142                else do;
143                     if name = hisid then do;
144                          total = total + 1;
145                          call ioa_ ("^a>^a", xp, een);
146                     end;
147                end;
148 
149           end counter;
150 
151      end ckauth;