1 /****^  **************************************************************
  2         *                                                            *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                   *
  4         *                                                            *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983    *
  6         *                                                            *
  7         * Copyright, (C) Massachusetts Institute of Technology, 1983 *
  8         *                                                            *
  9         ************************************************************** */
 10 
 11 
 12 
 13 
 14 
 15 
 16 /****^  HISTORY COMMENTS:
 17   1) change(88-09-20,TLNguyen), approve(88-09-20,MCR7976),
 18      audit(88-09-28,Parisek), install(88-09-30,MR12.2-1123):
 19      The rename command will print an appropriate error message when it
 20      finds that
 21         1. The new name of a specified storage system entry is improperly
 22            constructed without specifying the -name control argument.
 23         2. The returned code from XXX_$chname_file is non zero in value,
 24            where XXX can be either installation_tool_, hcs_, or fs_util_
 25                                                    END HISTORY COMMENTS */
 26 
 27 
 28 /* format: style4,ifthenstmt,ifthen,^indcomtxt,^indproc,initcol1,declareind8,dclind4,struclvlind1 */
 29 rename:
 30 rn:
 31      procedure () options (variable);
 32 
 33 /* This module implements the rename, add_name and delete_name commands.
 34 
 35    Usage:
 36    rename {-name} path1 {-name} name1 ... {-name} pathj {-name} namej
 37 
 38    where -name causes the following pathi or namei as a literal name
 39    (for pathi, in the working directory) without applying the star or
 40    equal conventions.
 41 
 42    add_name {-name} path {-name} name1 ... {-name} namej
 43 
 44    delete_name {-name} path1 ... {-name} pathj
 45 
 46    Written by Steve Herbst 12/09/76 */
 47 /* Cleanup handling and control arg processing fixed 10/25/79 S. Herbst */
 48 /* Made to work on mailboxes and queues 03/28/80 S. Herbst */
 49 /* Bug fixes on 06/30/80 by G. Palter */
 50 /* Fixed to not try to add the same name twice to the same seg 12/09/82 S. Herbst */
 51 /* modified for object_type_ convention 1/26/83 Jay Pattin */
 52 /* fixed -name, added l_rename and friends 2/27/83 Jay Pattin */
 53 /* 830924 object_type_ --> fs_util_ BIM */
 54 /* Modified 2/10/84 by C Spitzer. allow $, disallow ? in added or renamed names */
 55 /* Changed to allow -name before all args of all commands 03/27/84 S. Herbst */
 56 /* Modified 1984.08.27 by M. Pandolf to use pathname_ and report pathname when starname doesn't match */
 57 /* 850206 MSharpe to replace -fcnt with -inase/inaee */
 58 /* Fixed cleanup bug causing null ptr fault for "rn a b x.* y.=" 04/05/85 Steve Herbst */
 59 
 60 
 61 dcl 1 entries (ecount) aligned based (eptr),                /* entry info from hcs_$star_ */
 62      2 type bit (2) unaligned,
 63      2 nnames fixed bin (15) unaligned,
 64      2 nindex fixed bin (17) unaligned;
 65 
 66 dcl names (99) char (32) aligned based (nptr);              /* names from hcs_$star_ */
 67 
 68 dcl 1 added_names aligned based (added_names_ptr),
 69      2 (count, bound) fixed bin,
 70      2 array (added_names_bound refer (added_names.bound)),
 71       3 dn char (168),
 72       3 match fixed bin,                                    /* the number of the starname match from hcs_$star_ */
 73       3 name char (32);
 74 
 75 dcl arg char (arg_len) based (arg_ptr);
 76 dcl dn char (168);
 77 dcl (command, en, name) char (32);
 78 
 79 dcl (brief_sw, force_no_type, library_sw, literal_source, literal_target, stars) bit (1);
 80 
 81 dcl area area based (area_ptr);
 82 
 83 dcl area_ptr ptr int static init (null);
 84 dcl (added_names_ptr, eptr, nptr) ptr init (null);
 85 dcl arg_ptr ptr;
 86 
 87 dcl (added_names_bound, arg_count, arg_len, ecount, i, k, match_index) fixed bin;
 88 dcl code fixed bin (35);
 89 
 90 dcl error_table_$bad_equal_name fixed bin (35) ext;
 91 dcl error_table_$bad_file_name fixed bin (35) ext;
 92 dcl error_table_$badopt fixed bin (35) ext;
 93 dcl error_table_$entlong fixed bin (35) ext;
 94 dcl error_table_$namedup fixed bin (35) ext;
 95 dcl error_table_$noarg fixed binary (35) ext;
 96 dcl error_table_$nomatch fixed binary (35) ext;
 97 dcl error_table_$noentry fixed bin (35) ext;
 98 dcl error_table_$nostars fixed bin (35) ext;
 99 dcl error_table_$segnamedup fixed bin (35) ext;
100 
101 dcl check_star_name_$entry entry (char (*), fixed bin (35));
102 dcl (
103     active_fnc_err_,
104     com_err_,
105     com_err_$suppress_name
106     ) entry options (variable);
107 dcl cu_$af_return_arg entry (fixed bin, pointer, fixed bin (21), fixed bin (35));
108 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
109 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
110 dcl get_equal_name_ entry (char (*), char (*), char (32), fixed bin (35));
111 dcl get_system_free_area_ entry returns (ptr);
112 dcl hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35));
113 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
114 dcl installation_tools_$chname_file
115          entry (char (*), char (*), char (*), char (*), fixed bin (35));
116 dcl nd_handler_$switches entry (char (*), char (*), char (*), bit (36) aligned, fixed bin (35));
117 dcl  pathname_ entry (char(*), char(*)) returns(char(168));
118 dcl fs_util_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35));
119 
120 dcl (index, length, null, string) builtin;
121 
122 dcl (cleanup, linkage_error) condition;
123 %page;
124           command = "rename";
125           library_sw = "0"b;
126           goto RENAME_COMMON;
127 
128 l_rename:
129 lrename:
130 lren:
131      entry;
132 
133           library_sw = "1"b;
134           command = "l_rename";
135 
136 RENAME_COMMON:
137           call cu_$af_return_arg (arg_count, (null ()), (0), code);
138           if code = 0 then do;
139 NOT_ACT_FNC:
140                call active_fnc_err_ (0, command, "This command cannot be invoked as an active function.");
141                return;
142           end;
143 
144           if arg_count < 2 then do;
145                call com_err_$suppress_name (0, "rename", "Usage:  ^a path1 name1 ... pathj namej {-control_args}",
146                     command);
147 RETURN:
148                return;
149           end;
150 
151           force_no_type = "0"b;
152           do i = 1 to arg_count;                            /* prescan for bad control arguments */
153                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
154                if index (arg, "-") = 1 then
155                     if (arg = "-name") | (arg = "-nm") then do;
156                          i = i + 1;
157                          if i > arg_count then do;
158 NO_NAME_VALUE:
159                               call com_err_ (error_table_$noarg, command, "Value for -name");
160                               return;
161                          end;
162                     end;
163                     else if ^library_sw & (arg = "-interpret_as_standard_entry" | arg = "-inase")
164                          then force_no_type = "1"b;
165 
166                     else if (arg = "-interpret_as_extended_entry" | arg = "-inaee")
167                          then force_no_type = "0"b;
168 
169                     else do;
170                          call com_err_ (error_table_$badopt, command, """^a""", arg);
171                          return;
172                     end;
173           end;
174 
175           on cleanup call clean_up;
176 
177           call allocate_added_names;
178 
179           do i = 1 by 2 to arg_count;
180 
181 NEXT_ARG:
182                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
183                if arg = "-interpret_as_standard_entry" | arg = "-inase"
184                 | arg = "-interpret_as_extended_entry" | arg = "-inaee"
185                then do;
186                     i = i + 1;
187                     if i > arg_count then return;
188                     goto NEXT_ARG;
189                end;
190                if arg = "-name" | arg = "-nm" then do;
191                     literal_source = "1"b;
192                     i = i + 1;
193                     call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
194                end;
195                else literal_source = "0"b;
196 
197                call get_path;
198 
199                if code ^= 0
200                then if code = error_table_$nomatch
201                     then call com_err_ (code, command, "For ^a.", pathname_ (dn, en));
202                     else call com_err_ (code, command, "^a", arg);
203                else do;
204                     if (i + 1) > arg_count then do;
205                          call com_err_ (error_table_$noarg, command, "New name for ^a.", pathname_ (dn, en));
206                          return;
207                     end;
208                     call cu_$arg_ptr (i + 1, arg_ptr, arg_len, (0));
209 
210                     if arg = "-name" | arg = "-nm" then do;
211                          literal_target = "1"b;
212                          i = i + 1;
213                          call cu_$arg_ptr (i + 1, arg_ptr, arg_len, (0));
214                     end;
215                     else literal_target = "0"b;
216 
217                     call get_name;
218 
219                     if code ^= 0 then call com_err_ (code, command, "^a", arg);
220 
221                     else call change_names (en, name);
222                end;
223 
224                call clean_up_stars ();
225           end;
226 
227           return;
228 %page;
229 add_name:
230 addname:
231 an:
232      entry () options (variable);
233 
234           command = "add_name";
235           library_sw = "0"b;
236           goto ADDNAME_COMMON;
237 
238 l_add_name:
239 laddname:
240 lan:
241      entry;
242 
243           command = "l_add_name";
244           library_sw = "1"b;
245 
246 ADDNAME_COMMON:
247           call cu_$af_return_arg (arg_count, (null ()), (0), code);
248           if code = 0 then go to NOT_ACT_FNC;
249 
250           if arg_count < 2 then do;
251 ADD_NAME_USAGE:
252                call com_err_$suppress_name (0, "", "Usage:  ^a path names {-control_args}", command);
253                return;
254           end;
255 
256           brief_sw, force_no_type = "0"b;
257           do i = 1 to arg_count;                            /* prescan for control arguments */
258                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
259                if index (arg, "-") = 1 then do;
260                     if arg = "-brief" | arg = "-bf" then brief_sw = "1"b;
261                     else if arg = "-long" | arg = "-lg" then brief_sw = "0"b;
262                     else if arg = "-name" | arg = "-nm" then do;
263                          i = i + 1;
264                          if i > arg_count then go to NO_NAME_VALUE;
265                     end;
266                     else if ^library_sw
267                           & (arg = "-interpret_as_standard_entry" | arg = "-inase")
268                          then force_no_type = "1"b;
269                     else if arg = "-interpret_as_extended_entry" | arg = "-inaee"
270                          then force_no_type = "0"b;
271                     else do;
272                          call com_err_ (error_table_$badopt, command, "^a", arg);
273                          return;
274                     end;
275                end;
276           end;
277 
278           do i = 1 to arg_count;
279                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
280                if index (arg, "-") ^= 1 then do;
281                     literal_source = "0"b;
282                     go to FOUND_NAME;
283                end;
284                else if arg = "-name" | arg = "-nm" then do;
285                     literal_source = "1"b;
286                     i = i + 1;
287                     call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
288                     go to FOUND_NAME;
289                end;
290           end;
291           go to ADD_NAME_USAGE;
292 
293 FOUND_NAME:
294           on cleanup call clean_up;
295 
296           call get_path;
297 
298           if code ^= 0 then do;
299                call com_err_ (code, command, "^a", arg);
300                return;
301           end;
302 
303           if i = arg_count then go to ADD_NAME_USAGE;       /* no names to be added */
304 
305           call allocate_added_names;
306 
307           do i = i + 1 to arg_count;
308                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
309                if index (arg, "-") ^= 1 then do;
310                     literal_target = "0"b;
311 ADD_THE_NAME:
312                     call get_name;
313 
314                     if code ^= 0 then call com_err_ (code, command, "^a", arg);
315 
316                     else call change_names ("", name);
317                end;
318                else if arg = "-name" | arg = "-nm" then do;
319                     literal_target = "1"b;
320                     i = i + 1;
321                     call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
322                     go to ADD_THE_NAME;
323                end;
324           end;
325 
326           call clean_up;
327 
328           return;
329 %page;
330 delete_name:
331 deletename:
332 dn:
333      entry () options (variable);
334 
335           command = "delete_name";
336           library_sw = "0"b;
337           goto DELETE_NAME_COMMON;
338 
339 l_delete_name:
340 ldeletename:
341 ldn:
342      entry;
343 
344           command = "l_delete_name";
345           library_sw = "1"b;
346 
347 DELETE_NAME_COMMON:
348           call cu_$af_return_arg (arg_count, (null ()), (0), code);
349           if code = 0 then go to NOT_ACT_FNC;
350 
351           if arg_count = 0 then do;
352                call com_err_$suppress_name (0, "", "Usage:  ^a paths {-control_args}", command);
353                return;
354           end;
355 
356           brief_sw, force_no_type = "0"b;
357 
358           do i = 1 to arg_count;
359                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
360                if index (arg, "-") = 1 then do;
361                     if arg = "-name" | arg = "-nm" then do;
362                          i = i + 1;                         /* skip arg following -name */
363                          if i > arg_count then go to NO_NAME_VALUE;
364                     end;
365                     else if arg = "-brief" | arg = "-bf" then brief_sw = "1"b;
366                     else if arg = "-long" | arg = "-lg" then brief_sw = "0"b;
367                     else if ^library_sw
368                           & (arg = "-interpret_as_standard_entry" | arg = "-inase")
369                          then force_no_type = "1"b;
370                     else if arg = "-interpret_as_extended_entry" | arg = "-inaee"
371                          then force_no_type = "0"b;
372 
373                     else do;
374                          call com_err_ (error_table_$badopt, command, "^a", arg);
375                          return;
376                     end;
377                end;
378           end;
379 
380           on cleanup call clean_up;
381 
382           do i = 1 to arg_count;
383 
384                call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
385 
386                if index (arg, "-") ^= 1 then do;
387                     literal_source = "0"b;
388 DELETE_THE_NAME:
389                     call get_path;
390 
391                     if code ^= 0 then do;
392                          if ^brief_sw | code ^= error_table_$nomatch then
393                               call com_err_ (code, command, "^a", arg);
394                     end;
395 
396                     else call change_names (en, "");
397 
398                     call clean_up_stars ();
399                end;
400                else if arg = "-name" | arg = "-nm" then do;
401                     literal_source = "1"b;
402                     i = i + 1;
403                     call cu_$arg_ptr (i, arg_ptr, arg_len, (0));
404                     go to DELETE_THE_NAME;
405                end;
406           end;
407 
408           return;
409 %page;
410 get_path:
411      procedure ();
412 
413 /* This internal procedure expands a pathname argument and applies the star convention. */
414 
415           code = 0;
416 
417           if index (arg, "-") = 1 & ^literal_source then do;
418                call com_err_ (error_table_$badopt, command, "^a", arg);
419                go to RETURN;
420           end;
421 
422           call expand_pathname_ (arg, dn, en, code);
423           if code ^= 0 then return;
424 
425           if literal_source then do;
426                stars = "0"b;
427                return;
428           end;
429 
430           if en ^= "" then call check_star_name_$entry (en, code);
431           if code = 0 then stars = "0"b;
432           else if code < 3 then do;                         /* star convention */
433                stars = "1"b;
434                if area_ptr = null then area_ptr = get_system_free_area_ ();
435 
436                call hcs_$star_ (dn, en, 3, area_ptr, ecount, eptr, nptr, code);
437           end;
438 
439 end get_path;
440 %page;
441 get_name:
442      procedure ();
443 
444 /* This internal procedure checks for a valid entryname and applies the equal convention. */
445 
446 dcl type fixed bin (2);
447 
448 dcl check_star_name_       entry (char (*), bit (36) aligned, fixed bin (2), fixed bin (35));
449 
450           code = 0;
451           type = 0;
452 
453           if arg_len > length (name) then do;
454                code = error_table_$entlong;
455                return;
456           end;
457 
458           name = arg;
459 
460           if literal_target then return;
461 
462           if index (arg, "-") = 1 then do;
463                call com_err_ (error_table_$badopt, command, "^a", arg);
464                go to RETURN;
465           end;
466 
467           call check_star_name_ (arg, (CHECK_STAR_IGNORE_EQUAL), type, code);
468           if code ^= 0 then do;
469                call com_err_ (code, command, "^a", arg);
470                goto RETURN;
471           end;
472 
473           if type ^= 0 then do;
474                call com_err_ (error_table_$nostars, command, "^a", arg);
475                goto RETURN;
476           end;
477 
478 
479           call get_equal_name_ ("a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a", arg, "", code);
480                                                             /* see if valid equal name */
481           if code ^= error_table_$bad_equal_name then code = 0;       /* might be valid */
482 
483 /* This call tests for syntax errors in the equal name, for example "a.===.b".
484    It is a preliminary test before we know which entry names match the starname en.
485    Therefore, the equal name is applied to a dummy containing the maximum number of
486    components (16) rather than the starname, which can have too few components
487    even though some matching entry names have enough components. */
488 
489 end get_name;
490 %page;
491 change_names:
492      procedure (P_old_name, P_equal_name);
493 
494 /* This internal procedure calls its internal procedure change_name for each starname match. */
495 
496 dcl (P_old_name, P_equal_name) char (*);
497 dcl new_name char (32);
498 
499           if ^stars then call change_name;
500 
501           else do match_index = 1 to ecount;
502 
503                do k = entries (match_index).nindex
504                     to entries (match_index).nindex + entries (match_index).nnames - 1;
505 
506                     en = names (k);
507 
508                     call change_name;
509                end;
510 NEXT_STAR:
511           end;
512 %page;
513 change_name:
514      procedure ();
515 
516 /* This internal procedure performs the name change for all three commands. */
517 
518 dcl i fixed bin;
519 
520           if command = "delete_name" | command = "l_delete_name" then new_name = "";
521           else do;
522                if literal_target then new_name = P_equal_name;  /* if -name given, don't apply equals convention */
523                else do;
524                     call get_equal_name_ (en, P_equal_name, new_name, code);
525                     if code ^= 0 then do;
526                          call com_err_ (code, command, "^a for ^a", P_equal_name, en);
527                          return;
528                     end;
529                end;
530                if stars then do;
531                     do i = added_names.count by -1 to 1
532                          while (dn ^= added_names.dn (i) | match_index ^= added_names.match (i)
533                          | new_name ^= added_names.name (i));
534                     end;
535                     if i > 0 then                           /* already added this name to this segment */
536                          if command = "add_name" | command = "l_add_name" then return;
537                          else new_name = "";                /* rename: just delete the name to rename */
538 
539                     added_names.count = added_names.count + 1;
540                     if added_names.count > added_names.bound then call grow_added_names;
541                     added_names.dn (added_names.count) = dn;
542                     added_names.match (added_names.count) = match_index;
543                     added_names.name (added_names.count) = new_name;
544                end;
545           end;
546 
547 TRY:
548           if library_sw then do;
549                on linkage_error begin;
550                          call com_err_ (0, command, "The user lacks access to installation_tools_.");
551                          goto RETURN;
552                     end;
553 
554                call installation_tools_$chname_file (dn, en, P_old_name, new_name, code);
555                revert linkage_error;
556           end;
557           else if force_no_type then call hcs_$chname_file (dn, en, P_old_name, new_name, code);
558           else call fs_util_$chname_file (dn, en, P_old_name, new_name, code);
559 
560           if code ^= 0 then do;
561                if code = error_table_$namedup then do;
562                     string (nd_handler_options) = ""b;
563                     nd_handler_options.raw = force_no_type;
564                     nd_handler_options.library = library_sw;
565                     call nd_handler_$switches (command, dn, new_name, string (nd_handler_options), code);
566                     if code = 0 then go to TRY;
567                end;
568                else if code = error_table_$segnamedup then
569                     if brief_sw & command = "add_name" then;          /* "an -bf" suppresses this message */
570                     else call com_err_ (code, command, "^a on ^a.", new_name, pathname_ (dn, en));
571                else if code = error_table_$noentry & (command = "delete_name" | command = "l_delete_name") &
572                     brief_sw then return;
573                else if code = error_table_$bad_file_name then
574                     call com_err_ (code, command, "^a", new_name);
575                else do;
576                     call com_err_ (code, command, "^a", pathname_ (dn, en));
577                     if command = "add_name" | command = "l_add_name" then
578                          if stars then go to NEXT_STAR;
579                          else go to RETURN;
580                end;
581           end;
582 
583 end change_name;
584 
585 end change_names;
586 %page;
587 allocate_added_names:
588      proc;
589 
590           area_ptr = get_system_free_area_ ();
591           added_names_bound = 50;
592 
593           allocate added_names in (area) set (added_names_ptr);
594 
595           added_names.count = 0;
596 
597 end allocate_added_names;
598 %page;
599 grow_added_names:
600      proc;
601 
602 dcl old_ptr ptr;
603 dcl i fixed bin;
604 
605           old_ptr = added_names_ptr;
606           added_names_bound = 2 * added_names_bound;
607 
608           allocate added_names in (area) set (added_names_ptr);
609 
610           added_names.count = old_ptr -> added_names.count;
611           do i = 1 to added_names.count;
612                added_names.array (i) = old_ptr -> added_names.array (i);
613           end;
614 
615           free old_ptr -> added_names in (area);
616 
617 end grow_added_names;
618 %page;
619 clean_up:
620      proc;
621 
622           if eptr ^= null then free entries in (area);
623           if nptr ^= null then free names in (area);
624           if added_names_ptr ^= null then free added_names in (area);
625 
626      end clean_up;
627 %page;
628 clean_up_stars:
629      proc;
630 
631           if eptr ^= null then free entries in (area);
632           if nptr ^= null then free names in (area);
633 
634      end clean_up_stars;
635 %page;
636 %include check_star_name;
637 %page;
638 %include nd_handler_options;
639 
640 
641 end rename;