1
2
3
4
5
6
7
8
9
10
11
12
13
14 quota: 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 dcl a_code fixed bin (35) parameter;
60 dcl a_dp1 ptr parameter;
61 dcl a_ename char (*) parameter;
62 dcl a_ep ptr parameter;
63 dcl a_ignore fixed bin (17) parameter;
64 dcl a_ltrp fixed bin (71) parameter;
65 dcl a_parent char (*) parameter;
66 dcl a_qchange fixed bin (17) parameter;
67 dcl a_quota fixed bin (18) parameter;
68 dcl a_seg_or_dir bit (1) parameter;
69 dcl a_segptr ptr parameter;
70 dcl a_slvid bit (36) parameter;
71 dcl a_taccsw fixed bin (1) parameter;
72 dcl a_trp fixed bin (35) parameter;
73 dcl a_trpc fixed bin (35) parameter;
74 dcl a_tup bit (36) aligned parameter;
75 dcl a_uchange fixed bin (17) parameter;
76 dcl a_uidpath (0:15) bit (36) aligned parameter;
77 dcl a_used fixed bin (17) parameter;
78
79
80
81 dcl CHECK_ONLY fixed bin (1) init (1) static options (constant);
82 dcl LOTS fixed bin (71) static options (constant) init (11111111111111111111111111111111111b);
83 dcl ROOT_UID bit (36) static options (constant) init ((36)"1"b);
84 dcl SEC_PER_TICK float bin static options (constant) init (.65536e-1);
85
86 dcl called_find bit (1) aligned init ("0"b);
87 dcl check_access bit (1);
88 dcl code fixed bin (35);
89 dcl curtime bit (36) aligned;
90 dcl dep ptr;
91 dcl dir_privilege bit (1);
92 dcl dir_quota_sw bit (1) init ("0"b);
93 dcl dt fixed bin (35);
94 dcl ename char (32);
95 dcl len fixed bin;
96 dcl locked bit (1) aligned init ("0"b);
97 dcl ltrp fixed bin (71);
98 dcl moved_down fixed bin (35);
99 dcl mylock_entry bit (1) aligned;
100 dcl new_entry bit (1) aligned init ("0"b);
101 dcl not_root bit (1) aligned init ("1"b);
102 dcl now_terminal bit (1);
103 dcl parent char (168);
104 dcl parent_astep ptr;
105 dcl parent_dp ptr;
106 dcl parent_pvid bit (36) aligned;
107 dcl 1 parent_qcell like quota_cell aligned;
108 dcl parent_uid bit (36) aligned;
109 dcl parent_vtocx fixed bin;
110 dcl pathname char (168);
111 dcl pvid bit (36) aligned;
112 dcl 1 qcell like quota_cell aligned;
113 dcl qchange fixed bin (18);
114 dcl qt fixed bin (18) init (0);
115 dcl quota fixed bin (18);
116 dcl read_lock bit (36) aligned init ("0"b);
117 dcl segptr ptr;
118 dcl setquota_entry bit (1) init ("0"b);
119 dcl slvid bit (36);
120 dcl sstp pointer;
121 dcl taccsw bit (1) aligned;
122 dcl trp fixed bin (35);
123 dcl tup bit (36) aligned;
124 dcl uchange fixed bin (18);
125 dcl uid bit (36) aligned;
126 dcl uidpath (0:15) bit (36) aligned;
127 dcl unlock_son bit (1);
128 dcl used fixed bin (18);
129 dcl vtocx fixed bin;
130 dcl was_terminal bit (1);
131 dcl write_lock bit (36) aligned init ("1"b);
132
133
134
135 dcl error_table_$ai_restricted fixed bin (35) ext;
136 dcl error_table_$argerr fixed bin (35) ext;
137 dcl error_table_$bad_ring_brackets fixed bin (35) ext;
138 dcl error_table_$invalid_move_qmax fixed bin (35) ext;
139 dcl error_table_$master_dir fixed bin (35) ext;
140 dcl error_table_$mdc_not_mdir fixed bin (35) ext;
141 dcl error_table_$rqover fixed bin (35) ext;
142 dcl pds$access_authorization bit (72) aligned ext static;
143 dcl sst_seg$ external static;
144 dcl sst$root_astep pointer external static;
145
146
147
148 dcl activate entry (ptr, fixed bin (35)) returns (ptr);
149 dcl aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
150 dcl level$get entry returns (fixed bin (17));
151 dcl lock$dir_unlock entry (ptr);
152 dcl lock$unlock_ast entry;
153 dcl quotaw$cu entry (ptr, fixed bin (18), bit (1), fixed bin (1), fixed bin (35));
154 dcl quotaw$mq entry (ptr, ptr, fixed bin (18), bit (1), fixed bin (35));
155 dcl quotaw$sq entry (ptr, fixed bin (18), bit (1), fixed bin (1));
156 dcl sum$getbranch entry (ptr, bit (36) aligned, ptr, fixed bin (35));
157 dcl sum$dirmod entry (ptr);
158 dcl vtoc_attributes$get_quota entry (bit (36) aligned, bit (36) aligned, fixed bin (17), ptr, fixed bin (18), fixed bin (35));
159 dcl vtoc_attributes$set_quota entry (bit (36) aligned, bit (36) aligned, fixed bin (17), ptr, fixed bin (18), fixed bin (35));
160
161
162
163 dcl (addr, bin, bit, clock, fixed, length, min, null, ptr, rtrim, substr, unspec) builtin;
164 %page;
165
166
167
168
169
170
171
172 dqlong_reset: entry (a_parent, a_ltrp, a_code);
173
174 dir_quota_sw = "1"b;
175 qt = 1;
176
177 qlong_reset: entry (a_parent, a_ltrp, a_code);
178
179 ltrp = a_ltrp;
180 go to reset1;
181
182 qreset: entry (a_parent, a_trpc, a_code);
183
184 ltrp = a_trpc;
185 reset1:
186 parent = a_parent;
187
188 code = 0;
189 call dc_find$dir_write_priv (parent, FS_OBJ_TRP_MOD, dp, code);
190 if code ^= 0 then go to errxit;
191 called_find, locked = "1"b;
192
193 call get_quota_cell;
194 qcell.trp = qcell.trp - ltrp;
195 call vtoc_attributes$set_quota (uid, pvid, vtocx, addr (qcell), qt, code);
196 call sum$dirmod (dp);
197 goto done;
198
199
200
201
202
203
204 dqset: entry (a_parent, a_quota, a_code);
205
206 dir_quota_sw = "1"b;
207 qt = 1;
208
209 qset: entry (a_parent, a_quota, a_code);
210
211 setquota_entry = "1"b;
212 taccsw = "1"b;
213 quota = a_quota;
214 parent = a_parent;
215
216 code = 0;
217 call dc_find$dir_write_priv (parent, FS_OBJ_QUOTA_MOD, dp, code);
218 if code ^= 0 then go to errxit;
219 called_find, locked = "1"b;
220
221 call get_quota_cell;
222 go to common;
223
224 dqrestor: entry (a_parent, a_quota, a_ltrp, a_tup, a_ignore, a_taccsw, a_code);
225
226 dir_quota_sw = "1"b;
227 qt = 1;
228
229 qrestor: entry (a_parent, a_quota, a_ltrp, a_tup, a_ignore, a_taccsw, a_code);
230 ltrp = a_ltrp;
231 go to qreload_common;
232
233 qreload: entry (a_parent, a_quota, a_trp, a_tup, a_ignore, a_taccsw, a_code);
234
235 ltrp = a_trp;
236 qreload_common:
237
238 tup = a_tup;
239 taccsw = bit (a_taccsw, 1);
240 quota = a_quota;
241 parent = a_parent;
242
243 code = 0;
244 call dc_find$dir_write_priv (parent, FS_OBJ_QUOTA_RELOAD, dp, code);
245 if code ^= 0 then go to errxit;
246 called_find, locked = "1"b;
247
248 call get_quota_cell;
249 qcell.trp = ltrp;
250 qcell.tup = tup;
251
252 common:
253 sstp = addr (sst_seg$);
254 astep = make_seg_active (dp);
255 if aste.tqsw (qt) = taccsw then
256 aste.quota (qt) = quota;
257 else do;
258 call quotaw$sq (astep, quota, dir_quota_sw, fixed (taccsw, 1));
259
260 if setquota_entry then qcell.tup = bit (bin (clock (), 52), 52);
261 end;
262 qcell.received = qcell.received + quota - qcell.quota;
263 qcell.quota = quota;
264 qcell.terminal_quota_sw = aste.tqsw (qt);
265 if not_root then call lock$unlock_ast;
266
267 call vtoc_attributes$set_quota (uid, pvid, vtocx, addr (qcell), qt, code);
268 if not_root then do;
269 parent_dp = ptr (dep, 0);
270 call lock$dir_unlock (parent_dp);
271 end;
272 call sum$dirmod (dp);
273 goto done;
274
275
276
277
278
279 mdir_set: entry (a_uidpath, a_quota, a_code);
280
281 uidpath = a_uidpath;
282 quota = a_quota;
283
284 call dc_find$mdir_set_quota_uid (uidpath, parent, FS_OBJ_MDIR_QUOTA_MOD, ep, dp, code);
285 if code ^= 0 then go to errxit;
286 locked, called_find = "1"b;
287 parent_dp = ptr (ep, 0);
288
289 if ^entry.master_dir then do;
290 code = error_table_$mdc_not_mdir;
291 go to unlock2;
292 end;
293
294 if level$get () > fixed (entry.ex_ring_brackets (1), 3) then do;
295 code = error_table_$bad_ring_brackets;
296 go to unlock2;
297 end;
298
299 uid = dir.uid;
300 pvid = dir.pvid;
301 vtocx = dir.vtocx;
302 call vtoc_attributes$get_quota (uid, pvid, vtocx, addr (qcell), 0, code);
303 if code ^= 0 then go to unlock2;
304
305 dir_privilege = addr (pds$access_authorization) -> aim_template.privileges.dir;
306 qchange = quota - qcell.quota;
307 if qchange < 0 then
308 if aim_check_$greater (entry.access_class, parent_dp -> dir.access_class) then
309 if ^dir_privilege then do;
310
311 code = error_table_$ai_restricted;
312 go to unlock2;
313 end;
314 else if qcell.quota + qchange <= 0 then do;
315 code = error_table_$invalid_move_qmax;
316 go to unlock2;
317 end;
318 call lock$dir_unlock (parent_dp);
319
320 astep = activate (ep, code);
321 qcell.used = aste.used (0);
322 moved_down = qcell.received - qcell.quota;
323 qcell.received = quota;
324 qcell.quota = quota - moved_down;
325 if qcell.received < qcell.used + moved_down then do;
326 code = error_table_$rqover;
327 call lock$unlock_ast;
328 go to unlock1;
329 end;
330 aste.quota (0) = quota;
331 call lock$unlock_ast;
332
333 call vtoc_attributes$set_quota (uid, pvid, vtocx, addr (qcell), 0, code);
334 call sum$dirmod (dp);
335 go to done;
336
337
338
339
340
341 append_mdir_set: entry (a_ep, a_quota, a_code);
342
343 ep = a_ep;
344 quota = a_quota;
345 uid = entry.uid;
346 pvid = entry.pvid;
347 vtocx = entry.vtocx;
348 unspec (qcell) = "0"b;
349 qcell.received, qcell.quota = quota;
350 qcell.terminal_quota_sw = "1"b;
351 curtime = bit (bin (clock (), 52), 52);
352 qcell.tup = curtime;
353
354 astep = activate (ep, code);
355 aste.quota (0) = quota;
356 aste.tqsw (0) = "1"b;
357 call lock$unlock_ast;
358 call vtoc_attributes$set_quota (uid, pvid, vtocx, addr (qcell), 0, code);
359 a_code = code;
360 return;
361
362
363
364
365
366
367
368 dqread: entry (a_parent, a_quota, a_ltrp, a_tup, a_slvid, a_taccsw, a_used, a_code);
369
370 dir_quota_sw = "1"b;
371 qt = 1;
372 check_access = "1"b;
373 new_entry = "1"b;
374 goto get_common;
375
376 qread: entry (a_parent, a_quota, a_ltrp, a_tup, a_slvid, a_taccsw, a_used, a_code);
377 new_entry = "1"b;
378 check_access = "1"b;
379 goto get_common;
380
381 qget: entry (a_parent, a_quota, a_trp, a_tup, a_slvid, a_taccsw, a_used, a_code);
382
383 check_access = "1"b;
384 goto get_common;
385
386 priv_qread: entry (a_parent, a_quota, a_ltrp, a_tup, a_slvid, a_taccsw, a_used, a_code);
387
388 new_entry = "1"b;
389 check_access = "0"b;
390 goto get_common;
391
392 priv_dqread: entry (a_parent, a_quota, a_ltrp, a_tup, a_slvid, a_taccsw, a_used, a_code);
393
394 new_entry = "1"b;
395 dir_quota_sw = "1"b;
396 qt = 1;
397 check_access = "0"b;
398
399 get_common:
400 quota, trp, ltrp, used = 0;
401 tup = "0"b;
402 taccsw = "0"b;
403 parent = a_parent;
404
405 code = 0;
406 if check_access then call dc_find$dir_read (parent, dp, code);
407 else call dc_find$dir_read_priv (parent, dp, code);
408 if code ^= 0 then go to errxit;
409 called_find, locked = "1"b;
410
411 call get_quota_cell;
412
413 slvid = dir.sons_lvid;
414 sstp = addr (sst_seg$);
415 astep = make_seg_active (dp);
416 qcell.used = aste.used (qt);
417 if not_root then do;
418 parent_dp = ptr (dep, 0);
419 call lock$unlock_ast;
420 call lock$dir_unlock (parent_dp);
421 end;
422 if qcell.terminal_quota_sw then do;
423 curtime = bit (bin (clock (), 52), 52);
424
425 dt = fixed (curtime, 36) - fixed (qcell.tup, 36);
426 qcell.trp = qcell.trp + fixed ((dt * qcell.used) * SEC_PER_TICK + .5e0, 71);
427 qcell.tup = curtime;
428 end;
429 quota = qcell.quota;
430 ltrp = qcell.trp;
431 trp = min (ltrp, LOTS);
432 tup = qcell.tup;
433 used = qcell.used;
434 taccsw = qcell.terminal_quota_sw;
435
436 unlock: call dc_find$finished (dp, "1"b);
437 a_quota = quota;
438 if new_entry then a_ltrp = ltrp;
439 else a_trp = trp;
440 a_tup = tup;
441 a_slvid = slvid;
442 a_taccsw = fixed (taccsw, 1);
443 a_used = used;
444 a_code = code;
445 return;
446
447
448
449
450
451 check: entry (a_ep, a_uchange, a_code);
452
453 ep = a_ep;
454 unlock_son = "0"b;
455 go to join;
456
457 check_file: entry (a_parent, a_ename, a_uchange, a_code);
458
459 parent = a_parent;
460 ename = a_ename;
461 code = 0;
462 unlock_son = "1"b;
463 call dc_find$obj_status_read (parent, ename, DC_FIND_CHASE, ep, code);
464 dp = ptr (ep, 0);
465 if code ^= 0 then go to errxit;
466 called_find = "1"b;
467 go to join;
468
469 check_seg: entry (a_segptr, a_uchange, a_code);
470
471 segptr = a_segptr;
472 code = 0;
473 unlock_son = "1"b;
474 call dc_find$obj_status_read_ptr (segptr, ep, code);
475 if code ^= 0 then go to errxit;
476 dp = ptr (ep, 0);
477
478 join:
479 uchange = a_uchange;
480 dp = ptr (ep, 0);
481
482 sstp = addr (sst_seg$);
483 astep = make_seg_active (dp);
484 call quotaw$cu (astep, uchange, dir_quota_sw, CHECK_ONLY, code);
485 if not_root then do;
486 parent_dp = ptr (dep, 0);
487 call lock$unlock_ast;
488 call lock$dir_unlock (parent_dp);
489 end;
490
491 unlock3: if unlock_son then
492 if called_find then call dc_find$finished (dp, "1"b);
493 else call lock$dir_unlock (dp);
494 a_code = code;
495 return;
496
497
498
499
500
501 dqmove: entry (a_parent, a_ename, a_qchange, a_code);
502
503 dir_quota_sw = "1"b;
504 qt = 1;
505
506 qmove: entry (a_parent, a_ename, a_qchange, a_code);
507
508 code = 0;
509 qchange = a_qchange;
510 parent = a_parent;
511 ename = a_ename;
512 mylock_entry = "0"b;
513
514 len = length (rtrim (parent));
515 if ename ^= "" then do;
516 if len + length (rtrim (ename)) + 1 > length (pathname) then do;
517 bad_path: code = error_table_$argerr;
518 goto errxit;
519 end;
520 if len = 1 then pathname = substr (parent, 1, 1) || ename;
521 else pathname = substr (parent, 1, len) || ">" || ename;
522 end;
523 else do;
524 if len > length (pathname) then goto bad_path;
525 if len = 1 then goto bad_path;
526 pathname = parent;
527 end;
528
529 dir_privilege = addr (pds$access_authorization) -> aim_template.privileges.dir;
530
531
532
533 call dc_find$dir_move_quota (pathname, ep, dp, code);
534 if code ^= 0 then goto errxit;
535 called_find, locked = "1"b;
536 parent_dp = ptr (ep, 0);
537
538 if level$get () > fixed (entry.ex_ring_brackets (1), 3) then do;
539 code = error_table_$bad_ring_brackets;
540 go to unlock2;
541 end;
542
543 uid = dir.uid; pvid = dir.pvid; vtocx = dir.vtocx;
544 call vtoc_attributes$get_quota (uid, pvid, vtocx,
545 addr (qcell), qt, code);
546 if code ^= 0 then go to unlock2;
547 parent_uid = parent_dp -> dir.uid; parent_pvid = parent_dp -> dir.pvid; parent_vtocx = parent_dp -> dir.vtocx;
548 call vtoc_attributes$get_quota (parent_uid, parent_pvid, parent_vtocx,
549 addr (parent_qcell), qt, code);
550 if code ^= 0 then go to unlock2;
551
552 if qcell.terminal_quota_sw then
553 if qcell.received > qcell.quota then
554 if qcell.quota + qchange <= 0 then do;
555 code = error_table_$invalid_move_qmax;
556 go to unlock2;
557 end;
558
559 if qchange < 0 then
560 if aim_check_$greater (entry.access_class, parent_dp -> dir.access_class) then
561 if ^dir_privilege then do;
562
563 code = error_table_$ai_restricted;
564 go to unlock2;
565 end;
566 else if qcell.quota + qchange <= 0 then do;
567 code = error_table_$invalid_move_qmax;
568 go to unlock2;
569 end;
570
571 go to skip_del_entry;
572
573
574
575
576 qmove_mylock: entry (a_ep, a_dp1, a_qchange, a_seg_or_dir, a_code);
577
578 dir_quota_sw = a_seg_or_dir;
579 qt = fixed (dir_quota_sw, 1);
580 mylock_entry = "1"b;
581 ep = a_ep;
582 parent_dp = ptr (ep, 0);
583 dp = a_dp1;
584 qchange = a_qchange;
585
586 uid = dir.uid; pvid = dir.pvid; vtocx = dir.vtocx;
587 call vtoc_attributes$get_quota (uid, pvid, vtocx,
588 addr (qcell), qt, code);
589 if code ^= 0 then go to errxit;
590 parent_uid = parent_dp -> dir.uid; parent_pvid = parent_dp -> dir.pvid; parent_vtocx = parent_dp -> dir.vtocx;
591 call vtoc_attributes$get_quota (parent_uid, parent_pvid, parent_vtocx,
592 addr (parent_qcell), qt, code);
593 if code ^= 0 then go to errxit;
594 if qchange = 0 then
595 qchange = -qcell.quota;
596
597 skip_del_entry:
598 if ^dir_quota_sw & dir.master_dir then do;
599 code = error_table_$master_dir;
600 if mylock_entry then go to errxit;
601 go to unlock2;
602 end;
603 if qchange = 0 then do;
604 code = 0;
605 if mylock_entry then go to errxit;
606 go to unlock2;
607 end;
608
609 if ^parent_qcell.terminal_quota_sw then do;
610 code = error_table_$invalid_move_qmax;
611 if mylock_entry then go to errxit;
612 go to unlock2;
613 end;
614
615
616
617 sstp = addr (sst_seg$);
618 astep = activate (ep, code);
619
620 parent_astep = ptr (sstp, aste.par_astep);
621
622
623
624 qcell.used = aste.used (qt);
625 parent_qcell.used = parent_astep -> aste.used (qt);
626 curtime = bit (bin (clock (), 52), 52);
627
628 dt = fixed (curtime, 36) - fixed (parent_qcell.tup, 36);
629 parent_qcell.trp = parent_qcell.trp + fixed ((dt * parent_qcell.used) * SEC_PER_TICK + .5e0, 71);
630 parent_qcell.tup = curtime;
631 was_terminal = qcell.terminal_quota_sw;
632 if was_terminal then do;
633 dt = fixed (curtime, 36) - fixed (qcell.tup, 36);
634 qcell.trp = qcell.trp + fixed ((dt * qcell.used) * SEC_PER_TICK + .5e0, 71);
635 qcell.tup = curtime;
636 end;
637
638 call quotaw$mq (parent_astep, astep, qchange, dir_quota_sw, code);
639
640 if code ^= 0 then do;
641 call lock$unlock_ast;
642 if mylock_entry then go to errxit;
643 else go to unlock2;
644 end;
645 qcell.quota = aste.quota (qt);
646 parent_qcell.quota = parent_astep -> aste.quota (qt);
647 now_terminal, qcell.terminal_quota_sw = aste.tqsw (qt);
648
649
650
651 if was_terminal ^= now_terminal then do;
652 if was_terminal then do;
653 parent_qcell.trp = parent_qcell.trp + qcell.trp;
654 end;
655 else do;
656 qcell.tup = curtime;
657 end;
658 qcell.trp = 0;
659 end;
660
661 qcell.received = qcell.received + qchange;
662
663 call lock$unlock_ast;
664
665 call vtoc_attributes$set_quota (uid, pvid, vtocx,
666 addr (qcell), qt, code);
667 call vtoc_attributes$set_quota (parent_uid, parent_pvid, parent_vtocx,
668 addr (parent_qcell), qt, code);
669
670 if ^mylock_entry then do;
671 call sum$dirmod (dp);
672 if called_find then call dc_find$finished (dp, "1"b);
673 else call lock$dir_unlock (dp);
674 call lock$dir_unlock (parent_dp);
675 end;
676 a_code = code;
677 return;
678
679
680
681
682
683 unlock2: if not_root then call lock$dir_unlock (parent_dp);
684
685 done:
686 unlock1: if called_find then call dc_find$finished (dp, locked);
687 else call lock$dir_unlock (dp);
688
689 errxit: a_code = code;
690 return;
691
692
693
694
695
696 get_quota_cell: proc;
697
698 uid = dir.uid; pvid = dir.pvid; vtocx = dir.vtocx;
699 call vtoc_attributes$get_quota (uid, pvid, vtocx, addr (qcell), qt, code);
700 if code ^= 0 then go to unlock1;
701
702 end get_quota_cell;
703
704
705
706
707
708 make_seg_active: proc (dpt) returns (ptr);
709
710 dcl dpt ptr parameter;
711
712 dcl ASTep ptr;
713
714 if dpt -> dir.uid = ROOT_UID then do;
715 not_root = "0"b;
716 return (sst$root_astep);
717 end;
718 else do;
719 call sum$getbranch (dpt, read_lock, dep, code);
720 if code ^= 0 then return (null);
721 ASTep = activate (dep, code);
722 end;
723 return (ASTep);
724
725 end make_seg_active;
726 %page; %include aim_template;
727 %page; %include aste;
728 %page; %include dc_find_dcls;
729 %page; %include dir_entry;
730 %page; %include dir_header;
731 %page; %include fs_obj_access_codes;
732 %page; %include quota_cell;
733 end quota;