1
2
3
4
5
6
7
8
9
10
11
12
13
14 delentry: proc;
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66 Note
67
68
69
70
71
72
73
74 dcl a_code fixed bin (35) parameter;
75 dcl a_dirname char (*) parameter;
76 dcl a_ename char (*) parameter;
77 dcl a_ep ptr parameter;
78 dcl a_sp ptr parameter;
79 dcl a_trp fixed bin (71) parameter;
80 dcl a_uidpath (0:15) bit (36) aligned parameter;
81
82
83
84 dcl acl_count fixed bin;
85 dcl aclep ptr;
86 dcl areap ptr;
87 dcl asize fixed bin;
88 dcl audit_eventflags bit (36) aligned;
89 dcl code fixed bin (35);
90 dcl damaged bit (1) init ("0"b);
91 dcl dirl bit (1) init ("0"b);
92 dcl dirname char (168);
93 dcl e_sw fixed bin;
94 dcl ename char (32);
95 dcl ignore fixed bin (35);
96 dcl 1 mk_info aligned like makeknown_info;
97 dcl mkunk_uid bit (36) aligned init ("0"b);
98 dcl ncnt fixed bin;
99 dcl nnames fixed bin (18);
100 dcl nrp bit (18) aligned;
101 dcl onp ptr;
102 dcl priv_entry bit (1) init ("0"b);
103 dcl pvid bit (36) aligned;
104 dcl 1 qcell like quota_cell aligned automatic;
105 dcl ring fixed bin;
106 dcl seg_uid bit (36) aligned;
107 dcl segl bit (1) init ("0"b);
108 dcl segno fixed bin;
109 dcl segptr ptr init (null);
110 dcl sp ptr;
111 dcl trp fixed bin (71);
112 dcl type fixed bin;
113 dcl uidpath (0:15) bit (36) aligned;
114 dcl vtocx fixed bin;
115
116
117
118 dcl directory init (2) fixed bin static;
119 dcl link_br init (0) fixed bin static;
120 dcl file init (0) fixed bin static;
121 dcl read_lock bit (36) aligned init ("0"b);
122 dcl retv init (3) fixed bin static;
123 dcl seg init (1) fixed bin static;
124 dcl segment init (1) fixed bin static;
125 dcl uid_mdir init (2) fixed bin static;
126
127
128
129 dcl active_hardcore_data$ensize fixed bin external;
130 dcl active_hardcore_data$esize fixed bin external;
131 dcl error_table_$copy_sw_on fixed bin (35) external;
132 dcl error_table_$dirseg fixed bin (35) external;
133 dcl error_table_$fulldir fixed bin (35) external;
134 dcl error_table_$infcnt_non_zero fixed bin (35) external;
135 dcl error_table_$invalidsegno fixed bin (35) external;
136 dcl error_table_$known_in_other_rings fixed bin (35) external;
137 dcl error_table_$lower_ring fixed bin (35) external;
138 dcl error_table_$master_dir fixed bin (35) external;
139 dcl error_table_$safety_sw_on fixed bin (35) external;
140 dcl error_table_$seg_unknown fixed bin (35) external;
141 dcl error_table_$segknown fixed bin (35) external;
142 dcl error_table_$vtoce_connection_fail fixed bin (35) external; ;
143 dcl pds$access_authorization bit (72) aligned external;
144 dcl pds$process_group_id char (24) ext;
145 dcl pds$processid bit (36) aligned ext;
146
147
148
149 dcl acc_name_$delete entry (ptr);
150 dcl access_audit_check_ep_$self entry (bit (36) aligned, bit (36) aligned, ptr) returns (bit (1));
151 dcl access_audit_$log_entry_ptr entry (char (*), fixed bin, bit (36) aligned, bit (36) aligned, ptr, fixed bin (35), ptr, fixed bin (18), char (*));
152 dcl acl_$del_acl entry (fixed bin, bit (36) aligned, ptr);
153 dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
154 dcl delete_vtoce entry (ptr, fixed bin (35));
155 dcl fs_alloc$free entry (ptr, fixed bin, ptr);
156 dcl hash$out entry (ptr, ptr, ptr, fixed bin (35));
157 dcl level$get entry returns (fixed bin);
158 dcl lock$dir_lock_write entry (ptr, fixed bin (35));
159 dcl lock$dir_unlock entry (ptr);
160 dcl lock$dir_unlock_given_uid entry (bit (36) aligned);
161 dcl makeknown_ entry (ptr, fixed bin, fixed bin, fixed bin (35));
162 dcl makeunknown_ entry (fixed bin, bit (36) aligned, bit (1) aligned, fixed bin (35));
163 dcl mountedp entry (bit (36) aligned) returns (fixed bin (35));
164 dcl pathname_am$clear entry (fixed bin (17));
165 dcl pathname_am$flush entry (bit (36) aligned);
166 dcl sum$dirmod entry (ptr);
167 dcl syserr entry options (variable);
168 dcl syserr$error_code entry options (variable);
169 dcl terminate_$id entry (bit (36) aligned, fixed bin, fixed bin (35));
170 dcl vtoc_attributes$get_quota entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin, fixed bin (35));
171
172
173
174 dcl (addr, fixed, ptr, rel, null, baseptr, unspec) builtin;
175
176 dcl bad_dir_ condition;
177 dcl seg_fault_error condition;
178 %page;
179 salv_delete_branch: entry (a_ep, a_code);
180
181 ep = a_ep;
182 dp = ptr (ep, 0);
183 dirl = "0"b;
184 code = 0;
185 damaged = "1"b;
186 segptr = null;
187 segl = "0"b;
188 if ^entry.bs then type = link_br;
189 else if entry.dirsw then type = directory;
190 else type = segment;
191 go to remove;
192
193 retv: entry (a_dirname, a_ename, a_code);
194
195 e_sw = retv;
196 goto set_code;
197
198
199 priv_dfile: entry (a_dirname, a_ename, a_code);
200 priv_entry = "1"b;
201
202 dfile: entry (a_dirname, a_ename, a_code);
203 e_sw = file;
204
205 set_code: code = 0;
206 dirname = a_dirname;
207 ename = a_ename;
208
209 if e_sw ^= retv & ^priv_entry then call dc_find$obj_delete (dirname, ename, DC_FIND_NO_CHASE, ep, code);
210 else call dc_find$obj_delete_priv (dirname, ename, DC_FIND_NO_CHASE, ep, code);
211 if code ^= 0 then go to ret;
212 go to common;
213
214
215 dseg: entry (a_sp, a_code);
216
217 code = 0;
218 e_sw = seg;
219 sp = a_sp;
220 call dc_find$obj_delete_ptr (sp, ep, code);
221 if code ^= 0 then go to ret;
222 go to common;
223
224 duid_mdir_priv: entry (a_uidpath, a_trp, a_code);
225
226 e_sw = uid_mdir;
227 uidpath = a_uidpath;
228 call dc_find$obj_delete_priv_uid (uidpath, dirname, ename, ep, code);
229 if code ^= 0 then go to ret;
230 priv_entry = "1"b;
231 trp = 0;
232 goto common;
233
234 duid_mdir: entry (a_uidpath, a_trp, a_code);
235
236 e_sw = uid_mdir;
237 uidpath = a_uidpath;
238 call dc_find$obj_delete_uid (uidpath, dirname, ename, ep, code);
239 if code ^= 0 then go to ret;
240 trp = 0;
241
242 common:
243 dp = ptr (ep, 0);
244 dirl = "1"b;
245 if ^ep -> entry.bs then do;
246 type = link_br;
247 go to remove;
248 end;
249 else if ^ep -> entry.dirsw then type = segment;
250 else type = directory;
251
252 if e_sw ^= retv & ^priv_entry then do;
253 ring = level$get ();
254 if (type = segment & ring > fixed (ep -> entry.ring_brackets (1), 3)) |
255 (type ^= segment & ring > fixed (ep -> entry.ex_ring_brackets (1), 3)) then do;
256 code = error_table_$lower_ring;
257 go to finale;
258 end;
259
260 if entry.copysw then do;
261 code = error_table_$copy_sw_on;
262 go to finale;
263 end;
264 if entry.safety_sw then do;
265 code = error_table_$safety_sw_on;
266 go to finale;
267 end;
268 end;
269
270 if type = directory then do;
271 if e_sw = seg then do;
272 code = error_table_$dirseg;
273 go to finale;
274 end;
275 seg_uid = entry.uid;
276 segptr = null;
277 on seg_fault_error begin;
278 damaged = "1"b;
279 goto dir_glop;
280 end;
281 unspec (mk_info) = "0"b;
282 mk_info.uid = seg_uid;
283 mk_info.entryp = ep;
284 mk_info.dirsw = "1"b;
285 mk_info.allow_write = "1"b;
286 mk_info.activate = "1"b;
287 call makeknown_ (addr (mk_info), segno, (0), code);
288 if code = 0 | code = error_table_$segknown then
289 segptr = baseptr (segno);
290 else if code = error_table_$vtoce_connection_fail then damaged = "1"b;
291 else goto finale;
292 call dc_find$finished (dp, "1"b);
293 dirl = "0"b;
294 if damaged then goto dir_glop;
295
296 if segptr -> dir.uid = "0"b then do;
297 call syserr (4, "delentry: deleting damaged dir ^a>^a for ^a",
298 dirname, ename, pds$process_group_id);
299 damaged = "1"b;
300 end;
301 else do;
302 call lock$dir_lock_write (segptr, code);
303 if code ^= 0 then go to finale;
304 segl = "1"b;
305 end;
306 dir_glop: revert seg_fault_error;
307 if e_sw = seg then call dc_find$obj_delete_ptr (sp, ep, code);
308 else if e_sw = retv | priv_entry then call dc_find$obj_delete_priv (dirname, ename, DC_FIND_NO_CHASE, ep, code);
309 else call dc_find$obj_delete (dirname, ename, DC_FIND_NO_CHASE, ep, code);
310 if code ^= 0 then do;
311 if segptr ^= null then do;
312 call lock$dir_unlock (segptr);
313 call makeunknown_ (segno, "0"b, ("0"b), ignore);
314 end;
315 go to ret;
316 end;
317 dp = ptr (ep, 0);
318 dirl = "1"b;
319 if seg_uid ^= entry.uid then do;
320 code = error_table_$invalidsegno;
321 go to finale;
322 end;
323 if ^damaged then do;
324 if segptr -> dir.master_dir then
325 if e_sw ^= uid_mdir & ^priv_entry then do;
326 code = error_table_$master_dir;
327 go to finale;
328 end;
329 if segptr -> dir.seg_count ^= 0
330 | segptr -> dir.dir_count ^= 0
331 | segptr -> dir.lcount ^= 0 then do;
332
333 code = error_table_$fulldir;
334 if ^aim_check_$equal (pds$access_authorization, segptr -> dir.access_class) then
335 if ^addr (pds$access_authorization) -> aim_template.privileges.dir then do;
336 audit_eventflags = "0"b;
337 addr (audit_eventflags) -> audit_event_flags.cc_10_100 = "1"b;
338 if access_audit_check_ep_$self (audit_eventflags, access_operations_$fs_obj_delete, ep) then
339 call access_audit_$log_entry_ptr
340 ("delentry", level$get (), audit_eventflags, access_operations_$fs_obj_delete, ep, code, null, 0, "");
341 end;
342 go to finale;
343 end;
344 if e_sw = uid_mdir then do;
345 pvid = entry.pvid;
346 vtocx = entry.vtocx;
347 qcp = addr (qcell);
348 call vtoc_attributes$get_quota (seg_uid, pvid, vtocx, qcp, 0, code);
349 if code = 0 then trp = quota_cell.trp;
350 end;
351 end;
352 end;
353
354
355
356
357
358 if type ^= link_br then do;
359 if priv_entry | type = directory then code = 0;
360 else code = mountedp (dir.sons_lvid);
361 if code = 0 then do;
362 call delete_vtoce (ep, code);
363 if code ^= 0 then call syserr$error_code (LOG, code, "delentry: failed to delete_vtoce for ^w ^o.", ep -> entry.pvid, ep -> entry.vtocx);
364 end;
365 if code ^= 0 then
366 if ^priv_entry | code = error_table_$infcnt_non_zero then
367 go to finale;
368
369
370
371
372 end;
373
374 remove:
375 dir.modify = pds$processid;
376 nrp = entry.name_brp;
377 areap = ptr (dp, dir.arearp);
378 nnames = fixed (entry.nnames, 18);
379 ncnt = 0;
380
381 name_loop:
382 ncnt = ncnt + 1;
383 if ncnt > nnames then signal bad_dir_;
384 np = ptr (dp, nrp);
385 if np -> names.type ^= NAME_TYPE
386 | np -> names.owner ^= entry.uid
387 | np -> names.entry_rp ^= rel (ep) then signal bad_dir_;
388 call hash$out (dp, addr (np -> names.name), onp, code);
389 if code ^= 0 then call syserr$error_code (4, code, "delentry: error from hash$out on ""^a"" for ^a",
390 np -> names.name, pds$process_group_id);
391
392 if np ^= onp then signal bad_dir_;
393
394 nrp = np -> names.bp;
395 if nrp then do;
396 entry.name_brp = nrp;
397 call fs_alloc$free (areap, active_hardcore_data$ensize, np);
398 go to name_loop;
399 end;
400 entry.name_frp, entry.name_brp = "0"b;
401 entry.nnames = 0;
402
403 if type ^= link_br then do;
404 aclep = addr (entry.acl_frp);
405 acl_count = fixed (entry.acle_count, 18);
406 call acl_$del_acl (acl_count, entry.uid, aclep);
407
408 dir.acle_total =
409 dir.acle_total - acl_count;
410
411 entry.acl_frp, entry.acl_brp = "0"b;
412 entry.acle_count = 0;
413
414 asize = active_hardcore_data$esize;
415
416 call acc_name_$delete (addr (entry.bc_author));
417
418 mkunk_uid = entry.uid;
419 segptr = null;
420 end;
421 else do;
422 ep -> link.pathname_size = 0;
423 asize = ep -> link.size;
424 end;
425
426 call acc_name_$delete (addr (entry.author));
427
428 if entry.ebrp then ptr (ep, entry.ebrp) -> entry.efrp = entry.efrp;
429 if entry.efrp then ptr (ep, entry.efrp) -> entry.ebrp = entry.ebrp;
430 if rel (ep) = dir.entrybrp then dir.entrybrp = entry.ebrp;
431 if rel (ep) = dir.entryfrp then dir.entryfrp = entry.efrp;
432 entry.ebrp, entry.efrp = "0"b;
433 if type = link_br then dir.lcount = dir.lcount - 1;
434 else if type = segment then dir.seg_count = dir.seg_count - 1;
435 else dir.dir_count = dir.dir_count - 1;
436 entry.uid = "0"b;
437 entry.pvid = "0"b;
438 call fs_alloc$free (areap, asize, ep);
439 if type = directory & ^damaged then do;
440 if ^entry.per_process_sw then call pathname_am$flush (mkunk_uid);
441 else call pathname_am$clear (segno);
442 call lock$dir_unlock_given_uid (seg_uid);
443 segl = "0"b;
444 end;
445 if dirl then dir.modify = "0"b;
446 call sum$dirmod (dp);
447
448
449 finale:
450 if segl then call lock$dir_unlock_given_uid (seg_uid);
451 if dirl then do;
452 dir.modify = "0"b;
453 if e_sw ^= seg then call dc_find$finished (dp, "1"b);
454 else call lock$dir_unlock (dp);
455
456 if segptr ^= null then call makeunknown_ (segno, "0"b, ("0"b), ignore);
457 else if mkunk_uid ^= "0"b then do;
458 call terminate_$id (mkunk_uid, 0, code);
459 if code ^= 0 then if code = error_table_$seg_unknown
460 | code = error_table_$invalidsegno
461 | code = error_table_$known_in_other_rings then code = 0;
462 else call syserr$error_code (4, code, "delentry: error from terminate_ for ^a", pds$process_group_id);
463 end;
464 end;
465 if e_sw = uid_mdir then a_trp = trp;
466 ret:
467 a_code = code;
468 return;
469
470
471
472 %page; %include access_audit_eventflags;
473 %page; %include aim_template;
474 %page; %include dc_find_dcls;
475 %page; %include dir_entry;
476 %page; %include dir_header;
477 %page; %include dir_link;
478 %page; %include dir_name;
479 %page; %include fs_obj_access_codes;
480 %page; %include fs_types;
481 %page; %include makeknown_info;
482 %page; %include quota_cell;
483 %page; %include syserr_constants;
484 %page;
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545 end delentry;