1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 sweep:
25 procedure options (variable);
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42 dcl path char (168) init (">");
43 dcl dn char (168) init (get_wdir_ ());
44 dcl pdir char (168) init (get_pdir_ ());
45 dcl en char (32) init ("disk_stat");
46 dcl areap ptr;
47 dcl fcbp ptr;
48 dcl (quota, tot_dquota, tot_squota) fixed bin (35) init (0);
49 dcl (used, tot_dused, tot_sused) fixed bin (35) init (0);
50 dcl hpriv bit (1) aligned;
51 dcl ppriv bit (1) aligned;
52 dcl seg_ptr ptr;
53 dcl uid bit (36) aligned;
54 dcl (n, tn) fixed bin;
55 dcl bitc fixed bin (24);
56 dcl an fixed bin;
57 dcl ap ptr;
58 dcl al fixed bin;
59 dcl bchr char (al) based (ap) unaligned;
60 dcl ec fixed bin (35);
61 dcl starting_level fixed bin;
62 dcl (i, j) fixed bin;
63 dcl bfsw bit (1) aligned init ("1"b);
64 dcl pddsw bit (1) aligned init ("0"b);
65 dcl priv_off bit (1) aligned;
66 dcl priv_set fixed bin (35);
67 dcl cpx fixed bin;
68
69 dcl (addr, clock, index, null, rtrim, substr, sum) builtin;
70
71 dcl (cleanup, linkage_error, seg_fault_error) condition;
72
73 %include disk_stat;
74
75 dcl com_err_ entry options (variable);
76 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35));
77 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
78 dcl ioa_ entry options (variable);
79 dcl get_system_free_area_ entry () returns (ptr);
80 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
81 dcl (get_pdir_, get_wdir_) entry () returns (char (168));
82 dcl get_group_id_ entry () returns (char (32));
83 dcl hcs_$get_uid_seg entry (ptr, bit (36) aligned, fixed bin (35));
84 dcl hcs_$quota_read
85 entry (char (*), fixed bin, fixed bin (71), fixed bin (35), bit (36), fixed bin (1), fixed bin, fixed bin (35));
86 dcl hcs_$dir_quota_read
87 entry (char (*), fixed bin, fixed bin (71), fixed bin (35), bit (36), fixed bin (1), fixed bin, fixed bin (35));
88 dcl hphcs_$quota_read
89 entry (char (*), fixed bin, fixed bin (71), fixed bin (35), bit (36), fixed bin (1), fixed bin, fixed bin (35));
90 dcl hphcs_$dir_quota_read
91 entry (char (*), fixed bin, fixed bin (71), fixed bin (35), bit (36), fixed bin (1), fixed bin, fixed bin (35));
92 dcl hphcs_$deactivate entry (bit (36) aligned, fixed bin (35));
93 dcl msf_manager_$close entry (ptr);
94 dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
95 dcl msf_manager_$msf_get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
96 dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35));
97 dcl system_privilege_$dir_priv_on entry (fixed bin (35));
98 dcl system_privilege_$dir_priv_off entry (fixed bin (35));
99 dcl phcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
100 dcl phcs_$terminate_noname entry (ptr, fixed bin (35));
101 dcl hcs_$add_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
102 dcl hcs_$delete_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
103 dcl hcs_$set_bc entry (char (*), char (*), fixed bin (24), fixed bin (35));
104 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
105 dcl hphcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
106
107 dcl (
108 error_table_$badopt,
109 error_table_$noarg
110 ) ext fixed bin (35);
111
112 dcl 1 acla aligned,
113 2 userid char (32),
114 2 mode bit (36),
115 2 rcode fixed bin (35);
116
117 dcl 1 acld aligned,
118 2 userid char (32),
119 2 rcode fixed bin (35);
120 dcl cp_array (0:4) ptr;
121
122 %page;
123 ec = 0;
124 do an = 1 by 1 while (ec = 0);
125 call cu_$arg_ptr (an, ap, al, ec);
126 if ec = 0 then do;
127 if substr (bchr, 1, 1) ^= "-" then do;
128 call absolute_pathname_ (bchr, path, ec);
129 if ec ^= 0 then do;
130 call com_err_ (ec, "sweep", "^a", bchr);
131 return;
132 end;
133 end;
134 else if bchr = "-bf" then bfsw = "1"b;
135 else if bchr = "-brief" then bfsw = "1"b;
136 else if bchr = "-lg" then bfsw = "0"b;
137 else if bchr = "-long" then bfsw = "0"b;
138 else if bchr = "-pdd" then pddsw = "1"b;
139 else if bchr = "-of" | bchr = "-output_file" then do;
140 an = an + 1;
141 call cu_$arg_ptr (an, ap, al, ec);
142 if ec ^= 0 then do;
143 call com_err_ (error_table_$noarg, "sweep", "after ""-output_file""");
144 return;
145 end;
146 call expand_pathname_ (bchr, dn, en, ec);
147 if ec ^= 0 then do;
148 call com_err_ (ec, "sweep", "^a", bchr);
149 return;
150 end;
151 end;
152 else do;
153 call com_err_ (error_table_$badopt, "sweep", "^a", bchr);
154 return;
155 end;
156 end;
157 end;
158
159 priv_off = "1"b;
160 priv_set = 1;
161 hpriv = "0"b;
162 ppriv = "0"b;
163 on cleanup
164 begin;
165 if priv_set = 0 then call system_privilege_$dir_priv_off (priv_set);
166 end;
167
168
169
170 on linkage_error go to revert_handler;
171
172 call system_privilege_$dir_priv_on (priv_set);
173 priv_off = "0"b;
174 revert_handler:
175 revert linkage_error;
176 on linkage_error go to revert1;
177 call hphcs_$star_ (">", "**", 0, null (), 0, null (), null (), 0);
178 hpriv = "1"b;
179 revert1:
180 revert linkage_error;
181
182 on linkage_error goto revert2;
183 call phcs_$initiate (">", "", "", 0, 0, null (), 0);
184 ppriv = "1"b;
185 revert2: revert linkage_error;
186
187 if priv_off then do;
188 if bfsw
189 then call com_err_ (0, "sweep",
190 "Unable to set directory privilege. Access to storage system may not be complete.");
191 priv_set = 1;
192 end;
193
194 cp_array (*), fcbp, sp = null ();
195 cpx = 0;
196 call msf_manager_$open (dn, en, fcbp, ec);
197 if fcbp = null () then do;
198 call com_err_ (ec, "sweep", "");
199 return;
200 end;
201
202 call msf_manager_$get_ptr (fcbp, cpx, "1"b, cp_array (0), 0, ec);
203 if cp_array (0) = null () then do;
204 call com_err_ (ec, "sweep", "^a", en);
205 return;
206 end;
207 if ec ^= 0 then do;
208 call com_err_ (ec, "sweep", "");
209 return;
210 end;
211
212 sp = cp_array (0);
213 n, tn = 0;
214
215 acla.userid = get_group_id_ ();
216 acld.userid = acla.userid;
217 acla.mode = "111"b;
218
219 areap = get_system_free_area_ ();
220
221
222
223
224 i = 2;
225 j = 1;
226 do starting_level = -1 by 1
227 while (j ^= 0);
228 j = index (substr (path, i), ">");
229 if j ^= 0
230 then
231 i = i + j;
232 end;
233
234
235 call process (path, starting_level);
236
237 if cpx > 0 then do;
238 sp = cp_array (0);
239 tn = tn + n;
240 end;
241 else tn = n;
242 disk_stat.dtime = clock ();
243 quota = tot_dquota + tot_squota;
244 used = tot_dused + tot_sused;
245 call ioa_ ("^d/^d", quota, used);
246 call ioa_ ("dir: ^d/^d", tot_dquota, tot_dused);
247 call ioa_ ("seg: ^d/^d", tot_squota, tot_sused);
248 disk_stat.dents = tn;
249 if fcbp ^= null then call msf_manager_$close (fcbp);
250 bitc = 36 * (lodh + tn * lode);
251 call hcs_$set_bc (dn, en, bitc, ec);
252
253 if priv_set = 0 then call system_privilege_$dir_priv_off (priv_set);
254
255
256 return;
257 %page;
258 process:
259 procedure (apth, lvl);
260
261
262
263 dcl apth char (168),
264 lvl fixed bin;
265
266 dcl npth char (168),
267 ddn char (168),
268 een char (32),
269 error_table_$nomatch fixed bin (35) ext,
270 (stpp, dtpp) fixed bin (71),
271 updatime fixed bin (35),
272 (squota, dquota, sused, dused) fixed bin,
273 slvid bit (36),
274 (dquota_sw, squota_sw) fixed bin (1),
275 ifail fixed bin,
276 ecc fixed bin (35),
277 (ii, nix) fixed bin;
278 dcl sys_info$max_seg_size fixed bin (35) ext static;
279
280 star_entry_ptr, star_names_ptr = null ();
281 on cleanup
282 begin;
283 if star_names_ptr ^= null then free star_names;
284 if star_entry_ptr ^= null then free star_entries;
285 if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (acld), 1, ecc);
286 end;
287
288 call expand_pathname_ (apth, ddn, een, ecc);
289 if ecc ^= 0 then do;
290 call com_err_ (ecc, "sweep", "^a", apth);
291 return;
292 end;
293
294 if hpriv
295 then ifail = 2;
296 else do;
297 call hcs_$add_dir_acl_entries (ddn, een, addr (acla), 1, ecc);
298 if ecc ^= 0
299 then ifail = 1;
300 else ifail = 0;
301 end;
302
303 on seg_fault_error goto pexit;
304
305 if hpriv
306 then call hphcs_$dir_quota_read (apth, dquota, dtpp, updatime, slvid, dquota_sw, dused, ecc);
307 else call hcs_$dir_quota_read (apth, dquota, dtpp, updatime, slvid, dquota_sw, dused, ecc);
308 if ecc ^= 0 then goto gq_err;
309
310 if hpriv
311 then call hphcs_$quota_read (apth, squota, stpp, updatime, slvid, squota_sw, sused, ecc);
312 else call hcs_$quota_read (apth, squota, stpp, updatime, slvid, squota_sw, sused, ecc);
313 if ecc ^= 0 then do;
314 gq_err:
315 if ^bfsw then call com_err_ (ecc, "sweep", "getquota on ^a", apth);
316 go to pexit;
317 end;
318
319 if dquota_sw + squota_sw ^= 0 then do;
320
321 tot_dused = tot_dused + dused;
322 tot_sused = tot_sused + sused;
323 tot_dquota = tot_dquota + dquota;
324 tot_squota = tot_squota + squota;
325
326 if (lodh + (n+1) * lode) > sys_info$max_seg_size then do;
327 cpx = cpx + 1;
328 call msf_manager_$msf_get_ptr (fcbp, cpx, "1"b, cp_array (cpx), 0, ec);
329 if ec ^= 0 then do;
330 call com_err_ (ec, "sweep", "Cannot expand MSF for ^a", en);
331 goto pexit;
332 end;
333 sp = cp_array (cpx);
334 tn = tn + n;
335 n = 0;
336 end;
337 n = n + 1;
338 disk_stat.spth (n) = apth;
339 disk_stat.sqta (n) = squota;
340 disk_stat.dqta (n) = dquota;
341
342 if squota = 0 then stpp = 0;
343 if dquota = 0 then dtpp = 0;
344
345 disk_stat.suse (n) = sused;
346 disk_stat.duse (n) = dused;
347 disk_stat.slvid (n) = slvid;
348 disk_stat.stpp (n) = stpp;
349 disk_stat.dtpp (n) = dtpp;
350 disk_stat.slev (n) = lvl;
351
352 if hpriv
353 then call hphcs_$star_ (apth, "**", star_BRANCHES_ONLY, areap, star_entry_count, star_entry_ptr,
354 star_names_ptr, ecc);
355 else call hcs_$star_ (apth, "**", star_BRANCHES_ONLY, areap, star_entry_count, star_entry_ptr,
356 star_names_ptr, ecc);
357 revert seg_fault_error;
358 if ecc = error_table_$nomatch then go to pexit;
359
360 if ecc ^= 0 then do;
361 if ^bfsw then call com_err_ (ecc, "sweep", "star on ^a", apth);
362 go to pexit;
363 end;
364 inloop:
365 do ii = 1 to star_entry_count;
366 if star_entries (ii).type = star_DIRECTORY then do;
367 nix = star_entries (ii).nindex;
368 if apth ^= ">"
369 then npth = rtrim (apth) || ">" || star_names (nix);
370 else do;
371 npth = ">" || star_names (nix);
372 if ^pddsw
373 then
374 if (npth = ">process_dir_dir")
375
376 | (npth = ">pdd") | (substr (npth, 1, 6) = ">pdd.!")
377 then goto nopdir;
378 end;
379 call process (npth, lvl + 1);
380 nopdir:
381 end;
382 end inloop;
383 free star_names;
384 free star_entries;
385 end;
386 pexit:
387 if ppriv & hpriv then
388 call phcs_$initiate (ddn, een, "", 0, 0, seg_ptr, ecc);
389 else seg_ptr = null;
390
391 if (ifail = 0) & (apth ^= pdir) & ^pddsw
392 then
393 call hcs_$delete_dir_acl_entries (ddn, een, addr (acld), 1, ecc);
394
395 if seg_ptr ^= null then do;
396 call hcs_$get_uid_seg (seg_ptr, uid, ecc);
397 if ecc = 0 then call hphcs_$deactivate (uid, ecc);
398 call phcs_$terminate_noname (seg_ptr, ecc);
399 end;
400 ecc = 0;
401 %page;
402 %include star_structures;
403
404 end process;
405 %include access_mode_values;
406 %page;
407
408 end sweep;