1 /* **************************************************************
  2    *                                                            *
  3    * Copyright, (C) Massachusetts Institute of Technology, 1983 *
  4    *                                                            *
  5    * Copyright, (C) Honeywell Information Systems Inc., 1983    *
  6    *                                                            *
  7    ************************************************************** */
  8 
  9 
 10 
 11 
 12 /* format: style2,idind30,indcomtxt */
 13 copy_dir:
 14 cpd:
 15      procedure options (variable);
 16 
 17 /*  Move or copy a directory and its subtree.
 18 
 19    Last modified:
 20 
 21    06/02/78  by  LLS for initial implementation
 22    07/06/78  by  LLS to add -update, the entry_type_keys, and fix containment and argument consistency checking.
 23    11/14/80  by  GAT to use copy_dir_.
 24    09/22/81  by  Lindsey Spratt: removed call to status to validate pathnames.
 25    copy_dir_ does this validation and it need not be duplicated
 26    here.
 27    6/29/83 by Jay Pattin to add -fcnt
 28    831002  by BIM to cleanup a bit, audit above, etc.
 29    25/09/84 by B. Braun to initialize copy_dir_options.parent_ac_sw to "0"b;
 30    12/27/84  by Keith Loepere to remove create_branch_info.
 31    830206 by MSharpe to replace -fcnt with -inase/inaee; to accept -fc
 32              as synonym for -force;  to initialize cdo.primary to ""b.
 33 */
 34 /* Entries */
 35 
 36           dcl     check_star_name_$entry        entry (char (*), fixed bin (35));
 37           dcl     com_err_                      entry options (variable);
 38           dcl     com_err_$suppress_name        entry options (variable);
 39           dcl     copy_dir_                     entry (char (*), char (*), char (*), char (*), char (*), ptr,
 40                                                 fixed bin (35));
 41           dcl     cu_$arg_count                 entry (fixed bin, fixed bin (35));
 42           dcl     cu_$arg_ptr                   entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 43           dcl     expand_pathname_              entry (char (*), char (*), char (*), fixed bin (35));
 44           dcl     get_equal_name_               entry (char (*), char (*), char (32), fixed bin (35));
 45           dcl     get_system_free_area_         entry returns (ptr);
 46           dcl     get_wdir_                     entry returns (char (168));
 47           dcl     hcs_$star_                    entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr,
 48                                                 fixed bin (35));
 49 
 50 /**** *  Conditions  */
 51 
 52           dcl     cleanup                       condition;
 53 
 54 /**** *  Based  */
 55 
 56           dcl     arg                           char (arg_len) based (arg_ptr);
 57           dcl     area                          area based (area_ptr);
 58 
 59 /**** *  Automatic  */
 60 
 61           dcl     whoami                        char (8);   /* name of entry into code ("copy_dir" or "move_dir"). */
 62           dcl     code                          fixed bin (35);
 63                                                             /* the returned error code from a system call. */
 64           dcl     (
 65                   all_entries,                              /* all entries are copied */
 66                   all_names,                                /* all names on an entry are copied */
 67                   errors,
 68                   have_source,                              /* pathname of source is known. */
 69                   have_target,                              /* pathname of target is known */
 70                   same_dir,                                 /* se_name and te_name are in the same directory. */
 71                   multiple_sources,                         /* star name input                                */
 72                   move
 73                  )                              bit (1);    /* delete source_dir after copying */
 74           dcl     (
 75                   argno,                                    /* index to count through the argument list. */
 76                   entry_count,                              /* number star matches                            */
 77                   entry_index,
 78                   nargs
 79                   )                             fixed bin;
 80           dcl     arg_len                       fixed bin (21);
 81                                                             /* length of argument pointed to by arg_ptr. */
 82 
 83           dcl     (sd_name, td_name, wd)        char (168);
 84           dcl     (entry_temp, se_name, te_name)
 85                                                 char (32);
 86           dcl     (arg1, arg2)                  char (32) varying;
 87           dcl     (
 88                   area_ptr,                                 /* ptr on which area is based. */
 89                   arg_ptr                                   /* Ptr to arg, set by call to cu_$arg_ptr. */
 90                   )                             ptr;
 91 
 92 /*  External  */
 93 
 94           dcl     (
 95                   error_table_$badopt,
 96                   error_table_$inconsistent,
 97                   error_table_$notadir,
 98                   error_table_$no_s_permission
 99                   )                             fixed bin (35) external;
100 
101 /**** *  Builtins  */
102 
103           dcl     (addr, binary, null, substr, sum)
104                                                 builtin;
105 ^L
106 
107           whoami = "copy_dir";
108           move = "0"b;
109           go to START;
110 
111 move_dir:
112 mvd:
113      entry options (variable);
114 
115           whoami = "move_dir";
116           move = "1"b;
117 
118 /*  true beginning of program */
119 
120 START:
121           star_branch_count, star_link_count = 0;
122           star_select_sw = star_BRANCHES_ONLY;
123           area_ptr = get_system_free_area_ ();
124           star_entry_ptr, star_names_ptr = null ();
125           on condition (cleanup)
126                begin;
127                     if star_names_ptr ^= null ()
128                     then free star_names in (area);
129                     if star_entry_ptr ^= null ()
130                     then free star_entries in (area);
131                end;
132 
133           wd = get_wdir_ ();
134           have_source = "0"b;
135           have_target = "0"b;
136           all_names = "1"b;
137           all_entries = "1"b;
138           errors = "0"b;
139           same_dir = "0"b;
140 
141           cdo.version = copy_dir_options_version_0;
142           cdo.replace = "0"b;
143           cdo.link_translation = "1"b;
144           cdo.primary = "0"b;
145           cdo.acl = "0"b;
146           cdo.force = "0"b;
147           cdo.brief = "0"b;
148           cdo.chase = "0"b;
149           cdo.parent_ac_sw = "0"b;
150           cdo.link = "0"b;
151           cdo.seg = "0"b;
152           cdo.msf = "0"b;
153           cdo.nnlk = "0"b;
154           cdo.update = "0"b;
155           cdo.dir = "0"b;
156           cdo.raw = "0"b;
157           cdo.pad1, cdo.pad2 = "0"b;
158           if move
159           then cdo.delete = "1"b;
160           else cdo.delete = "0"b;
161 
162 
163 /* process arguments */
164 
165           call cu_$arg_count (nargs, code);
166           if code ^= 0
167           then do;
168                     call com_err_ (code, whoami);
169                     return;
170                end;
171           if nargs = 0
172           then do;
173 usage:
174                     call com_err_$suppress_name (0, whoami,
175                          "Usage: ^a source_dir {target_dir} {-entry_type_keys} {-control_args} ", whoami);
176                     goto finish;
177                end;                                         /* get source_dir (sd_name and se_name). */
178 
179 
180           do argno = 1 to nargs;
181                call cu_$arg_ptr (argno, arg_ptr, arg_len, code);
182                if code ^= 0
183                then do;
184                          call com_err_ (code, whoami, "On argument number ^d", argno);
185                          goto finish;
186                     end;
187 
188                if substr (arg, 1, 1) ^= "-"
189                then if ^have_source
190                     then do;
191                               call expand_pathname_ (arg, sd_name, se_name, code);
192                               if code ^= 0
193                               then do;
194 err:
195                                         call com_err_ (code, whoami, "^a", arg);
196                                         goto finish;
197                                    end;
198                               call check_star_name_$entry (se_name, code);
199                               if code = 0
200                               then do;
201                                         entry_count = 1;
202                                         multiple_sources = "0"b;
203                                    end;
204                               else if (code = 1 | code = 2)
205                               then multiple_sources = "1"b;
206                               else do;
207                                         call com_err_ (code, whoami, "Star name check failed on ^a.", se_name);
208                                         goto finish;
209                                    end;
210                               have_source = "1"b;
211                          end;
212 
213 /*  process the rest of the arguments. */
214 
215                     else if ^have_target
216                     then do;
217 
218                               call expand_pathname_ (arg, td_name, entry_temp, code);
219                               if code ^= 0
220                               then do;
221                                         call com_err_ (code, whoami, "^a", arg);
222                                         goto finish;
223                                    end;
224 
225                               have_target = "1"b;
226                          end;
227                     else do;
228                               call com_err_ (error_table_$badopt, whoami,
229                                    "Too many pathnames, a maximum of two is allowed.");
230                               goto finish;
231                          end;                               /* check for the control arguments */
232                else if arg = "-replace" | arg = "-rp"
233                then cdo.replace = "1"b;
234                else if arg = "-update" | arg = "-ud"
235                then cdo.update = "1"b;
236                else if (arg = "-no_link_translation" | arg = "-nlt") & ^move
237                then cdo.link_translation = "0"b;
238                else if arg = "-acl"
239                then cdo.acl = "1"b;
240                else if arg = "-force" | arg = "-fc"
241                then cdo.force = "1"b;
242                else if arg = "-brief" | arg = "-bf"
243                then cdo.brief = "1"b;
244                else if arg = "-chase"
245                then cdo.chase = "1"b;
246                else if arg = "-primary" | arg = "-pri"
247                then cdo.primary = "1"b;
248                else if arg = "-interpret_as_standard_entry" | arg = "-inase"
249                then cdo.raw = "1"b;
250 
251                else if arg = "-interpret_as_extended_entry" | arg = "-inaee"
252                then cdo.raw = "0"b;
253 
254 /* check for entry type keys. */
255 
256                else if arg = "-link" | arg = "-lk"
257                then do;
258                          all_entries = "0"b;
259                          cdo.link = "1"b;
260                     end;
261                else if arg = "-sm" | arg = "-segment"
262                then do;
263                          all_entries = "0"b;
264                          cdo.seg = "1"b;
265                     end;
266                else if arg = "-dr" | arg = "-directory"
267                then do;
268                          all_entries = "0"b;
269                          cdo.dir = "1"b;
270                     end;
271                else if arg = "-branch" | arg = "-br"
272                then do;
273                          all_entries = "0"b;
274                          cdo.seg = "1"b;
275                          cdo.msf = "1"b;
276                          cdo.dir = "1"b;
277                     end;
278                else if arg = "-file" | arg = "-f"
279                then do;
280                          all_entries = "0"b;
281                          cdo.seg = "1"b;
282                          cdo.msf = "1"b;
283                     end;
284                else if arg = "-msf" | arg = "-multisegment_file"
285                then do;
286                          all_entries = "0"b;
287                          cdo.msf = "1"b;
288                     end;
289                else if arg = "-non_null_link" | arg = "-nnlk"
290                then do;
291                          all_entries = "0"b;
292                          cdo.nnlk = "1"b;
293                     end;
294                else do;
295                          call com_err_ (error_table_$badopt, whoami, "^a", arg);
296                          goto finish;
297                     end;
298           end;
299 
300 /* check argument compatibility. */
301 
302           if (cdo.nnlk & cdo.link)
303           then do;
304                     arg1 = "-non_null_link";
305                     arg2 = "-link";
306 incompatarg:
307                     call com_err_ (error_table_$inconsistent, whoami, "Incompatible arguments ^a and ^a", arg1, arg2);
308                     goto finish;
309                end;
310           if (cdo.replace & cdo.update)
311           then do;
312                     arg1 = "-replace";
313                     arg2 = "-update";
314                     goto incompatarg;
315                end;
316           if (cdo.chase & ^(cdo.link | all_entries))
317           then do;
318                     arg1 = "-chase";
319                     arg2 = "not -link";
320                     goto incompatarg;
321                end;
322           if ^have_target
323           then do;
324                     td_name = wd;
325                     entry_temp = "==";
326                end;
327           if all_entries
328           then cdo.link, cdo.seg, cdo.dir, cdo.msf = "1"b;
329 
330 
331 /* if source_dir is a star name, decode it and set up for using
332    multiple source entries.  Otherwise, set up for using  a single
333    source entry. */
334 
335           if multiple_sources
336           then do;
337 
338                     call hcs_$star_ (sd_name, se_name, star_BRANCHES_ONLY, area_ptr, star_entry_count, star_entry_ptr,
339                          star_names_ptr, code);
340                     if code ^= 0
341                     then do;
342                               call com_err_ (code, whoami, "Could not get matching names for ^a^[>^]^a.", sd_name,
343                                    sd_name ^= ">", se_name);
344                               goto finish;
345                          end;
346                     entry_count = star_entry_count;
347                end;
348 
349 /* begin the loop through all of the source entries. */
350 
351           do entry_index = 1 to entry_count;
352                if multiple_sources
353                then if star_entries (entry_index).type = star_DIRECTORY
354                                                             /*  check that arg 1 is a directory. */
355                     then se_name = star_names (star_entries (entry_index).nindex);
356                     else goto NEXT_ENTRY;
357 
358                call get_equal_name_ (se_name, entry_temp, te_name, code);
359                call copy_dir_ (whoami, sd_name, se_name, td_name, te_name, addr (cdo), code);
360 
361 /* errors messages are taken care of by copy_dir_, if -brief was used, the "trivial" errors
362    aren't reported anywhere.
363 */
364 NEXT_ENTRY:
365           end;
366 finish:
367           if star_names_ptr ^= null ()
368           then free star_names in (area);
369           if star_entry_ptr ^= null ()
370           then free star_entries in (area);
371 
372           return;
373 %page;
374 /* Include */
375 
376 %include star_structures;
377 %page;
378 %include query_info_;
379 %page;
380 %include copy_dir_options;
381 
382           declare 1 cdo                         aligned like copy_dir_options;
383 
384      end copy_dir;