1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */
 13 
 14 quota: proc;
 15 
 16 /* QUOTA - directory control interface for managing quotas.
 17 
 18    Quotas live in the VTOC entry; or in the ASTE when the seg is active.
 19    There are two "quota cells" for each directory: one for pages of segments and one for directory pages.
 20    Each quota cell contains
 21    .      quota
 22    .      used
 23    .      clock
 24    .      time-page product
 25    .      received count (quota + all inferior quotas)
 26    .      inferior quota count
 27 
 28    The current program does not handle directory quota at all.
 29 
 30    Quota cell is protected by the directory lock.
 31    But used can only be satisfactorily protected by the PTL.
 32    So quotaw is called to look at or manipulate used, and he must be called
 33    with the AST locked since his inputs are asteps.
 34 
 35    vtoc_attributes is used to  read and write quota cells in VTOC.
 36    It may be called with or without AST locked */
 37 
 38 /* Last change: */
 39 /* Modified May 1985 by EJ Sharpe to use dc_find$mdir_set_quota_uid and to
 40      enforce AIM restriction on removing quota from upgraded master dirs */
 41 /* Modified January 1985 by Keith Loepere to set tup at append_mdir_set. */
 42 /* Modified November 1984 by Keith Loepere for auditing info. */
 43 /* Modified July 1984 by Keith Loepere to use the new dc_find. */
 44 /* Modified BIM 84-05 for sst reformat. */
 45 /* Modified BIM 83-12-06 to correctly check dir privilege and upgradedness, TR 16411 */
 46 /* Modified BIM 3/82 to only hold read locks when appropriate */
 47 /* Modified 05/05/82 by S. Krupp to change error code invalid_move_quota to
 48    invalid_move_qmax and return ai_not_restricted in case of no privilege */
 49 /* Modified November 1979 by C. Hornig for privileged quota reading */
 50 /* Modified 19 Feb 79 by D. Spector for 18-bit quota values */
 51 /* Modified June 1, 1976 by R. Bratt to call find_$finished */
 52 /* Modified March 1976 by Larry Johnson for master directory quota */
 53 /* Extensive changes for NSS by TVV 6/75 */
 54 /* Modified by Kobziar 10-21-74 to add qmove_mylock entry */
 55 /* Modified by Kobziar July 74 to call new entry in access_mode and to check authorization */
 56 
 57 /* Parameters */
 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 /* Variables */
 80 
 81 dcl  CHECK_ONLY                         fixed bin (1) init (1) static options (constant);
 82 dcl  LOTS                               fixed bin (71) static options (constant) init (11111111111111111111111111111111111b); /* 35 1-bits */
 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); /* Convert fs time to seconds */
 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);/* TRUE only if doing dir quota */
 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); /* default assumption is segs (=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 /* External */
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 /* Entries */
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 /* Misc */
162 
163 dcl  (addr, bin, bit, clock, fixed, length, min, null, ptr, rtrim, substr, unspec) builtin;
164 %page;
165 
166 /* ========================================================== */
167 
168 /* qlong_reset, reset - entries which modify the trp of the directory only */
169 /* these are called by accounting to reduce the trp once a month. */
170 /* qreset is very probably obsolete */
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;                                    /* Copy arguments */
180           go to reset1;
181 
182 qreset: entry (a_parent, a_trpc, a_code);
183 
184           ltrp = a_trpc;                                    /* .. old style */
185 reset1:
186           parent = a_parent;
187 
188           code = 0;                                         /* Clear return code */
189           call dc_find$dir_write_priv (parent, FS_OBJ_TRP_MOD, dp, code); /* get pointer to directory */
190           if code ^= 0 then go to errxit;
191           called_find, locked = "1"b;
192 
193           call get_quota_cell;                              /* read VTOC */
194           qcell.trp = qcell.trp - ltrp;                     /* Perform subtraction */
195           call vtoc_attributes$set_quota (uid, pvid, vtocx, addr (qcell), qt, code);
196           call sum$dirmod (dp);                             /* Make sure dir mod noted */
197           goto done;
198 
199 /* * * * * * * * * * * * * * * * * * * * * * */
200 
201 /* qset, qset_mylock, qreload, qrestor - support for entries which set the quota cell */
202 /* all four are highly-privileged entrypoints */
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;                                    /* Default */
213           quota = a_quota;                                  /* Copy arg */
214           parent = a_parent;                                /* copy into char(168) aligned */
215 
216           code = 0;                                         /* Clear return code */
217           call dc_find$dir_write_priv (parent, FS_OBJ_QUOTA_MOD, dp, code); /* get pointer to directory */
218           if code ^= 0 then go to errxit;
219           called_find, locked = "1"b;
220 
221           call get_quota_cell;                              /* Read VTOCE */
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;                                    /* Privileged entry for SysAdmin */
231           go to qreload_common;                             /* .. and daemon */
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;                                      /* Copy args */
239           taccsw = bit (a_taccsw, 1);
240           quota = a_quota;
241           parent = a_parent;                                /* copy into char(168) aligned */
242 
243           code = 0;                                         /* Clear return code */
244           call dc_find$dir_write_priv (parent, FS_OBJ_QUOTA_RELOAD, dp, code); /* get pointer to directory */
245           if code ^= 0 then go to errxit;
246           called_find, locked = "1"b;
247 
248           call get_quota_cell;                              /* read in quota info */
249           qcell.trp = ltrp;
250           qcell.tup = tup;
251 
252 common:
253           sstp = addr (sst_seg$);                           /* Make segment active */
254           astep = make_seg_active (dp);
255           if aste.tqsw (qt) = taccsw then                   /* if no change to terminal status */
256                aste.quota (qt) = quota;                     /* just change quota in AST entry */
257           else do;                                          /* for non-term quota, used must be subtracted from parent */
258                call quotaw$sq (astep, quota, dir_quota_sw, fixed (taccsw, 1));
259                                                             /* sets quota, adds or subs used from sup accts */
260                if setquota_entry then qcell.tup = bit (bin (clock (), 52), 52); /* on first qset set tup */
261           end;
262           qcell.received = qcell.received + quota - qcell.quota;
263           qcell.quota = quota;                              /* set quota in VTOC */
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;                              /* Unlock parent dir */
269                parent_dp = ptr (dep, 0);
270                call lock$dir_unlock (parent_dp);            /* unlock sup dir */
271           end;
272           call sum$dirmod (dp);                             /* Make sure dir mod noted */
273           goto done;
274 
275 /* * * * * * * * * * * * * * * * * * * * * * */
276 
277 /* mdir_set: entry to set quota on a master directory */
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); /* finds directory */
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;                                    /* setup to read vtoce */
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                               /* If reducing quota */
308                if aim_check_$greater (entry.access_class, parent_dp -> dir.access_class) then /* its an upgraded dir */
309                     if ^dir_privilege then do;              /* If not privileged, forget it. */
310                                                             /* Could publish info if he did this */
311                          code = error_table_$ai_restricted;
312                          go to unlock2;
313                     end;
314                     else if qcell.quota + qchange <= 0 then do; /* if would make it zero, forget it too. */
315                          code = error_table_$invalid_move_qmax;
316                          go to unlock2;
317                     end;
318           call lock$dir_unlock (parent_dp);                 /* done with parent */
319 
320           astep = activate (ep, code);
321           qcell.used = aste.used (0);                       /*  aste is more up to date */
322           moved_down = qcell.received - qcell.quota;        /* quota on lower directorys */
323           qcell.received = quota;
324           qcell.quota = quota - moved_down;
325           if qcell.received < qcell.used + moved_down then do; /* not enough */
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 /* append_mdir_set: special entry called by append to set initial master directory quota */
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;                                  /* set up for vtoc_attributes call */
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;                              /* trp clock starts NOW */
353 
354           astep = activate (ep, code);                      /* must also update aste */
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 /* qread, qget - entries to read the quota information */
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;                       /* zero return variables */
401           tup = "0"b;
402           taccsw = "0"b;
403           parent = a_parent;                                /* copy into char(168) aligned */
404 
405           code = 0;                                         /* Clear return code */
406           if check_access then call dc_find$dir_read (parent, dp, code); /* get pointer to directory */
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;                              /* get quota info */
412 
413           slvid = dir.sons_lvid;                            /* Save sons LVID for later */
414           sstp = addr (sst_seg$);
415           astep = make_seg_active (dp);                     /* To check used, must have active acct */
416           qcell.used = aste.used (qt);                      /* update from ast entry to temp */
417           if not_root then do;                              /* ok, now unlock */
418                parent_dp = ptr (dep, 0);
419                call lock$unlock_ast;
420                call lock$dir_unlock (parent_dp);            /* unlock parent dir */
421           end;
422           if qcell.terminal_quota_sw then do;               /* this is a terminal account, do full update */
423                curtime = bit (bin (clock (), 52), 52);      /* get time as bit string - high order bits */
424                                                             /* calc and add to the time-page product which is in page-secs */
425                dt = fixed (curtime, 36) - fixed (qcell.tup, 36); /* time since last update */
426                qcell.trp = qcell.trp + fixed ((dt * qcell.used) * SEC_PER_TICK + .5e0, 71);
427                qcell.tup = curtime;                         /* .. */
428           end;
429           quota = qcell.quota;                              /* copy info from dir header */
430           ltrp = qcell.trp;                                 /* .. into return args */
431           trp = min (ltrp, LOTS);                           /* return max value if  overflow 35 bits */
432           tup = qcell.tup;
433           used = qcell.used;
434           taccsw = qcell.terminal_quota_sw;
435 
436 unlock:   call dc_find$finished (dp, "1"b);                 /* Unlock directory */
437           a_quota = quota;                                  /* .. and give args back to caller */
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 /* entry called by append to see if can move quota */
450 
451 check: entry (a_ep, a_uchange, a_code);
452 
453           ep = a_ep;                                        /* dir is not locked */
454           unlock_son = "0"b;
455           go to join;
456 
457 check_file: entry (a_parent, a_ename, a_uchange, a_code);   /* Called by fs_move */
458 
459           parent = a_parent;
460           ename = a_ename;
461           code = 0;
462           unlock_son = "1"b;                                /* will lock the dir */
463           call dc_find$obj_status_read (parent, ename, DC_FIND_CHASE, ep, code);
464           dp = ptr (ep, 0);                                 /* Get ptr to parent */
465           if code ^= 0 then go to errxit;                   /* see if find it */
466           called_find = "1"b;
467           go to join;
468 
469 check_seg: entry (a_segptr, a_uchange, a_code);             /* (not used currently) */
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;                              /* What's the change in quota */
480           dp = ptr (ep, 0);                                 /* get pointer to base of directory */
481 
482           sstp = addr (sst_seg$);
483           astep = make_seg_active (dp);                     /* Force active so look at used */
484           call quotaw$cu (astep, uchange, dir_quota_sw, CHECK_ONLY, code); /* checks act acct with ptl set */
485           if not_root then do;
486                parent_dp = ptr (dep, 0);
487                call lock$unlock_ast;
488                call lock$dir_unlock (parent_dp);            /* unlock parent dir */
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 /* This entry moves quota between a dir and its parent */
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;                              /* Copy arg */
510           parent = a_parent;                                /* copy into char(168) aligned */
511           ename = a_ename;                                  /* copy into char(32) aligned */
512           mylock_entry = "0"b;
513 
514           len = length (rtrim (parent));                    /* Get dirname into pathname */
515           if ename ^= "" then do;
516                if len + length (rtrim (ename)) + 1 > length (pathname) then do; /* too long */
517 bad_path:           code = error_table_$argerr;
518                     goto errxit;
519                end;
520                if len = 1 then pathname = substr (parent, 1, 1) || ename; /* dir is then root */
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;               /* don't bother with a single directory (root) */
526                pathname = parent;
527           end;
528 
529           dir_privilege = addr (pds$access_authorization) -> aim_template.privileges.dir;
530 
531 /* this is going to be useful later... */
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);                          /* Locate parent */
537 
538           if level$get () > fixed (entry.ex_ring_brackets (1), 3) then do;
539                code = error_table_$bad_ring_brackets;       /* ringbrackets must be consistent with validation level */
540                go to unlock2;
541           end;
542 
543           uid = dir.uid; pvid = dir.pvid; vtocx = dir.vtocx;/* Copy vars for son */
544           call vtoc_attributes$get_quota (uid, pvid, vtocx, /* .. and read VTOC */
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                   /* if inferior dir has terminal acct */
553                if qcell.received > qcell.quota then         /* and it has inferior quotas */
554                     if qcell.quota + qchange <= 0 then do;  /* and the.change would make it non-terminal */
555                          code = error_table_$invalid_move_qmax; /* don't allow change to be made */
556                          go to unlock2;
557                     end;
558 
559           if qchange < 0 then                               /* If moving quota up */
560                if aim_check_$greater (entry.access_class, parent_dp -> dir.access_class) then /* its an upgraded dir */
561                     if ^dir_privilege then do;              /* If not privileged, forget it. */
562                                                             /* Could publish info if he did this */
563                          code = error_table_$ai_restricted;
564                          go to unlock2;
565                     end;
566                     else if qcell.quota + qchange <= 0 then do; /* if would make non-term, forget it too. */
567                          code = error_table_$invalid_move_qmax;
568                          go to unlock2;
569                     end;
570 
571           go to skip_del_entry;
572 
573 /* This entry is called from inside append, when creating an upgraded directory.
574    Parent and new dir are both locked at this point */
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;                      /* Copy switch */
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;                                       /* are already locked */
584           qchange = a_qchange;
585 
586           uid = dir.uid; pvid = dir.pvid; vtocx = dir.vtocx;/* Copy vars */
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                               /* If quota change arg is zero, */
595                qchange = -qcell.quota;                      /* ..take the whole thing */
596 
597 skip_del_entry:
598           if ^dir_quota_sw & dir.master_dir then do;
599                code = error_table_$master_dir;              /* Apples an oranges */
600                if mylock_entry then go to errxit;
601                go to unlock2;
602           end;
603           if qchange = 0 then do;                           /* If useless call */
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;       /* None to move */
610                code = error_table_$invalid_move_qmax;
611                if mylock_entry then go to errxit;
612                go to unlock2;
613           end;
614 
615 /* get pointers to AST entries for both directories */
616 
617           sstp = addr (sst_seg$);                           /* Get SST */
618           astep = activate (ep, code);                      /* Activate son */
619 
620           parent_astep = ptr (sstp, aste.par_astep);        /* this is active because son is active */
621 
622 /* update trp for both directories, since we may cause a sudden change to used */
623 
624           qcell.used = aste.used (qt);                      /* Copy from AST */
625           parent_qcell.used = parent_astep -> aste.used (qt);
626           curtime = bit (bin (clock (), 52), 52);           /* same as above */
627                                                             /* calc & add the time-page product which is in page-seconds */
628           dt = fixed (curtime, 36) - fixed (parent_qcell.tup, 36); /* time since trp was last updated */
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;           /* indicator if directory currently has terminal quota */
632           if was_terminal then do;                          /* only update son if it is terminal */
633                dt = fixed (curtime, 36) - fixed (qcell.tup, 36); /* time since trp was last updated */
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                                                             /* change quotas and maybe used with ptl locked */
640           if code ^= 0 then do;                             /* one if the quotas didn't cover the used */
641                call lock$unlock_ast;
642                if mylock_entry then go to errxit;           /* don't unlock */
643                else go to unlock2;
644           end;
645           qcell.quota = aste.quota (qt);                    /* change quotas in the VTOCEs */
646           parent_qcell.quota = parent_astep -> aste.quota (qt);
647           now_terminal, qcell.terminal_quota_sw = aste.tqsw (qt); /* terminal status of directory may have changed */
648 
649 /* clean up trps in case terminal status of directory has changed */
650 
651           if was_terminal ^= now_terminal then do;          /* Did status of inferior change? */
652                if was_terminal then do;
653                     parent_qcell.trp = parent_qcell.trp + qcell.trp; /* carry total trp up to parent */
654                end;
655                else do;
656                     qcell.tup = curtime;
657                end;
658                qcell.trp = 0;                               /* just so it doesn't get charged twice */
659           end;
660 
661           qcell.received = qcell.received + qchange;        /* Adjust total quota at this node */
662 
663           call lock$unlock_ast;                             /* Unlock AST */
664 
665           call vtoc_attributes$set_quota (uid, pvid, vtocx, /* Write back */
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;                         /* usually must unlock */
671                call sum$dirmod (dp);                        /* indicate directory and parent modified */
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 /* Error handlers */
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;                                    /* set return error code */
690           return;
691 
692 /* * * * * * * * * * * * * * * * * * * * * * */
693 
694 /* Internal procedure to get directory's quota cell */
695 
696 get_quota_cell: proc;
697 
698           uid = dir.uid; pvid = dir.pvid; vtocx = dir.vtocx;/* Copy vars */
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 /* Internal procedure to make segment be active */
707 
708 make_seg_active: proc (dpt) returns (ptr);                  /* Returns astep */
709 
710 dcl  dpt                                ptr parameter;      /* .. given entry ptr */
711 
712 dcl  ASTep                              ptr;
713 
714           if dpt -> dir.uid = ROOT_UID then do;             /* root's active already */
715                not_root = "0"b;
716                return (sst$root_astep);
717           end;
718           else do;                                          /* no root */
719                call sum$getbranch (dpt, read_lock, dep, code); /* get branch (lock parent) */
720                if code ^= 0 then return (null);
721                ASTep = activate (dep, code);                /* Activate thing */
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;