1
2
3
4
5
6
7
8
9 copy_deadproc: proc();
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41 %page;
42
43
44 dcl aim_check_$equal entry (bit(72) aligned, bit(72) aligned) returns(bit(1) aligned);
45 dcl check_gate_access_ entry (char(*), ptr, fixed bin(35));
46 dcl com_err_ entry() options(variable);
47 dcl command_query_$yes_no entry() options(variable);
48 dcl copy_pdir_$deadproc entry (char(*), char(*), char(*), char(*), char(*), char(*), bit(1),
49 fixed bin(35));
50 dcl copy_pdir_$delete entry (char(*), char(*), char(*), fixed bin(35));
51 dcl copy_pdir_$liveproc entry (char(*), char(*), char(*), char(*), char(*), char(*), bit(1),
52 char(*), fixed bin(35));
53 dcl cu_$arg_count entry (fixed bin, fixed bin(35));
54 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35));
55 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35));
56 dcl get_authorization_ entry returns (bit (72));
57 dcl get_privileges_ entry() returns(bit(36) aligned);
58 dcl hcs_$get_access_class entry (char(*), char(*), bit(72) aligned, fixed bin(35));
59 dcl hcs_$get_user_effmode entry (char(*), char(*), char(*), fixed bin, fixed bin(5), fixed bin(35));
60 dcl hcs_$set_256K_switch entry (bit(2) aligned, bit(2) aligned, fixed bin(35));
61 dcl hcs_$status_minf entry (char(*), char(*), fixed bin(1), fixed bin(2), fixed bin(24), fixed bin(35));
62 dcl pathname_ entry (char(*), char(*)) returns(char(168));
63 dcl system_privilege_$dir_priv_off entry (fixed bin(35));
64 dcl system_privilege_$dir_priv_on entry (fixed bin(35));
65 dcl system_privilege_$seg_priv_off entry (fixed bin(35));
66 dcl system_privilege_$seg_priv_on entry (fixed bin(35));
67 dcl upd_free_name_$retain_suffix entry (char(*), char(*), char(*), fixed bin(35));
68 dcl upd_free_name_$restore_with_suffix entry (char(*), char(*), char(*), fixed bin(35));
69
70 dcl (
71 error_table_$action_not_performed,
72 error_table_$badopt,
73 error_table_$incorrect_access,
74 error_table_$moderr,
75 error_table_$no_m_permission,
76 error_table_$no_s_permission,
77 error_table_$noarg,
78 error_table_$noentry,
79 error_table_$notadir
80 ) fixed bin(35) ext static;
81
82
83
84 dcl (
85 DEFAULT_DIR char(5) init(">pdd>"),
86 DIR_TYPE fixed bin(2) init(2),
87 FALSE bit (1) init ("0"b),
88 PDIR_PATH char(17) init(">dumps>save_pdirs"),
89 PDIR_SUFFIX char(4) init ("pdir"),
90 TRUE bit (1) init ("1"b)
91 ) int static options(constant);
92 %page;
93
94
95 dcl (addr, before, index, null,
96 rtrim, search, substr) builtin;
97
98
99
100 dcl cleanup condition;
101
102
103
104 dcl arg char (al) based (ap);
105 dcl dir_str char(dir_len) based(dir_ptr);
106 dcl name_str char(name_len) based(name_ptr);
107 dcl 1 privileges like aim_privileges based (addr(priv_string));
108
109
110
111 dcl al fixed bin(21);
112 dcl ap ptr;
113 dcl argno fixed bin;
114 dcl caller_access_class bit(72) aligned;
115 dcl code fixed bin (35);
116 dcl delete_sw bit(1);
117 dcl deadproc bit(1);
118 dcl dir_len fixed bin(21);
119 dcl dir_ptr ptr;
120 dcl dirname char(168);
121 dcl ename char(32);
122 dcl ignore fixed bin(24);
123 dcl ignore_code fixed bin(35);
124 dcl mode fixed bin(5);
125 dcl myname char(13);
126 dcl name_sw bit(1);
127 dcl nargs fixed bin;
128 dcl name_len fixed bin(21);
129 dcl name_ptr ptr;
130 dcl ncd_sw bit(1);
131 dcl need_hphcs bit(1);
132 dcl need_priv bit(1);
133 dcl no_chase fixed bin(1);
134 dcl old_256k_sw bit(2) aligned;
135 dcl owner_sw bit(1);
136 dcl parent_access bit(1);
137 dcl parent_access_class bit (72) aligned;
138 dcl person_proj char(32);
139 dcl pdir_access_class bit (72) aligned;
140 dcl pdir_path char(168);
141 dcl pdir_to_create char(32);
142 dcl priv_string bit(36) aligned;
143 dcl privileges_are_set bit(1);
144 dcl restore_names bit(1);
145 dcl target_dir char(168);
146 dcl target_dirname char(168);
147 dcl target_parent char(168);
148 dcl tdirname char(168);
149 dcl tename char(32);
150 dcl type fixed bin(2);
151 dcl yes_sw bit(1);
152 %page;
153 deadproc = TRUE;
154 myname = "copy_deadproc";
155 go to COMMON;
156
157 copy_liveproc:
158 entry;
159
160 deadproc = FALSE;
161 myname = "copy_liveproc";
162 go to COMMON;
163
164 COMMON:
165 delete_sw, name_sw, ncd_sw, old_256k_sw, owner_sw,
166 need_hphcs, need_priv, restore_names,
167 parent_access, privileges_are_set = FALSE;
168 target_dir = PDIR_PATH;
169 name_ptr, dir_ptr = null();
170 code = 0;
171 no_chase = 0;
172
173 on cleanup begin;
174 call clean_up();
175 end;
176
177 call cu_$arg_count(nargs, code);
178 if code ^= 0 then do;
179 call com_err_(code,myname);
180 goto EXIT;
181 end;
182
183 if nargs = 0 then
184 if deadproc then
185 call argument_error (error_table_$noarg,
186 "^/A process directory name must be provided.^/^a",
187 "Usage: copy_deadproc {deadproc_name} {-ctl_args}", "");
188 else
189 call argument_error (error_table_$noarg,
190 "^/A process directory name and user name must be provided.^/^a",
191 "Usage: copy_liveproc {live_pdir_name} {user_name} {-ctl_args}", "");
192 %page;
193 do argno = 1 to nargs;
194 call cu_$arg_ptr(argno, ap, al, (0));
195
196 if deadproc & (arg = "-delete" | arg = "-dl") then delete_sw = TRUE;
197 else if deadproc & (arg = "-no_delete" | arg = "-ndl") then
198 delete_sw = FALSE;
199 else if deadproc & (arg = "-no_copy_delete" | arg = "-ncd") then
200 ncd_sw = TRUE;
201 else if arg = "-owner" | arg = "-ow" then owner_sw = TRUE;
202 else if ^deadproc & (arg = "-directory" | arg = "-dir" | arg = "-dr") then do;
203 if dir_ptr ^= null then
204 call argument_error (0,
205 "More than one directory was specified. ^a, ^a", dir_str, arg);
206 call get_next_arg ("directory name", dir_ptr, dir_len);
207 end;
208 else if arg = "-name" | arg = "-nm" then do;
209 if name_ptr ^= null() then
210 call argument_error (0, "More than one name is specified. ^a, ^a",
211 name_str, arg);
212 if deadproc then
213 call get_next_arg ("deadproc name", name_ptr, name_len);
214 else
215 call get_next_arg ("user name", name_ptr, name_len);
216 end;
217 else if substr(arg, 1, 1) ^= "-" then do;
218 if ^deadproc & dir_ptr = null then do;
219 dir_len = al;
220 dir_ptr = ap;
221 end;
222 else if name_ptr = null() then do;
223 name_len = al;
224 name_ptr = ap;
225 end;
226 else call argument_error (0,
227 "More than one name is specified. ^a, ^a", name_str, arg);
228 end;
229 else call argument_error(error_table_$badopt, " ^a",arg, "");
230 end;
231
232 if deadproc then do;
233 if name_ptr = null() then
234 call argument_error(error_table_$noarg, "A deadproc name must be specified.", "", "");
235
236 if search(name_str, "<>") = 0 then
237 pdir_path = DEFAULT_DIR || name_str;
238 else pdir_path = name_str;
239 end;
240 else do;
241 if dir_ptr = null() then
242 call argument_error(error_table_$noarg, "A liveproc directory name must be specified.", "", "");
243 if name_ptr = null() then
244 call argument_error(error_table_$noarg, "A user name must be specified.", "", "");
245 if search(dir_str, "<>") = 0 then
246 pdir_path = DEFAULT_DIR || dir_str;
247 else pdir_path = dir_str;
248 end;
249 %page;
250
251 call check_gate_access_ ("phcs_", null(), code);
252 if code ^= 0 then do;
253 if code = error_table_$noentry then call report_error(code, "Checking access to the phcs_ gate.", "", "");
254 else if code = error_table_$moderr then call report_error(code,
255 "Execute access is required on the phcs_ gate.", "", "");
256 end;
257
258
259
260 call expand_pathname_ (pdir_path, dirname, ename, code);
261 if code ^= 0 then call report_error(code, "^a", pathname_(dirname, ename), "");
262
263
264 call hcs_$get_access_class (dirname, ename, pdir_access_class, code);
265 if code ^= 0 then call report_error(code, "^a", pathname_(dirname, ename), "");
266
267 caller_access_class = get_authorization_ ();
268
269 if aim_check_$equal (caller_access_class, pdir_access_class) then;
270 else do;
271 if ^(privileges_are_set) then call set_privileges(code);
272 if code ^= 0 then do;
273 if code = error_table_$noentry then
274 call report_error(code, "Checking access to the system_privilege_ gate.", "", "");
275 else if code = error_table_$moderr then
276 call report_error(code, "Execute access is required on the system_privilege_ gate.", "", "");
277 else call report_error(code, "^a", pathname_(dirname, ename), "");
278 end;
279 parent_access = TRUE;
280 end;
281
282
283
284
285 if owner_sw then do;
286 call expand_pathname_ (target_dir, target_dirname, target_parent, code);
287 if code ^= 0 then call report_error(code, "^a", pathname_(target_dirname, target_parent), "");
288
289 call hcs_$get_access_class (target_dirname, target_parent, parent_access_class, code);
290 if code ^= 0 then call report_error(code, "^a", pathname_(target_dirname, target_parent), "");
291
292 if pdir_access_class ^= parent_access_class then call report_error (error_table_$action_not_performed,
293 "^/When -owner is used, the access class of pdir ^a must equal the access class of the target directory ^a.",
294 pathname_(dirname, ename), pathname_(target_dirname, target_parent));
295 end;
296
297 call hcs_$status_minf (dirname, ename, no_chase, type, ignore, code);
298 if code ^= 0 then call report_error(code, "^a", pathname_(dirname, ename), "");
299 if type ^= DIR_TYPE then call report_error(error_table_$notadir, "^a", pathname_(dirname, ename), "");
300
301
302
303 call hcs_$get_user_effmode (dirname, ename, "", -1, mode, code);
304 if code ^= 0 then call report_error(code, "^a", pathname_(dirname, ename), "");
305 if mode ^= SMA_ACCESS_BIN & mode ^= SM_ACCESS_BIN then call report_error(error_table_$moderr,
306 "SM access is required on ^a", pathname_(dirname, ename), "");
307 %page;
308 if delete_sw | ncd_sw then do;
309
310
311 call expand_pathname_ (dirname, tdirname, tename, code);
312 if code ^= 0 then call report_error(code, "^a", dirname, "");
313
314 call hcs_$get_user_effmode (tdirname, tename, "", -1, mode, code);
315 if code ^= 0 then call report_error(code, "^a", dirname, "");
316
317 if mode ^= SMA_ACCESS_BIN & mode ^= SM_ACCESS_BIN then do;
318
319 if mode = S_ACCESS_BIN then code = error_table_$no_m_permission;
320 else if mode = M_ACCESS_BIN then code = error_table_$no_s_permission;
321 else code = error_table_$incorrect_access;
322
323 if ncd_sw then
324 call report_error (error_table_$incorrect_access,
325 "Modify access is needed on containing dir ^a to delete ^a.",
326 dirname, pathname_(dirname, ename));
327
328 if delete_sw then call command_query_$yes_no (yes_sw, code, myname,
329 "In order to delete the pdir ^a, Modify access is needed on the containing dir ^a. If you continue, the pdir will be copied but not deleted.",
330 "The directory ^a can be copied but not deleted. Do you wish to continue?",
331 pathname_(dirname, ename), dirname);
332 if ^(yes_sw) then
333 call report_error(error_table_$action_not_performed,
334 "Copying ^a.", ename, "");
335 delete_sw = FALSE;
336 end;
337 end;
338
339 if deadproc
340 then call construct_names_from_pdir (ename, pdir_to_create, person_proj);
341 else do;
342 pdir_to_create = rtrim(name_str) || "." || PDIR_SUFFIX;
343 person_proj = name_str;
344 end;
345
346 if ^ncd_sw then do;
347 need_hphcs = determine_hphcs_need(dirname, ename, person_proj);
348 if need_hphcs then do;
349
350 call check_gate_access_ ("hphcs_", null(), code);
351 if code ^= 0 then do;
352 if code = error_table_$noentry then
353 call report_error(code, "Checking access to the hphcs_ gate.",
354 "", "");
355 else if code = error_table_$moderr then
356 call report_error(code,
357 "Execute access is required on the hphcs_ gate.", "", "");
358 end;
359 end;
360 %page;
361 if ^deadproc & owner_sw then;
362 else if owner_sw then do;
363 if (person_proj = ename) then
364 call report_error(error_table_$action_not_performed,
365 "Cannot construct person.project from name given ^a.", ename, "");
366 end;
367 else person_proj = "";
368
369
370
371
372
373 call hcs_$status_minf (target_dir, pdir_to_create, no_chase, type, ignore,
374 code);
375 if code = 0 then do;
376 restore_names = TRUE;
377 call upd_free_name_$retain_suffix (target_dir, pdir_to_create,
378 "pdir", code);
379 if code ^= 0 then
380 call report_error(code, "While renaming the pdir directory ^a",
381 pathname_(target_dir, pdir_to_create), "");
382 end;
383
384
385
386 call hcs_$set_256K_switch ( "11"b, old_256k_sw, code);
387 if code ^= 0 then call com_err_(myname, code, "Warning, unable to set the 256K switch...continuing copying.");
388
389 if deadproc
390 then call copy_pdir_$deadproc (myname, dirname, ename, target_dir, pdir_to_create, person_proj, need_hphcs, code);
391 else call copy_pdir_$liveproc (myname, dirname, ename, target_dir, pdir_to_create, person_proj, need_hphcs,
392 before(name_str,"."), code);
393 if code ^= 0 then call report_error(code, "While copying ^a to ^a.",
394 pathname_(dirname, ename), pathname_(target_dir, pdir_to_create));
395
396 restore_names = FALSE;
397 end;
398
399 if delete_sw | ncd_sw then do;
400 call copy_pdir_$delete (myname, dirname, ename, code);
401 if code ^= 0 then
402 call report_error(code, "Deleting ^a.", pathname_(dirname, ename),
403 "");
404 end;
405
406 END_COPY:
407 call clean_up();
408
409 EXIT:
410 return;
411 %page;
412
413
414
415
416
417
418
419 argument_error: proc(ecode, message, str1, str2);
420
421 dcl ecode fixed bin(35),
422 (message, str1, str2) char(*);
423
424 call com_err_(ecode, myname, message, str1, str2);
425 goto EXIT;
426
427 end argument_error;
428
429
430 %page;
431
432
433
434 clean_up: proc();
435
436 dcl code fixed bin(35);
437
438 code = 0;
439 if restore_names then
440 call upd_free_name_$restore_with_suffix (target_dir, pdir_to_create,
441 "pdir", ignore_code);
442 restore_names = FALSE;
443 if privileges_are_set then do;
444 if ^(privileges.dir) then call system_privilege_$dir_priv_off (ignore_code);
445 if ^(privileges.seg) then call system_privilege_$seg_priv_off (ignore_code);
446 end;
447 call hcs_$set_256K_switch (old_256k_sw, (""b), ignore_code);
448
449 end clean_up;
450
451
452 %page;
453
454
455
456
457
458
459
460 construct_names_from_pdir: proc (old_name, new_name, acl_name);
461
462 dcl acl_name char(*);
463 dcl new_name char(*);
464 dcl old_name char(*);
465
466 dcl temp_name char(32) var;
467 dcl temp_idx fixed bin;
468
469
470
471 acl_name, new_name = "";
472 temp_name = rtrim(old_name);
473
474 temp_idx = index(old_name, ".");
475 if temp_idx ^= 0 then new_name = substr(temp_name, 1, temp_idx-1);
476 else
477 new_name = old_name;
478
479 new_name = rtrim(new_name) || "." || PDIR_SUFFIX;
480
481
482
483 temp_idx = index(temp_name, ".f.");
484 if temp_idx ^= 0 then acl_name = substr(temp_name, 1, temp_idx-1);
485 else
486 acl_name = old_name;
487
488 end construct_names_from_pdir;
489
490
491 %page;
492
493
494
495 determine_hphcs_need: proc(dirname, ename, person_proj) returns(bit(1));
496
497 dcl dirname char(168);
498 dcl ename char(32);
499 dcl person_proj char(32);
500
501 dcl code fixed bin(35);
502 dcl userid char(32);
503 dcl get_group_id_ entry() returns(char(32));
504 dcl get_group_id_$tag_star entry() returns(char(32));
505
506 userid = get_group_id_$tag_star();
507 if person_proj = substr(userid, 1, index(userid, ".*")-1)
508 then return("0"b);
509 else do;
510 call hcs_$get_user_effmode (dirname, ename, get_group_id_(),
511 -1, mode, code);
512 if code ^= 0 then call report_error(code, "^a", dirname, "");
513 if mode = SMA_ACCESS_BIN
514 then do;
515 call hcs_$get_user_effmode (pathname_ (dirname, ename),
516 "pit", get_group_id_(), -1, mode, code);
517 if mode = REW_ACCESS_BIN then
518 return ("0"b);
519 else return ("1"b);
520 end;
521 else return("1"b);
522 end;
523
524 end determine_hphcs_need;
525
526
527 %page;
528
529
530
531
532
533
534
535 get_next_arg: proc(arg_expected, ap1, al1);
536
537 dcl arg_expected char(*);
538 dcl (ap1 ptr,
539 al1 fixed bin(21),
540 code fixed bin(35));
541
542 argno = argno + 1;
543 if argno > nargs then do;
544 call argument_error(error_table_$noarg, "A ^a expected after ^a.", arg_expected, arg);
545 return;
546 end;
547
548 call cu_$arg_ptr (argno, ap1, al1, code);
549 if code ^= 0 then call argument_error(code, "get_next_arg", "", "");
550
551 end get_next_arg;
552
553
554 %page;
555
556
557
558
559
560
561 report_error: proc(ecode, message, str1, str2);
562
563 dcl ecode fixed bin(35),
564 (message, str1, str2) char(*);
565
566 call com_err_(ecode, myname, message, str1, str2);
567 goto END_COPY;
568
569 end report_error;
570
571
572 %page;
573
574
575
576 set_privileges: proc(code);
577
578 dcl code fixed bin(35);
579
580 code = 0;
581 priv_string = get_privileges_();
582
583
584 call check_gate_access_ ("system_privilege_", null(), code);
585 if code ^= 0 then return;
586
587 if privileges.dir then;
588 else call system_privilege_$dir_priv_on (code);
589 if privileges.seg then;
590 else call system_privilege_$seg_priv_on (code);
591
592 privileges_are_set = "1"b;
593
594 end set_privileges;
595
596
597 %page;%include access_mode_values;
598 %page;%include aim_privileges;
599
600 end copy_deadproc;