1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1974 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 create: cr: proc;
 12 
 13 
 14 /* Command completely re-written on 10/04/74 to add create_dir options for
 15    compatibility with the Access Isolation Mechanism  -- J. C. Whitmore  */
 16 /* Modified 750122 by LJS to use new hcs_$create_branch_ and clean up error handling */
 17 /* Modified 751205 by LJS to use parent access class as default, make dir names starting with "-" invalid */
 18 /* Modified April 1976 by Larry Johnson to create master directories */
 19 /* Fix to reject "" and not print err after "no" to query 04/08/80 S. Herbst */
 20 /* Fixed to reject -foo, create_dir to set 7,7 brackets and accept -rb 06/30/82 S. Herbst */
 21 /* Changed to not create through links 07/28/82 S. Herbst */
 22 /* Fixed -name 12/21/83 S. Herbst */
 23 /* Rewrote again, added -msf and -max_length 01/11/84 S. Herbst */
 24 /* Changed to provide dir_quota for dirs, December 1984, Keith Loepere. */
 25 /* Modified 1985-01-02 by EJ Sharpe to add -account and -owner */
 26 /* Fixed -name to disallow white space or null arg 02/21/85 Steve Herbst */
 27 
 28 
 29 /* Constants */
 30 
 31 dcl  SMA bit (3) unaligned internal static options (constant) init ("111"b);
 32 dcl  RW bit (3) unaligned internal static options (constant) init ("101"b);
 33 
 34 
 35 /* Based */
 36 
 37 dcl arg char (arg_len) based (arg_ptr);
 38 
 39 
 40 /* Automatic */
 41 
 42 dcl dn char (168);
 43 dcl (ctl_arg_name, en, lv_name, type_name, whoami) char (32);
 44 dcl (account, owner) char (32);
 45 
 46 dcl access_class bit (72) aligned;
 47 dcl (create_dir_sw, create_msf_sw) bit (1);
 48 dcl (ac_specified_sw, lv_specified_sw, quota_specified_sw, dir_quota_specified_sw) bit (1);
 49 dcl (acct_specified_sw, owner_specified_sw) bit (1);
 50 
 51 dcl (alp, arg_ptr, fcb_ptr) ptr;
 52 
 53 dcl rb (3) fixed bin;
 54 dcl (arg_count, i) fixed bin;
 55 dcl (quota, dir_quota) fixed bin (18);
 56 dcl (msf_max_length, specified_max_length) fixed bin (19);
 57 dcl arg_len fixed bin (21);
 58 dcl code fixed bin (35);
 59 
 60 
 61 /* External */
 62 
 63 dcl error_table_$action_not_performed fixed bin (35) ext;
 64 dcl error_table_$bad_ring_brackets fixed bin (35) ext;
 65 dcl error_table_$badopt fixed bin (35) ext;
 66 dcl error_table_$invalid_ring_brackets fixed bin (35) ext;
 67 dcl error_table_$namedup fixed bin (35) ext;
 68 dcl error_table_$no_s_permission fixed bin (35) ext;
 69 dcl error_table_$noarg fixed bin (35) ext;
 70 dcl error_table_$noentry fixed bin (35) ext;
 71 dcl error_table_$nostars fixed bin (35) ext;
 72 dcl sys_info$max_seg_size fixed bin(35) ext static;
 73 
 74 
 75 /* Entries */
 76 
 77 dcl check_star_name_$entry entry (char (*), fixed bin (35));
 78 dcl (com_err_, com_err_$suppress_name) entry options (variable);
 79 dcl convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35));
 80 dcl cu_$arg_count entry (fixed bin, fixed bin (35));
 81 dcl cu_$arg_list_ptr entry (ptr);
 82 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
 83 dcl mdc_$create_dirx_acct entry (char (*), char (*), char (*), ptr, char (*), char (*), fixed bin (35));
 84 dcl cu_$level_get entry () returns (fixed bin);
 85 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
 86 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
 87 dcl get_authorization_ entry returns (bit (72) aligned);
 88 dcl get_group_id_$tag_star entry () returns (char (32));
 89 dcl get_wdir_ entry returns (char (168));
 90 dcl hcs_$create_branch_ entry (char (*), char (*), pointer, fixed bin (35));
 91 dcl hcs_$set_max_length entry (char(*), char(*), fixed bin(19), fixed bin(35));
 92 dcl hcs_$status_minf entry (char(*), char(*), fixed bin(1), fixed bin(2), fixed bin(24), fixed bin(35));
 93 dcl ioa_ entry options (variable);
 94 dcl msf_manager_$close entry (ptr);
 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 nd_handler_ entry (char (*), char (*), char (*), fixed bin (35));
 98 dcl pathname_ entry (char (*), char (*)) returns (char (168));
 99 
100 
101 /* Builtins */
102 
103 dcl (addr, mod, null, string, substr, verify) builtin;
104 
105 
106 /* Conditions */
107 
108 dcl cleanup condition;
109 
110 %include create_branch_info;
111 
112 dcl 1 branch_template aligned like create_branch_info;
113 
114 dcl WHITE_SPACE char (4) aligned int static options (constant) init (/* NL HT SP FF */ "
115            ^L");
116 ^L
117           whoami = "create";
118           create_dir_sw = "0"b;
119           go to CHECK_ARGS;
120 
121 
122 
123 create_dir: createdir: cd: entry;
124 
125           whoami = "create_dir";
126           create_dir_sw = "1"b;
127 
128 CHECK_ARGS:
129           access_class = get_authorization_ ();
130 
131           call cu_$arg_count (arg_count, code);
132           if code ^= 0 then do;
133                call com_err_ (code, whoami);
134                return;
135           end;
136           if arg_count = 0 then do;
137 USAGE:         call com_err_$suppress_name (0, whoami, "Usage:  ^a paths {-control_args}", whoami);
138                return;
139           end;
140 
141           call cu_$arg_list_ptr (alp);
142 
143           create_msf_sw = "0"b;
144           ac_specified_sw, lv_specified_sw, quota_specified_sw, dir_quota_specified_sw = "0"b;
145           acct_specified_sw, owner_specified_sw = "0"b;
146           msf_max_length = 0;                               /* can be changed by -max_length */
147           quota, dir_quota = 0;
148 
149           if create_dir_sw then rb (1), rb (2), rb (3) = 7; /* default for dirs */
150           else rb (1), rb (2), rb (3) = cu_$level_get ();   /* for segments */
151           account = "";       /* defaults to user's proccess group id */
152           owner = "";         /* defaults to user's proccess group id */
153 
154 begin;
155 
156 dcl name_sw (arg_count) bit (1) unaligned;
157 dcl path_sw (arg_count) bit (1) unaligned;
158 
159           string (name_sw) = "0"b;
160           string (path_sw) = "0"b;
161 
162           do i = 1 to arg_count;
163 
164                call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
165                if code ^= 0 then do;
166                     call com_err_ (code, whoami);
167                     return;
168                end;
169 
170 /* Control args only for create_dir */
171 
172                if arg = "-access_class" | arg = "-acc" then do;
173                     if ^create_dir_sw then go to BAD_CTL_ARG;
174                     ctl_arg_name = "-access_class";         /* save arg name in case error printed */
175                     i = i + 1;
176                     if i > arg_count then do;
177 MISSING_VALUE:           call com_err_ (0, whoami, "No value specified for ^a", ctl_arg_name);
178                          return;
179                     end;
180                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
181                     call convert_authorization_$from_string (access_class, arg, code);
182                     if code ^= 0 then do;                   /* all errors are fatal */
183                          call com_err_ (code, whoami, arg);
184                          return;
185                     end;
186                     ac_specified_sw = "1"b;
187                end;
188 
189                else if arg = "-logical_volume" | arg = "-lv" then do;
190                     if ^create_dir_sw then go to BAD_CTL_ARG;
191                     ctl_arg_name = "-logical_volume";
192                     i = i + 1;
193                     if i > arg_count then go to MISSING_VALUE;
194                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
195                     lv_specified_sw = "1"b;
196                     lv_name = arg;
197                end;
198 
199                else if arg = "-quota" then do;
200                     if ^create_dir_sw then go to BAD_CTL_ARG;
201                     ctl_arg_name = "-quota";
202                     i = i + 1;
203                     if i > arg_count then go to MISSING_VALUE;
204                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
205                     quota = cv_dec_check_ (arg, code);
206                     if code ^= 0 then do;
207 BAD_VALUE:               call com_err_ (code, whoami, "Cannot convert ^a value ^a", ctl_arg_name, arg);
208                          return;
209                     end;
210                     quota_specified_sw = "1"b;
211                end;
212 
213                else if arg = "-dir_quota" then do;
214                     if ^create_dir_sw then go to BAD_CTL_ARG;
215                     ctl_arg_name = "-dir_quota";
216                     i = i + 1;
217                     if i > arg_count then go to MISSING_VALUE;
218                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
219                     dir_quota = cv_dec_check_ (arg, code);
220                     if code ^= 0 then go to BAD_VALUE;
221                     dir_quota_specified_sw = "1"b;
222                end;
223 
224                else if arg = "-account" | arg = "-acct" then do;
225                     if ^create_dir_sw then go to BAD_CTL_ARG;
226                     ctl_arg_name = "-account";
227                     i = i + 1;
228                     if i > arg_count then go to MISSING_VALUE;
229                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
230                     account = arg;
231                     acct_specified_sw = "1"b;
232                end;
233 
234                else if arg = "-owner" | arg = "-ow" then do;
235                     if ^create_dir_sw then go to BAD_CTL_ARG;
236                     ctl_arg_name = "-owner";
237                     i = i + 1;
238                     if i > arg_count then go to MISSING_VALUE;
239                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
240                     owner = arg;
241                     owner_specified_sw = "1"b;
242                end;
243 
244 /* Control args only for create */
245 
246                else if arg = "-max_length" | arg = "-ml" then do;
247                     if create_dir_sw then go to BAD_CTL_ARG;
248                     ctl_arg_name = "-max_length";
249                     i = i + 1;
250                     if i > arg_count then go to MISSING_VALUE;
251                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
252                     msf_max_length = cv_dec_check_ (arg, code);
253                     if code ^= 0 then go to BAD_VALUE;
254                     if msf_max_length <= 0 then go to BAD_VALUE;
255                end;
256 
257                else if arg = "-multisegment_file" | arg = "-msf" then do;
258                     if create_dir_sw then go to BAD_CTL_ARG;
259                     create_msf_sw = "1"b;
260                end;
261 
262                else if arg = "-segment" | arg = "-sm" then do;
263                     if create_dir_sw then go to BAD_CTL_ARG;
264                     create_msf_sw = "0"b;
265                end;
266 
267 /* Control args for both commands */
268 
269                else if arg = "-name" | arg = "-nm" then do;
270                     ctl_arg_name = "-name";
271                     i = i + 1;
272                     if i > arg_count then go to MISSING_VALUE;
273                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
274                     if verify (arg, WHITE_SPACE) = 0 then do;
275                          call com_err_ (0, whoami, "Invalid name ""^a""", arg);
276                          return;
277                     end;
278                     path_sw (i), name_sw (i) = "1"b;
279                end;
280 
281                else if arg = "-ring_brackets" | arg = "-rb" then do;
282                     ctl_arg_name = "-ring_brackets";
283                     i = i + 1;
284                     if i > arg_count then go to MISSING_VALUE;
285                     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
286                     rb (1) = cv_dec_check_ (arg, code);
287                     if code ^= 0 then go to BAD_VALUE;
288                     if i < arg_count then do;
289                          call cu_$arg_ptr_rel (i + 1, arg_ptr, arg_len, code, alp);
290                          rb (2) = cv_dec_check_ (arg, code);
291                          if code = 0 then do;
292                               i = i + 1;
293                               if i < arg_count & ^create_dir_sw then do;
294                                    call cu_$arg_ptr_rel (i + 1, arg_ptr, arg_len, code, alp);
295                                    rb (3) = cv_dec_check_ (arg, code);
296                                    if code = 0 then i = i + 1;
297                                    else rb (3) = rb (2);
298                               end;
299                               else rb (3) = rb (2);
300                          end;
301                          else rb (2), rb (3) = rb (1);
302                     end;
303                     else rb (2), rb (3) = rb (1);
304                end;
305 
306                else if substr (arg, 1, 1) = "-" then do;
307 BAD_CTL_ARG:        call com_err_ (error_table_$badopt, whoami, arg);
308                     return;
309                end;
310 
311                else do;
312                     if verify (arg, WHITE_SPACE) = 0 then do;  /* blank arg */
313                          call com_err_ (0, whoami, "Invalid name ""^a""", arg);
314                          return;
315                     end;
316                     path_sw (i) = "1"b;
317                end;
318           end;
319 
320           if string (path_sw) = "0"b then go to USAGE;
321 
322           if msf_max_length ^= 0 & ^create_msf_sw then do;
323                call com_err_ (0, whoami, "-max_length can only be specified with -msf.");
324                return;
325           end;
326 
327           if msf_max_length > sys_info$max_seg_size then do;
328                call ioa_ ("^a: Max length ^d greater than limit of ^d; using ^d for max length.",
329                     whoami, msf_max_length, sys_info$max_seg_size, sys_info$max_seg_size);
330                msf_max_length = sys_info$max_seg_size;
331           end;
332           if mod (msf_max_length, 1024) ^= 0 then do;
333                specified_max_length = msf_max_length;
334                msf_max_length = msf_max_length - mod (msf_max_length, 1024) + 1024;
335                call ioa_ ("^a: ^d is not a multiple of 1024; ^d will be used for max length.",
336                     whoami, specified_max_length, msf_max_length);
337           end;
338 
339           if ^quota_specified_sw & (lv_specified_sw | ac_specified_sw) then do; /* special directories need quota */
340                if lv_specified_sw & ac_specified_sw then type_name = "upgraded master";
341                else if lv_specified_sw then type_name = "master";
342                else type_name = "upgraded";
343                call com_err_ (error_table_$noarg, whoami, "-quota needed to create ^a directory.", type_name);
344                return;
345           end;
346 
347           if (acct_specified_sw | owner_specified_sw) & ^lv_specified_sw then do;
348                call com_err_ (error_table_$noarg, whoami,
349                     "^[-account^]^[ and ^]^[-owner^] may only be specified when using -logical_volume to create a master directory.",
350                     acct_specified_sw, (acct_specified_sw & owner_specified_sw), owner_specified_sw);
351                return;
352           end;
353 
354 /* - - - - This is where the real work starts - - - - */
355 
356 /* Fill in structure that gets passed to hcs_$create_branch_ */
357 
358           branch_template.version = create_branch_version_2; /* Fill in version constant defined
359                                                                in include file */
360           branch_template.switches.dir_sw = create_dir_sw;
361           branch_template.switches.copy_sw = "0"b;
362           branch_template.switches.priv_upgrade_sw = "0"b;
363           branch_template.switches.mbz1 = (31)"0"b;
364           if create_dir_sw then branch_template.mode = SMA;
365           else branch_template.mode = RW;
366           branch_template.mbz2 = (33)"0"b;
367           do i = 1 to 3;
368                branch_template.rings (i) = rb (i);
369           end;
370           branch_template.userid = get_group_id_$tag_star ();
371           branch_template.bitcnt = 0;
372           branch_template.quota = quota;
373           branch_template.dir_quota = dir_quota;
374           branch_template.chase_sw = "0"b;
375 
376           do i = 1 to arg_count;
377 
378                if ^path_sw (i) then go to END_LOOP;         /* skip over control args */
379 
380                call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, alp);
381                if code ^= 0 then do;
382                     call com_err_ (code, whoami, "Arg: ^d", i);
383                     return;
384                end;
385 
386                if name_sw (i) then do;
387                     dn = get_wdir_ ();
388                     en = arg;
389                end;
390                else do;
391                     call expand_pathname_ (arg, dn, en, code);
392                     if code ^= 0 then do;
393                          call com_err_ (code, whoami, arg);
394                          go to END_LOOP;
395                     end;
396 
397                     call check_star_name_$entry (en, code);
398                     if code ^= 0 then do;
399                          if code < 3 then code = error_table_$nostars;  /* star convention not allowed */
400                          go to COMPLAIN;
401                     end;
402                end;
403 
404                branch_template.parent_ac_sw = ^ac_specified_sw;
405                branch_template.access_class = access_class;
406 
407 TRY_AGAIN:
408                if lv_specified_sw then
409                     call mdc_$create_dirx_acct (dn, en, lv_name, addr (branch_template), account, owner, code);
410 
411                else if create_msf_sw then code = create_msf ();
412 
413                else call hcs_$create_branch_ (dn, en, addr (branch_template), code);
414 
415                if code ^= 0 then
416                     if code = error_table_$namedup then do;
417 
418                          call nd_handler_ (whoami, dn, en, code);
419                          if code = 0 then go to TRY_AGAIN;  /* user deleted it */
420                          if code > 1 & code ^= error_table_$action_not_performed then
421 COMPLAIN:                     call com_err_ (code, whoami, "^a^[^/^-Specified ring brackets: ^d,^d,^d^]",
422                                    pathname_ (dn, en),
423                                    code = error_table_$bad_ring_brackets | code = error_table_$invalid_ring_brackets,
424                                    rb (1), rb (2), rb (3));
425                          go to END_LOOP;
426                     end;
427                     else go to COMPLAIN;
428 
429 END_LOOP: end;
430 
431 end;  /* begin block */
432 
433           return;
434 %page;
435 create_msf: proc returns (fixed bin (35));
436 
437 /* Creates an MSF with pathname dn>en, returns the status code */
438 
439 dcl code fixed bin (35);
440 
441           call hcs_$status_minf (dn, en, 0, 0, 0, code);
442           if code = 0 | code = error_table_$no_s_permission then return (error_table_$namedup);
443           else if code ^= error_table_$noentry then return (code);
444 
445           fcb_ptr = null;
446 
447           on cleanup begin;
448                if fcb_ptr ^= null then call msf_manager_$close (fcb_ptr);
449           end;
450 
451           call msf_manager_$open (dn, en, fcb_ptr, code);
452           if fcb_ptr = null then return (code);
453 
454           call msf_manager_$msf_get_ptr (fcb_ptr, 0, "1"b, null, 0, code);  /* creates the MSF */
455 
456           call msf_manager_$close (fcb_ptr);
457 
458           if msf_max_length ^= 0 then do;
459                call hcs_$set_max_length (pathname_ (dn, en), "0", msf_max_length, code);
460                if code ^= 0 then
461                     call com_err_ (code, whoami, "Could not set max length of ^a>0", pathname_ (dn, en));
462           end;
463 
464           return (code);
465 
466 end create_msf;
467 
468 
469 end create;