



		    delete_volume_log.pl1           10/10/89  1422.1r w 10/10/89  1359.5       77184



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


delete_volume_log: dvl: proc;

/* This command allows the caller to delete  the specified volume log in a consistent manner */

/* DR Vinograd 9/78 */


dcl  suffix char (32);
dcl  new_pool_path char (168);
dcl  contents_name char (32);
dcl  vlx fixed bin;
dcl  volog_name char (32);
dcl  pvolog_name char (32);
dcl  pvolog_dir char (168);
dcl  contents_dir char (168);
dcl  wd_mode bit (1);
dcl  volog_dir char (168);
dcl  volname char (32);
dcl  narg fixed bin;
dcl  j fixed bin;
dcl  arg char (argl) based (argp);
dcl  argl fixed bin;
dcl  argp ptr;
dcl  contentsp ptr;
dcl  manual_free bit (1);
dcl  ac fixed bin;
dcl  code fixed bin (35);
dcl  ignore fixed bin (35);
dcl  vpp ptr;

dcl  myname char (32) init ("delete_volume_log") static options (constant);
dcl  lock_wait_time fixed bin static init (60) options (constant);

dcl  cleanup condition;

dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$invalid_lock_reset fixed bin (35) ext;
dcl  error_table_$noentry ext fixed bin (35);;

dcl  get_wdir_ entry returns (char (168));
dcl  ioa_ entry options (variable);
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  manage_volume_pool_$free entry (ptr, entry options (variable), char (*), fixed bin (35));
dcl  manage_volume_pool_$set_pool_path entry (entry options (variable), char (*), ptr, fixed bin (35));
dcl  hcs_$delentry_seg entry (ptr, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  error_rnt entry variable options (variable);
dcl  suffixed_name_$make entry (char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock entry (bit (36) aligned, fixed bin (35));
dcl  cu_$arg_count entry (fixed bin);

dcl (null, addr, substr, rtrim) builtin;

%include backup_volume_log;
%include backup_pvol_info;
%include fs_vol_label;
%include backup_volume_header;
%include backup_static_variables;
%include pvolog;

/* set flags */
	wd_mode, manual_free = "0"b;
	error_rnt = com_err_;
	bvlp, pvlp = null;
						/* pick up name of volume log */
	call cu_$arg_ptr (1, argp, argl, code);
	if code ^= 0 then do;
argerr:	     call com_err_ (0, myname, "USAGE ^a pvname [-manual_free] [-wd | -working_dir]", myname);
	     return;
	end;
	if substr (arg, 1, 1) = "-" then goto argerr;
						/* get pathname */
	volname = arg;
						/* pickup control args if any */
	ac = 2;
	call cu_$arg_count (narg);
	do while (ac <= narg);
	     call cu_$arg_ptr (ac, argp, argl, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to access arg after", arg);
		goto finish;
	     end;
	     if arg = "-manual_free" then manual_free = "1"b;
	     else if arg = "-wd" | arg = "-working_dir" then wd_mode = "1"b;
	     else do;
		call com_err_ (error_table_$badopt, myname, "^a", arg);
		goto finish;
	     end;
	     ac = ac + 1;
	end;

	code = 0;
						/* set cleanup handler to unlock and release */
	if ^manual_free then do;
	     if wd_mode then new_pool_path = rtrim (get_wdir_ ()) || ">" || "Volume_Dumper";
	     else new_pool_path = ">daemon_dir_dir>volume_backup>Volume_Dumper";
	     call manage_volume_pool_$set_pool_path (error_rnt, new_pool_path, vpp, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to set new volume pool path");
		goto finish;
	     end;
	end;
	if wd_mode then volog_dir, contents_dir, pvolog_dir = get_wdir_ ();
	else do;
	     volog_dir = ">daemon_dir_dir>volume_backup";
	     pvolog_dir = ">daemon_dir_dir>volume_backup>pvolog";
	     contents_dir = ">daemon_dir_dir>volume_backup>contents";
	end;
	on cleanup call finish_;
	call get_volog (volname);
	if bvlp = null then do;
	     call com_err_ (code, myname, "^a>^a.volog", volog_dir, volname);
	     goto finish;
	end;
	call lock_volume_log ;
	do vlx = 1 to backup_volume_log.next;
	     volname = backup_volume_log (vlx).volname;
	     call get_pvolog (volname);
	     if pvlp ^= null then do;
		call lock_pvolog ;
		do j = 1 to pvolog.next;
		     pvlep = addr (pvolog.array (j));
		     if pvle.pvname = backup_volume_log.pvname then do;
			pvle.invocation_count = pvle.invocation_count - 1;
			if pvle.invocation_count = 0 then do;
			     pvolog.in_use = pvolog.in_use - 1;
			     pvle.pvname = "";
			end;
		     end;
		end;
		if pvolog.in_use <= 0 then do;
		     call hcs_$delentry_seg (pvlp, code);
		     if code ^= 0 then
			call com_err_ (code, myname, "Unable to delete output volume log ^a.pvolog.", volname);
		     else pvlp = null;
		     do suffix = "contents", "contents_names";
			call get_contents (volname, suffix);
			if contentsp ^= null then do;
			     call hcs_$delentry_seg (contentsp, code);
			     if code ^= 0 & code ^= error_table_$noentry then
				call com_err_ (code, myname, "Unable to delete ^a.^a", volname, suffix);
			end;
			else call com_err_ (code, myname, "Unable to locate ^a.^a", volname, suffix);
		     end;
		     if ^manual_free then do;
			call manage_volume_pool_$free (vpp, error_rnt, volname, code);
			if code ^= 0 then
			     call com_err_ (code, myname, "Unable to free volume ^a", volname);
			else call ioa_ ("Output volume ^a now available for use.", volname);
		     end;
		end;
		if pvlp ^= null then call unlock_pvolog;
	     end;
	     else call com_err_ (code, myname, "^a>^a.pvolog.", pvolog_dir, volname);
	end;
	call hcs_$delentry_seg (bvlp, code);
	if code ^= 0 then call com_err_ (code, myname, "Unable to delete ^a.volog", volname);
	else bvlp = null;
finish:
	call finish_;
	return;



lock_volume_log: proc ;

/* This proc locks the volume log */

	     call set_lock_$lock (backup_volume_log.lock, lock_wait_time, code);
	     if code = error_table_$invalid_lock_reset then code = 0;
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to lock volume log");
		goto finish;
	     end;
	     return;
	end lock_volume_log;

finish_:	proc;
						/* unlock, terminate, and release as required */
	     if bvlp ^= null then call set_lock_$unlock (backup_volume_log.lock, ignore);
	     if pvlp ^= null then call set_lock_$unlock (pvolog.lock, ignore);
	     if bvlp ^= null then call hcs_$terminate_noname (bvlp, ignore);
	     if pvlp ^= null then call hcs_$terminate_noname (pvlp, ignore);
	     return;

	end finish_;

get_volog: proc (volname);
dcl  volname char (*);
	     bvlp = null;
	     call suffixed_name_$make (volname, "volog", volog_name, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to construct volog name");
		goto finish;
	     end;
	     call hcs_$initiate (volog_dir, volog_name, "", 0, 0, bvlp, code);
	end get_volog;
get_pvolog: proc (volname);
dcl  volname char (*);
	     pvlp = null;
	     call suffixed_name_$make (volname, "pvolog", pvolog_name, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to construct pvolog name");
		goto finish;
	     end;
	     call hcs_$initiate (pvolog_dir, pvolog_name, "", 0, 0, pvlp, code);
	end get_pvolog;
get_contents: proc (volname, suffix);
dcl (volname, suffix) char (*);
	     contentsp = null;
	     call suffixed_name_$make (volname, suffix, contents_name, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to construct contents name");
		goto finish;
	     end;
	     call hcs_$initiate (contents_dir, contents_name, "", 0, 0, contentsp, code);
	end get_contents;

lock_pvolog: proc ;

/* This proc locks an output volume log */

	     call set_lock_$lock (pvolog.lock, lock_wait_time, code);
	     if code = error_table_$invalid_lock_reset then code = 0;
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to lock output log");
		goto finish;
	     end;
	     return;
	end lock_pvolog;
unlock_pvolog: proc ;

/* This proc unlocks an output volume log */

	     call set_lock_$unlock (pvolog.lock, ignore);
	     return;
	end unlock_pvolog;
     end delete_volume_log;




		    display_pvolog.pl1              10/10/89  1422.1rew 10/10/89  1359.2       64818



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(88-03-30,GWMay), approve(89-10-03,MCR8135),
     audit(89-10-04,Beattie), install(89-10-10,MR12.3-1089):
     Changes display to columnize output to save wasted space.
     Changed to add the -header option.
                                                   END HISTORY COMMENTS */


display_pvolog: proc;

/* This command displays the data in the specified output log. This data consists
   of the names and number of times cycled through of the physical volumes on this output volume.
   A special entry is provided to unlock
   a output log that has been left locked. */

%page;
       myname = "display_pvolog";
       go to COMMON;

dpvl: entry;

       myname = "dpvl";

COMMON:
/* init control variables */
          col_count = 0;
	header_sw = "1"b;
	lock = "0"b;
	force_unlock = "0"b;
	type = 0;
	pvname = "";
	pvlp = null;
	goto common;

unlock_pvolog: entry;

	lock = "0"b;
	pvlp = null;
	pvname = "";
	force_unlock = "1"b;

common:
	system_dir = ">daemon_dir_dir>volume_backup";
	call cu_$arg_ptr (1, argp, argl, code);
	if code ^= 0 then do;
argerr:	     call com_err_ (error_table_$noarg, myname, "
Usage:^10t^a pvolog {-control_args}
^10tcontrol_args:^25t^a^-^a^/^25t^a^-^a",
	        myname, "-working_dir, -wd", "-header, -he",
	        "-no_header, -nhe", "-pvname name, -pv name");
	     return;
	end;
	if substr (arg, 1, 1) = "-" then goto argerr;
						/* convert name to pathname */
	call suffixed_name_$make (arg, "pvolog", pvolog_name, code);
	if code ^= 0 then do;
	     call com_err_ (code, myname, "Unable to construct pvolog name");
	     goto finish;
	end;

	call cu_$arg_count (narg);
	ac = 2;
	do while (ac <= narg);
	     call cu_$arg_ptr (ac, argp, argl, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "error on arg after ^a", arg);
		goto finish;
	     end;
	     if arg = "-working_dir" | arg = "-wd" then system_dir = get_wdir_ ();
	     else if arg = "-nhe" | arg = "-no_header" then header_sw = "0"b;
	     else if arg = "-he" | arg = "-header" then header_sw = "1"b;
	     else if arg = "-pv" | arg = "-pvname" then do;
		ac = ac + 1;
		call cu_$arg_ptr (ac, argp, argl, code);
		if code ^= 0 then do;
		     call com_err_ (code, myname, "Unable to pickup pvname");
		     goto finish;
		end;
		pvname = arg;
		type = -1;
	     end;
	     else do;
		call com_err_ (error_table_$badopt, myname, "^a", arg);
		goto finish;
	     end;
	     ac = ac + 1;
	end;

          on cleanup go to finish;
						/* pick up name of volume log */
						/* get pointer to volume log */
	call hcs_$initiate (rtrim(system_dir) || ">pvolog", pvolog_name, "", 0, 0, pvlp, code);
	if pvlp = null then do;
	     call com_err_ (code, myname, "Unable to get pointer to pvolog ^a>pvolog>^a", system_dir, pvolog_name);
	     goto finish;
	end;

	if force_unlock then do;
	     lock = "1"b;				/* fake it */
	     goto finish;
	end;
						/* pick up control args */
						/* print header if requested */
						/* lock log before printing */
	call set_lock_$lock (pvolog.lock, -1, code);
	if code ^= 0 then do;
	     if code = error_table_$invalid_lock_reset then code = 0;
	     else do;
		call com_err_ (code, myname, "Unable to lock pvolog");
		goto finish;
	     end;
	end;
	lock = "1"b;

	if header_sw then do;
	     call ioa_ ("
^-Output Volume Log for Physical Volume ^a
^-^a volume dump started at ^a
^-in_use: ^d^-max_used: ^d
^/^[<NO ENTRIES>^;count pvname^]^[^23tcount pvname^]^[^45tcount pvname^]",
	        before (pvolog_name, "."),
	        ascii_type (pvolog.dump_type),
	        time_string_ (pvolog.mount_time),
	        pvolog.in_use, pvolog.next,
	        pvolog.next < 1,
	        pvolog.next > 1,
	        pvolog.next > 2);
	end;
						/* Examine each entry in the log and print as requested */
	do i = pvolog.next to 1 by -1;
	     pvlep = addr (pvolog.array (i));
	     if (pvname ^= "" & pvname = pvle.pvname)
	     | pvname = "" then
		if pvle.invocation_count ^= 0 then do;
		   if col_count = 3 | length (rtrim(pvle.pvname)) > 15 then col_count = 0;
		   col_count = col_count + 1;

		   call ioa_$nnl ("^3d^3x^a^[^/^;^23t^]^[^/^]",
		      pvle.invocation_count,
		      pvle.pvname,
		      col_count = 3,
		      i = 1);
		   end;
	end;

finish:						/* cleanup - unlock and terminate */
	call finish_;
	return;


time_string_: proc (time) returns (char (20));

/* This proc returns a time string suitable for printing */

dcl  time fixed bin (71);
dcl  time_string char (20);
	     call date_time_ (time, time_string);
	     return (substr (time_string, 1, 16));
	end time_string_;

finish_:	proc;
	     if lock & pvlp ^= null then call set_lock_$unlock (pvolog.lock, ignore);
	     if pvlp ^= null then call hcs_$terminate_noname (pvlp, ignore);

	end finish_;
%page;
dcl  pvolog_name char (32);
dcl  narg fixed bin;
dcl  system_dir char (168);
dcl  arg char (argl) based (argp);
dcl  argl fixed bin;
dcl  argp ptr;
dcl  col_count fixed bin;
dcl  i fixed bin;
dcl  ac fixed bin;
dcl  pvname char (32);
dcl  lock bit (1);
dcl  force_unlock bit (1);
dcl  code fixed bin (35);
dcl  ignore fixed bin (35);
dcl  type fixed bin;
dcl  header_sw bit (1);

dcl  ascii_type (3) char (32) var int static init ("incremental", "consolidated", "complete");
dcl  myname char (32) var;

dcl  suffixed_name_$make entry (char (*), char (*), char (*), fixed bin (35));
dcl  get_wdir_ entry returns (char (168));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  ioa_$nnl entry() options(variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock entry (bit (36) aligned, fixed bin (35));
dcl  cu_$arg_count entry (fixed bin);

dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$invalid_lock_reset ext fixed bin (35);
dcl  error_table_$noarg fixed bin(35) ext static;

dcl (before, length, rtrim, substr) builtin;
dcl  null builtin;
dcl  addr builtin;
dcl  cleanup condition;

%include pvolog;
%include backup_pvol_info;
%include fs_vol_label;
%include backup_volume_header;
%include backup_static_variables;

     end display_pvolog;




		    merge_volume_log.pl1            10/10/89  1422.1r w 10/10/89  1359.3       81522



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


merge_volume_log: proc;

/* This utility command merges two volume logs. Such a situation can occur if a volume log is deleted, then
   a new one is created by the volume dumper, and subsequently the old one is recovered.  This command will update the
   newer volume log with the data in the older volume log. The older volume log will not be modified. */

/* Modified 83-11-04 by SGH (UNCA) to improve merge strategy -- phx16302. */

dcl  arg char (argl) based (argp);
dcl  argl fixed bin;
dcl  argp ptr;
dcl  old_lock bit (1);
dcl  new_lock bit (1);
dcl  temp_segs bit (1);
dcl  update_lock bit (1);
dcl  cycle_uid bit (36);
dcl  tp (1) ptr;
dcl  p (2) ptr;
dcl  temp_bvlp ptr;
dcl  update_bvlep ptr;
dcl  new_bvlp ptr;
dcl  copy_bvlp ptr;
dcl  old_bvlep ptr;
dcl  old_bvlp ptr;
dcl  update_bvlp ptr;
dcl  i fixed bin;
dcl  j fixed bin;
dcl  num char (12) ;
dcl  relpn char (32);
dcl  dn (3) char (168);
dcl  en (3) char (32);
dcl  code fixed bin (35);
dcl  new_entry_count fixed bin;
dcl  ignore fixed bin (35);
dcl  myname char (32);

dcl  cleanup condition;

dcl  cu_$arg_count entry returns (fixed bin);
dcl  hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
dcl  adjust_bit_count_ entry (char (*), char (*), bit (1), fixed bin, fixed bin (35));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
dcl  release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  suffixed_name_$make entry (char (*), char (*), char (*), fixed bin (35));
dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock entry (bit (36) aligned, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));

dcl  error_table_$invalid_lock_reset fixed bin (35) ext;
dcl  unspec builtin;
dcl  null builtin;
dcl  addr builtin;

%include backup_volume_log;
%include backup_pvol_info;
%include fs_vol_label;
%include backup_volume_header;
%include backup_static_variables;

/* init local variables */
	code = 0;
	temp_segs = "0"b;
	old_lock = "0"b;
	new_lock = "0"b;
	update_lock = "0"b;
	new_entry_count = 0;
	old_bvlp, update_bvlp, temp_bvlp, new_bvlp, tp (*) = null;
	myname = "merge_volume_log";

	on cleanup call finish_;
						/* pickup pathnames and convert to pointers */
	do i = 1, 2;
	     call cu_$arg_ptr (i, argp, argl, code);
	     if code ^= 0 then goto err;

	     call suffixed_name_$make (arg, "volog", relpn, code);
	     if code ^= 0 then goto err;

	     call expand_pathname_ (relpn, dn (i), en (i), code);
	     if code ^= 0 then goto err;

	     call hcs_$initiate (dn (i), en (i), "", 0, 0, p (i), code);
	     if p (i) = null then goto err;
	end;
						/* set local copies */
	old_bvlp = p (1);
	update_bvlp = p (2);

	if old_bvlp = update_bvlp then do;
	     call com_err_ (0, myname, "Same log specified as old and new");
	     goto finish;
	end;
						/* create third seg if required */
	if cu_$arg_count () > 2 then do;
	     call cu_$arg_ptr (3, argp, argl, code);
	     if code ^= 0 then goto err;
	     call suffixed_name_$make (arg, "volog", relpn, code);
	     if code ^= 0 then goto err;
	     call expand_pathname_ (relpn, dn (3), en (3), code);
	     if code ^= 0 then goto err;
	     call hcs_$make_seg (dn (3), en (3), "", 1010b, new_bvlp, code);
	     if new_bvlp = null then goto err;
	end;
						/* set up temp segs */
	call get_temp_segments_ (myname, tp, code);
	if code ^= 0 then goto err;
	temp_segs = "1"b;
	temp_bvlp = tp (1);
						/* unlock logs if we abort */
						/* lock both logs - set flags indicating they're locked */
	call set_lock_$lock (old_bvlp -> backup_volume_log.lock, -1, code);
	if code ^= 0 then do;
	     if code = error_table_$invalid_lock_reset then code = 0;
	     else goto err;
	end;
	old_lock = "1"b;
	call set_lock_$lock (update_bvlp -> backup_volume_log.lock, -1, code);
	if code ^= 0 then goto err;
	update_lock = "1"b;

/* Compare each entry in each log and order the new log enties by which entry, if used, has
   an earlier starting time. */

	i, j = 1;
	do while (i <= old_bvlp -> backup_volume_log.next | j <= update_bvlp -> backup_volume_log.next);
	     old_bvlep = addr (old_bvlp -> backup_volume_log.array (i));
	     update_bvlep = addr (update_bvlp -> backup_volume_log.array (j));

/* If both cycle uids valid ->  compare and take one with first open time. */

	     if old_bvlep -> bvle.cycle_uid ^= "0"b & update_bvlep -> bvle.cycle_uid ^= "0"b then do;
		if old_bvlep -> bvle.open_time < update_bvlep -> bvle.open_time then call log_entry (old_bvlep, i);
		else if old_bvlep -> bvle.open_time > update_bvlep -> bvle.open_time then
		     call log_entry (update_bvlep, j);

/* If both open-times equal -> take only one if identical; otherwise, both */

		else do;				/* equal open times */
		     if unspec (old_bvlep -> bvle) = unspec (update_bvlep -> bvle) then do;
			call log_entry (old_bvlep, i);
			j = j + 1;
		     end;
		     else do;
			call log_entry (old_bvlep, i);
			call log_entry (update_bvlep, j);
		     end;
		end;
	     end;

/* If old cycle uid valid but update invalid -> take old, discard update. */

	     else if old_bvlep -> bvle.cycle_uid ^= "0"b then do;
		call log_entry (old_bvlep, i);
		j = j + 1;
	     end;

/* If update cycle uid valid but old invalid -> take update, discard old. */

	     else if update_bvlep -> bvle.cycle_uid ^= "0"b then do;
		call log_entry (update_bvlep, j);
		i = i + 1;
	     end;

/* If both cycle uids invalid -> discard both with warning. */

	     else do;
		call com_err_ (0, myname, "null entry in both logs");
		i = i + 1;
		j = j + 1;
	     end;
	end;
						/* if new copy wanted copy old log */
	if new_bvlp ^= null then do;
	     new_bvlp -> backup_volume_log = old_bvlp -> backup_volume_log;
	     if code ^= 0 then goto err;
	     copy_bvlp = new_bvlp;
	     new_lock = "1"b;
	end;
	else copy_bvlp = old_bvlp;
						/* copy temp log entries into right place */
	do i = 1 to new_entry_count;
	     copy_bvlp -> backup_volume_log.array (i) = temp_bvlp -> backup_volume_log.array (i);
	end;
						/* Unlock all locked logs and set flags */
	copy_bvlp -> backup_volume_log.next = new_entry_count;
	call set_lock_$unlock (old_bvlp -> backup_volume_log.lock, code);
	if code ^= 0 then goto err;
	old_lock = "0"b;
	call set_lock_$unlock (update_bvlp -> backup_volume_log.lock, code);
	if code ^= 0 then goto err;
	update_lock = "0"b;
	if new_bvlp ^= null then call set_lock_$unlock (new_bvlp -> backup_volume_log.lock, code);
	if code ^= 0 then goto err;
	new_lock = "0"b;

	call ioa_ ("volume logs ^a and ^a merged", en (1), en (2));

/* Unlock  all locked logs and terminate all known logs. Also release temp segs */

finish:
	call finish_;
	return;

err:	call com_err_ (code, myname);
	goto finish;

log_entry: proc (vlep, index);

/* This proc adds an entry to the new volume log */

dcl  vlep ptr;
dcl  index fixed bin;
	     new_entry_count = new_entry_count + 1;
	     index = index + 1;
	     temp_bvlp -> backup_volume_log.array (new_entry_count) = vlep -> bvle;
	end log_entry;


finish_:	proc;
	     if old_lock & old_bvlp ^= null then call set_lock_$unlock (old_bvlp -> backup_volume_log.lock, code);
	     if new_lock & new_bvlp ^= null then call set_lock_$unlock (new_bvlp -> backup_volume_log.lock, code);
	     if update_lock & update_bvlp ^= null then
		call set_lock_$unlock (update_bvlp -> backup_volume_log.lock, code);
	     if old_bvlp ^= null then call setbc_term (old_bvlp);
	     if update_bvlp ^= null then call setbc_term (update_bvlp);
	     if new_bvlp ^= null then call setbc_term (new_bvlp);
	     if temp_segs then call release_temp_segments_ (myname, tp, ignore);
	     return;
	end finish_;
setbc_term: proc (p);
dcl  p ptr;
dcl  dn char (168);
dcl  en char (32);
dcl  dnl fixed bin;
	     call hcs_$fs_get_path_name (p, dn, dnl, en, (0));
	     call adjust_bit_count_ (dn, en, "1"b, (0), (0));
	     call hcs_$terminate_noname (p, (0));
	     return;
	end setbc_term;
     end merge_volume_log;




		    purge_volume_log.pl1            11/01/89  0847.1rew 11/01/89  0844.2      216792



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(86-02-26,GWMay), approve(86-02-27,MCR7368),
     audit(86-03-28,Fawcett), install(86-03-31,MR12.0-1035):
     added assignment statement for rpv_pvid. This was being dropped from the
     original log when passed through this program.
  2) change(88-03-01,GWMay), approve(89-10-03,MCR8135),
     audit(89-10-04,Beattie), install(89-10-10,MR12.3-1103):
     Redesigned purge selection loop to more accurately represent reload
     groups per the documentation.  Prior to this change consolidated dumps
     were not being freed and reload groups > 2 did not work.  Also changed
     display of status messages to use ioa_ in place of com_err_.  Also
     changed to unlock the volog when using -test.  Prior to this fix, vologs
     are left locked by the -test control pass.
  3) change(89-10-16,GWMay), approve(89-10-16,PBF8135),
     audit(89-10-16,Beattie), install(89-10-18,MR12.3-1095):	
     Fixed bug where one too many reload groups was retained.
  4) change(89-10-26,GWMay), approve(89-10-26,MCR8135),
     audit(89-10-26,Beattie), install(89-11-01,MR12.3-1103):	
     Fixed bug where a dump volume was deleted from the volog but wasn't
     getting posted for later purging from the pvologs and contents_name
     segments.
                                                   END HISTORY COMMENTS */


/* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/

purge_volume_log: proc;

/* This command tool allows the caller to purge/delete in a controlled maner dump volumes from a volume log. It
   only deletes those dump volumes that have been superceeded by other dump volumes. In other words we delete incremental
   dump volumes that have been superceeded by consolidated dump volumes and consolidated dump volumes that have been
   superceeded by complete dump volumes. We take great care to preserve  reload groups, where a reload group is defined
   as those dump volumes necessary to logically recreate a physical volume during a volume reload. */
/* Status:
     0) Created:	 Sometime in the past by D.R. Vinograd
     1) Modified:	 12/13/82 by GA Texada to pretend -force if called as a subroutine.
*/
%page;
/* set flags */
    code = 0;
    sub, force_mode, test_mode = "0"b;
    error_rnt = com_err_;
    manual_free = "1"b;
    myname = "purge_volume_log";
    pvlp, bvlp = null;
    sys_dir = ">daemon_dir_dir>volume_backup";
						/* pick up name of volume log */
    call cu_$arg_ptr (1, argp, argl, code);
    if code ^= 0 then do;
argerr: call error_rnt (error_table_$noarg, myname, "
Usage:   ^a pvname {-control_args}
         control_args:   -auto   -test   -force   -working_dir,-wd",
	 myname);
        goto finish;
      end;
    if substr (arg, 1, 1) = "-" then goto argerr;
    volog = arg;
						/* pickup control args if any */
    ac = 2;
    call cu_$arg_count (narg);
    do while (ac <= narg);
      call cu_$arg_ptr (ac, argp, argl, code);
      if code ^= 0 then do;
	call error_rnt (code, myname, "Unable to access arg after ^a", arg);
	goto finish;
        end;
      if arg = "-auto" then manual_free = "0"b;
      else if arg = "-force" then force_mode = "1"b;
      else if arg = "-test" then test_mode = "1"b;
      else if arg = "-wd" | arg = "-working_dir" then sys_dir = get_wdir_ ();
      else do;
	call error_rnt (error_table_$badopt, myname, "^a", arg);
	goto finish;
        end;
      ac = ac + 1;
    end;

common:
    tp (*) = null;
    new_pool_path = rtrim (sys_dir) || ">Volume_Dumper";
    volog_dir = sys_dir;
    pvolog_dir = rtrim (sys_dir) || ">pvolog";
    contents_dir = rtrim (sys_dir) || ">contents";
    on cleanup call finish_;
    call find_volog_and_lock (volog);
    if ^manual_free then do;
        call manage_volume_pool_$set_pool_path (error_rnt, new_pool_path, vpp, code);
        if code ^= 0 then do;
	  call error_rnt (code, myname, "Unable to set new volume pool path");
	  goto finish;
	end;
      end;
    code = 0;
    new_ent_cnt = 0;
    call get_temp_segments_ (myname, tp, code);
    if code ^= 0 then do;
        call error_rnt (code, myname, "Unable to create temp segs");
        goto finish;
      end;
    tbvlp = tp (1);
    old_vlp = tp (2);
    new_vlp = tp (3);
    del_vlp = tp (4);
						/* build name list of all dump volumes in log */
    call build_volume_list (bvlp, old_vlp);
						/*  initialize what will be new volume log */
    reload_groups = backup_volume_log.reload_groups;
    tbvlp -> backup_volume_log.header = backup_volume_log.header;
    tbvlp -> backup_volume_log.info = backup_volume_log.info;
    tbvlp -> backup_volume_log.version = backup_volume_log.version;
    tbvlp -> backup_volume_log.lock = backup_volume_log.lock;
    tbvlp -> backup_volume_log.pvname = backup_volume_log.pvname;
    tbvlp -> backup_volume_log.pvid = backup_volume_log.pvid;
    if backup_volume_log.version = backup_volume_log_version_2 |
       backup_volume_log.version = backup_volume_log_version_3 then
      tbvlp -> backup_volume_log.disk_type = backup_volume_log.disk_type;
    tbvlp -> backup_volume_log.next = backup_volume_log.next;
    tbvlp -> backup_volume_log.reload_groups = reload_groups;
    tbvlp -> backup_volume_log.rpv_pvid = backup_volume_log.rpv_pvid;
    tbvlp -> backup_volume_log.Nsaved_incr_sets = backup_volume_log.Nsaved_incr_sets;
    tbvlp -> backup_volume_log.Nsaved_cons_sets = backup_volume_log.Nsaved_cons_sets;
    
/* Back scan the volume log to develop as many reload groups as are desired.
   The basic scheme is to use incremental dump volumes until they are superceeded
   by consolidated dump volumes and consolidated dump volumes until a complete dump volume is found. Care must
   be taken for the case where the dumping process overlapped, as well as for the multi volume consolidated
   or complete dump.  We also allow the caller to save very recent incremental dump volumes even though they may have
   been superceeded by consolidated dump volumes.  */

/* save count of number of log entries */

    old_ent_cnt = backup_volume_log.next;
    comp_count, cons_count = 0;
    comp_cycle_uid, cons_cycle_uid = "0"b;
    subsequent_dump_open_time = 0;
						/* scan log entries not looked at */
    do idx = old_ent_cnt to 1 by -1
       while (comp_count <= reload_groups);
      bvlep = addr (backup_volume_log.array (idx));
						/* if compelete dump */
      if bvle.dump_type = comp then do;
         if comp_cycle_uid ^= bvle.cycle_uid then do;
	  comp_count = comp_count + 1;
	  if comp_count <= reload_groups then do;
	     comp_cycle_uid = bvle.cycle_uid;
	     subsequent_dump_open_time = open_time ();
               call log_volume_entry (idx);
	     end;
	  end;
         else
            call log_volume_entry (idx);
         end;
						/* if consolidated dump */
      else
         if bvle.dump_type = cons & comp_count < reload_groups then do;
	  if cons_cycle_uid ^= bvle.cycle_uid then do;
	     cons_count = cons_count + 1;
	     cons_cycle_uid = bvle.cycle_uid;
	     if comp_count = 0 then
	        subsequent_dump_open_time = open_time ();
	     end;

	  if subsequent_dump_open_time < bvle.close_time
	     | backup_volume_log.Nsaved_cons_sets < 1
	     | comp_count = 0
	     | cons_count <= backup_volume_log.Nsaved_cons_sets then
	     call log_volume_entry (idx);
	  end;
						/* if incremental dump */
      else
         if bvle.dump_type = incr & comp_count < reload_groups then do;
            if subsequent_dump_open_time < bvle.close_time
	     | backup_volume_log.Nsaved_incr_sets < 1
	     | cons_count = 0
	     | cons_count <= backup_volume_log.Nsaved_incr_sets then
               call log_volume_entry (idx);
	  end;
    end;

/* Compress the temp volume log such that there are no empty entries */

    do bvlx = old_ent_cnt to 1 by -1;
      do sortx = old_ent_cnt to 1 by -1;
        if tbvlp -> backup_volume_log.array (sortx).cycle_uid = "0"b
	   & (sortx + 1 <= hbound (backup_volume_log.array, 1)) then do;
	  tbvlp -> backup_volume_log.array (sortx) =
	       tbvlp -> backup_volume_log.array (sortx + 1);
	  unspec (tbvlp -> backup_volume_log.array (sortx + 1)) = "0"b;
	end;
      end;
    end;
    tbvlp -> backup_volume_log.next = new_ent_cnt;
    call build_volume_list (tbvlp, new_vlp);

    call build_delete_list;

    call process_delete_list;

    if ^test_mode then do;
        call hcs_$fs_move_seg (tbvlp, bvlp, 1, code);
        if code ^= 0 then do;
	  call error_rnt (code, myname, "Unable to replace volume log");
	  goto finish;
	end;
      end;

    call set_lock_$unlock (backup_volume_log.lock, code);
    if code ^= 0 then do;
        call error_rnt (code, myname, "Error unlocking volume log");
        goto finish;
      end;

    if old_ent_cnt ^= new_ent_cnt then do;
        call ioa_ ("^a: Volume log ^a ^[not ^]purged. Entry count ^[would have ^]changed from ^d to ^d",
	   myname, volog_name, test_mode, test_mode, old_ent_cnt, new_ent_cnt);
      end;
finish:
    if sub then a_code = code;
    call finish_;
    return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


purge_volume_log_: entry (a_sys_dir, a_volog, throw_away_value, a_manual_free, a_code);

/* This entry provide a subroutine interface for use by the volume dumper */

    sys_dir = a_sys_dir;
    volog = a_volog;
    sub, force_mode = "1"b;
    test_mode = "0"b;
    manual_free = a_manual_free;
    myname = "purge_volume_log_";
    error_rnt = dmpr_report_$error_output;
    bvlp, pvlp = null;
    goto common;


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


log_volume_entry: proc (idx);
dcl idx		     fixed bin;

/* This proc records in the temp volume log the log entry found during the scan. */
    if tbvlp -> backup_volume_log.array (idx).cycle_uid ^= "0"b then return;
    tbvlp -> backup_volume_log.array (idx) = backup_volume_log.array (idx);
    new_ent_cnt = new_ent_cnt + 1;
    return;
  end log_volume_entry;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


build_volume_list: proc (bvlp, vlp);

/* This proc builds a list of the dump volumes contained in a volume log */

dcl vlp		     ptr;
dcl bvlp		     ptr;
dcl (bvlx, vlx)	     fixed bin;
    do bvlx = 1 to bvlp -> backup_volume_log.next;
      bvlep = addr (bvlp -> backup_volume_log.array (bvlx));
      do vlx = 1 to vlp -> vol_list.next while
	 (bvle.volname ^= vlp -> vol_list.name (vlx));
      end;
      found = (vlx <= vlp -> vol_list.next);
      if ^found then do;
	vlp -> vol_list.next = vlp -> vol_list.next + 1;
	vlp -> vol_list.name (vlp -> vol_list.next) = bvle.volname;
	vlp -> vol_list.count (vlp -> vol_list.next) = 1;
        end;
      else vlp -> vol_list.count (vlx) = vlp -> vol_list (vlx).count + 1;
    end;
    return;
  end build_volume_list;


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


build_delete_list: proc;

/* This proc compares the volume names in the new and old volume lists and takes the ones not in the new but in
   the old and places them into the delete list. */

dcl (nvlx, pvlx)	     fixed bin;
dcl Sdelete              bit (1) aligned;
dcl count                fixed bin;

    do pvlx = 1 to old_vlp -> vol_list.next;
      search_name = old_vlp -> vol_list.name (pvlx);
      do nvlx = 1 to new_vlp -> vol_list.next while
	 (search_name ^= new_vlp -> vol_list.name (nvlx));
      end;

      Sdelete = "1"b;
      count = -1;
      if (nvlx <= new_vlp -> vol_list.next) then do;
         if (old_vlp -> vol_list.count (pvlx) = new_vlp -> vol_list.count (nvlx)) then
            Sdelete = "0"b;
         else
            count = new_vlp -> vol_list.count (nvlx);
      end;

      if Sdelete then do;
         del_vlp -> vol_list.next = del_vlp -> vol_list.next + 1;
         del_vlp -> vol_list.name (del_vlp -> vol_list.next) = search_name;
         del_vlp -> vol_list.count (del_vlp -> vol_list.next) = count;
      end;
    end;
 

    return;
  end build_delete_list;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


process_delete_list: proc;

/* This proc goes through the delete list and for each dump volume it locates the output log associated with it.
   It then removes the entry for this physical volume and decrements the in-use count.  If the output log has no
   more enties then the dump volume is considered free and the output log and contents seg are deleted. The volume
   is also marked as free in the dump volume pool. */
dcl (dvlx, pvlx)	     fixed bin;
dcl rebuild_failed	     bit (1);


    do dvlx = 1 to del_vlp -> vol_list.next;
      volname = del_vlp -> vol_list.name (dvlx);
      count = del_vlp -> vol_list.count (dvlx);
      call find_pvolog_and_lock (volname, pvlp);
      if pvlp = null then do;
	call ioa_ ("^a: ^a>^a.pvolog",
	     myname, pvolog_dir, volname);
	call ioa_ ("^a: Rebuilding ^a.pvolog", myname, volname);
	call rebuild_pvolog_ (volog_dir, volname, error_rnt, pvlp, code);
	rebuild_failed = (code ^= 0);
	if rebuild_failed then
	  call error_rnt (code, myname, "Rebuild of pvolog ^a.pvolog failed", volname);
	if pvlp ^= null then call set_lock_$lock (pvolog.lock, lock_wait_time, code);
        end;
      if pvlp = null then do;
	if ^rebuild_failed then goto next;		/* it was a null output log */
	if force_mode then goto next;
	else do;
	    call error_rnt (0, myname,
	         "Aborting purge because of missing output volume log ^a.pvolog", volname);
	    goto finish;
	  end;
        end;
      in_use = pvolog.in_use;
      do pvlx = 1 to pvolog.next;
        pvlep = addr (pvolog.array (pvlx));
        if pvle.pvname = backup_volume_log.pvname then do;
	  if ^test_mode then do;
	      if count = -1 then do;
		pvle.pvname = "";
		pvle.invocation_count = 0;
		in_use,
		     pvolog.in_use = pvolog.in_use - 1;
	        end;
	      else pvle.invocation_count = count;
	    end;
	  else if count = -1 then in_use = in_use - 1;
	end;
      end;
      if in_use <= 0 & ^test_mode then do;

	call hcs_$delentry_seg (pvlp, code);
	if code ^= 0 then
	  call error_rnt (code, myname, "Unable to delete output log for volume ^a", volname);
	else pvlp = null;

	call delete_contents_segs (volname);
	if ^manual_free then do;
	    call manage_volume_pool_$free (vpp, error_rnt, volname, code);
	    if code ^= 0 & code ^= error_table_$action_not_performed then
	      call error_rnt (code, myname, "Unable to free volume ^a", volname);
	    else call ioa_ ("^a: Output volume ^a is now available for use",
		    myname, volname);
	  end;
        end;
      else do;
	call set_lock_$unlock (pvolog.lock, code);
	if ^pvolog_known then do;
	    call hcs_$terminate_noname (pvlp, ignore);
	    pvlp = null;
	  end;
        end;
next:
    end;
    code = 0;
    return;
  end process_delete_list;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


finish_: proc;
						/* unlock, terminate, and release as required */
    if bvlp ^= null then call set_lock_$unlock (backup_volume_log.lock, ignore);
    if bvlp ^= null then
      call adjust_bit_count_ (volog_dir, volog_name, "1"b, (0), ignore);
    if bvlp ^= null & ^volog_known then do;
        call hcs_$terminate_noname (bvlp, ignore);
        bvlp = null;
      end;
    if tp (1) ^= null then call release_temp_segments_ (myname, tp, ignore);
    if pvlp ^= null then call set_lock_$unlock (pvolog.lock, ignore);
    if pvlp ^= null & ^pvolog_known then call hcs_$terminate_noname (pvlp, ignore);
  end finish_;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


find_volog_and_lock: proc (name);
dcl name		     char (32);
    call suffixed_name_$make (name, "volog", volog_name, code);
    if code ^= 0 then do;
        call error_rnt (code, myname, "Unable to create volog name from ^a", name);
        goto finish;
      end;

/* and then ptr */
    call hcs_$initiate (volog_dir, volog_name, "", 0, 0, bvlp, code);
    if bvlp = null then do;
        call error_rnt (code, myname, "Unable to locate volog ^a>^a", volog_dir, volog_name);
        goto finish;
      end;
    volog_known = (code = error_table_$segknown);
    call set_lock_$lock (backup_volume_log.lock, lock_wait_time, code);
    if code ^= 0 then do;
        if code = error_table_$invalid_lock_reset then code = 0;
        if code ^= 0 then do;
	  call error_rnt (code, myname, "Unable to lock volume log ^a", volog_name);
	  goto finish;
	end;
      end;
  end find_volog_and_lock;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


open_time: proc returns (fixed bin (71));
dcl temp		     fixed bin (71);
dcl jdx		     fixed bin;

    do jdx = idx to 1 by -1;
      if backup_volume_log.array (jdx).cycle_uid = bvle.cycle_uid then
        temp = backup_volume_log.array (jdx).open_time;
    end;
    return (temp);

  end open_time;


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


delete_contents_segs: proc (volname);
dcl seg_type	     char (32);
dcl volname	     char (32);
    do seg_type = "contents", "contents_names";
      call suffixed_name_$make (volname, seg_type, ename, code);
      if code ^= 0 then do;
	call error_rnt (code, myname, "Unable to create ^a name from ^a", seg_type, volname);
	return;
        end;
      if ^test_mode then do;
	call delete_$path (contents_dir, ename, "100111"b, "", code);
	if code ^= 0 & code ^= error_table_$noentry then
	  call error_rnt (code, myname, "Unable to delete ^a>^a ", contents_dir, ename);
        end;
    end;
  end delete_contents_segs;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


find_pvolog_and_lock: proc (volname, pvlp);
dcl volname	     char (32);
dcl pvlp		     ptr;
    pvlp = null;
    call suffixed_name_$make (volname, "pvolog", pvolog_name, code);
    if code ^= 0 then do;
        call error_rnt (code, myname, "Unable to construct pvolog name from ^a", volname);
        return;
      end;
    call hcs_$initiate (pvolog_dir, pvolog_name, "", 0, 0, pvlp, code);
    pvolog_known = (code = error_table_$segknown);
    if pvlp = null then return;
    call set_lock_$lock (pvolog.lock, lock_wait_time, code);
    if code ^= 0 then do;
        if code = error_table_$invalid_lock_reset then code = 0;
        if code ^= 0 then do;
	  call error_rnt (code, myname, "Unable to lock output volume log ^a", pvolog_name);
	  goto finish;
	end;
      end;
  end find_pvolog_and_lock;
%page;


dcl a_sys_dir	     char (*);
dcl count		     fixed bin;
dcl vpp		     ptr;
dcl sortx		     fixed bin;
dcl new_pool_path	     char (168);
dcl bvlx		     fixed bin;
dcl a_volog	     char (*);
dcl force_mode	     bit (1);
dcl narg		     fixed bin;
dcl volog		     char (32);
dcl volog_name	     char (32);
dcl test_mode	     bit (1);
dcl in_use	     fixed bin;
dcl ac		     fixed bin;
dcl pvolog_name	     char (32);
dcl throw_away_value     fixed bin;
dcl a_manual_free	     bit (1);
dcl a_code	     fixed bin (35);
dcl arg		     char (argl) based (argp);
dcl myname	     char (32);
dcl argl		     fixed bin;
dcl argp		     ptr;
dcl reload_groups	     fixed bin;
dcl sub		     bit (1);
dcl subsequent_dump_open_time
		     fixed bin (71);
dcl idx		     fixed bin;
dcl comp_cycle_uid	     bit (36);
dcl cons_cycle_uid	     bit (36);
dcl comp_count	     fixed bin;
dcl cons_count	     fixed bin;
dcl tp		     (4) ptr;
dcl found		     bit (1);
dcl search_name	     char (32);
dcl volname	     char (32);
dcl ename		     char (32);
dcl volog_dir	     char (168);
dcl pvolog_dir	     char (168);
dcl contents_dir	     char (168);
dcl sys_dir	     char (168);

dcl manual_free	     bit (1);
dcl code		     fixed bin (35);
dcl new_ent_cnt	     fixed bin;
dcl old_ent_cnt	     fixed bin;
dcl pvolog_known	     bit (1);
dcl volog_known	     bit (1);
dcl ignore	     fixed bin (35);
dcl old_vlp	     ptr;
dcl new_vlp	     ptr;
dcl del_vlp	     ptr;
dcl tbvlp		     ptr;

dcl 1 vol_list	     aligned based,
    2 next	     fixed bin,
    2 array	     (1:1 refer (vol_list.next)),
      3 count	     fixed bin,
      3 name	     char (32);

dcl lock_wait_time	     fixed bin static init (60) options (constant);

dcl cleanup	     condition;

dcl error_table_$badopt  ext fixed bin (35);
dcl error_table_$noarg fixed bin(35) ext static;
dcl error_table_$noentry ext fixed bin (35);
dcl error_table_$action_not_performed ext fixed bin (35);
dcl error_table_$segknown ext fixed bin (35);
dcl error_table_$invalid_lock_reset fixed bin (35) ext;

dcl delete_$path	     entry (char (*), char (*), bit (6), char (*), fixed bin (35));
dcl ioa_		     entry () options (variable);
dcl manage_volume_pool_$set_pool_path entry (entry options (variable), char (*), ptr, fixed bin (35));
dcl get_wdir_	     entry returns (char (168));
dcl rebuild_pvolog_	     entry (char (*), char (*), entry options (variable), ptr, fixed bin (35));
dcl adjust_bit_count_    entry (char (*), char (*), bit (1), fixed bin, fixed bin (35));
dcl manage_volume_pool_$free entry (ptr, entry options (variable), char (*), fixed bin (35));
dcl cu_$arg_ptr	     entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl get_temp_segments_   entry (char (*), (*) ptr, fixed bin (35));
dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
dcl com_err_	     entry options (variable);
dcl error_rnt	     entry variable options (variable);
dcl dmpr_report_$error_output entry options (variable);
dcl suffixed_name_$make  entry (char (*), char (*), char (*), fixed bin (35));
dcl hcs_$delentry_seg    entry (ptr, fixed bin (35));
dcl hcs_$initiate	     entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl hcs_$fs_move_seg     entry (ptr, ptr, fixed bin, fixed bin (35));
dcl set_lock_$lock	     entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl set_lock_$unlock     entry (bit (36) aligned, fixed bin (35));
dcl hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl cu_$arg_count	     entry (fixed bin);

dcl (hbound, rtrim, substr, null, addr, unspec) builtin;
%page;
%include backup_volume_log;
%include backup_pvol_info;
%page;
%include fs_vol_label;
%page;
%include backup_volume_header;
%include backup_static_variables;
%include pvolog;

  end purge_volume_log;




		    rebuild_pvolog.pl1              10/10/89  1422.1r w 10/10/89  1359.0       83385



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


rebuild_pvolog: proc;

/* This command and subroutine rebuild a  output volume log */

dcl  volname char (32);
dcl  unlock_volog bit (1) init ("0"b);
dcl  mount_time fixed bin (71);
dcl  myname char (32);
dcl  new_pvlp ptr;
dcl  pvolog_name char (32);
dcl  sub bit (1) init ("0"b);
dcl  volog_known bit (1) init ("0"b);
dcl  volname_count fixed bin;

dcl  long bit (1) init ("0"b);
dcl  narg fixed bin;
dcl  volog_dir char (168);
dcl  sys_dir char (168);
dcl  pvolog_dir char (168);
dcl  arg char (argl) based (argp);
dcl  argl fixed bin;
dcl  argp ptr;
dcl (bvx, ac, stx) fixed bin;
dcl  code fixed bin (35);
dcl  ignore fixed bin (35);
dcl  volume_pool_state fixed bin;


dcl  lock_wait_time fixed bin static init (60) options (constant);

dcl  cleanup condition;

dcl  hcs_$delentry_seg entry (ptr, fixed bin (35));
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  adjust_bit_count_ entry (char (*), char (*), bit (1), fixed bin, fixed bin (35));
dcl  suffixed_name_$make entry (char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  hcs_$fs_move_seg entry (ptr, ptr, fixed bin, fixed bin (35));
dcl  get_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  release_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  get_system_free_area_ entry returns (ptr);
dcl  get_wdir_ entry returns (char (168));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl (error_rnt, a_error_rnt) entry variable options (variable);
dcl  com_err_ entry options (variable);
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock entry (bit (36) aligned, fixed bin (35));
dcl  cu_$arg_count entry (fixed bin);

dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$bad_volid ext fixed bin (35);
dcl  error_table_$locked_by_this_process ext fixed bin (35);
dcl  error_table_$segknown ext fixed bin (35);
dcl  error_table_$invalid_lock_reset ext fixed bin (35);

dcl (substr, before, clock, addr, null, sum, min) builtin;
dcl (length, search) builtin;

%include backup_volume_log;
%include pvolog;
%include backup_pvol_info;
%include fs_vol_label;
%include backup_volume_header;
%include backup_static_variables;
%include  star_structures;

	bvlp, pvlp = null;
	star_names_ptr = null;
	volume_pool_state = 0;
	code = 0;
	myname = "rebuild_pvolog";
	error_rnt = com_err_;
	sys_dir = ">daemon_dir_dir>volume_backup";
	call cu_$arg_ptr (1, argp, argl, code);
	if code ^= 0 then do;
argerr:	     call error_rnt (0, myname, " USAGE: ^a volume [-wd|-working_dir]  ", myname);
	     return;
	end;
	if substr (arg, 1, 1) = "-" then goto argerr;
	volname = arg;
	call cu_$arg_count (narg);
	ac = 2;
	do while (ac <= narg);
	     call cu_$arg_ptr (ac, argp, argl, code);
	     if code ^= 0 then do;
		call error_rnt (code, myname, "Unable to access arg after ^a", arg);
		goto finish;
	     end;
	     if arg = "-working_dir" | arg = "-wd" then sys_dir = get_wdir_ ();
	     else if arg = "-long" | arg = "-lg" then long = "1"b;
	     else if arg = "-brief" | arg = "-bf" then long = "0"b;
	     else do;
		call error_rnt (error_table_$badopt, myname, "^a", arg);
		goto finish;
	     end;
	     ac = ac + 1;
	end;
common:
	volog_dir = sys_dir;
	pvolog_dir = rtrim (sys_dir) || ">pvolog";
	on cleanup call finish_;
	call check_volname (volname);
	if long then call ioa_ ("Processing ^a", volname);
	call hcs_$star_ (volog_dir, "*.volog", star_ALL_ENTRIES, get_system_free_area_ (), star_entry_count,
	     star_entry_ptr, star_names_ptr, code);
	if code ^= 0 then do;
	     call error_rnt (code, myname, "Unable to list volog dir ^a", volog_dir);
	     goto finish;
	end;
	call get_temp_segment_ (myname, pvlp, code);
	if code ^= 0 then do;
	     call error_rnt (code, myname, "Unable to get temp seg");
	     goto finish;
	end;
	pvolog.version = pvolog_version_1;
	pvolog.mount_time = clock;
	call scan_vologs;
	call suffixed_name_$make (volname, "pvolog", pvolog_name, code);
	if code ^= 0 then do;
	     call error_rnt (code, myname, "Unable to construct pvolog name from ^a", volname);
	     goto finish;
	end;
	call hcs_$make_seg (pvolog_dir, pvolog_name, "", 01010b, new_pvlp, code);
	if new_pvlp = null then do;
	     call error_rnt (code, myname, "Unable to create new pvolog seg ^a>^a", pvolog_dir, pvolog_name);
	     goto finish;
	end;
	call hcs_$fs_move_seg (pvlp, new_pvlp, 1, code);
	if code ^= 0 then do;
	     call error_rnt (code, myname, "Unable to copy new volog from temp seg");
	     goto finish;
	end;
	if new_pvlp -> pvolog.in_use = 0 then do;
	     call error_rnt (0, myname, "Null output volume ^a>^a will be deleted", pvolog_dir, pvolog_name);
	     call hcs_$delentry_seg (new_pvlp, code);
	     if code ^= 0 then do;
		call error_rnt (code, myname, "Unable to delete ^a.pvolog", volname);
		goto finish;
	     end;
	     new_pvlp = null;
	end;
	else do;
	     call adjust_bit_count_ (pvolog_dir, pvolog_name, "1"b, (0), ignore);
	end;


finish:						/* cleanup - unlock and terminate */
	call finish_;
	return;

rebuild_pvolog_: entry (a_sys_dir, a_volname, a_error_rnt, a_pvlp, a_code);
dcl  a_sys_dir char (*);
dcl  a_volname char (*);
dcl  a_code fixed bin (35);
dcl  a_pvlp ptr;
	volname = a_volname;
	new_pvlp, a_pvlp = null;
	code, a_code = 0;
	sub = "1"b;
	error_rnt = a_error_rnt;
	star_names_ptr = null;
	bvlp, pvlp = null;
	myname = "rebuild_pvolog_";
	sys_dir = a_sys_dir;
	goto common;

finish_:	proc;
	     if pvlp ^= null then call release_temp_segment_ (myname, pvlp, ignore);
	     if bvlp ^= null & unlock_volog then call set_lock_$unlock (backup_volume_log.lock, ignore);
	     if bvlp ^= null & ^volog_known then call hcs_$terminate_noname (bvlp, ignore);
	     if star_names_ptr ^= null then free star_names;
	     if sub then do;
		a_code = code;
		a_pvlp = new_pvlp;
	     end;
	end finish_;

find_volog_and_lock: proc (volog);
dcl  volog char (*);
	     call hcs_$initiate (volog_dir, volog, "", 0, 0, bvlp, code);
	     volog_known = (code = error_table_$segknown);
	     if bvlp = null then return;
	     call set_lock_$lock (backup_volume_log.lock, lock_wait_time, code);
	     unlock_volog = ^(code = error_table_$locked_by_this_process);
	     if ^unlock_volog then code = 0;
	     if code ^= 0 then do;
		if code = error_table_$invalid_lock_reset then code = 0;
		else do;
		     call error_rnt (code, myname, "Unable to lock volog ^a", volog);
		     goto finish;
		end;
	     end;
	end find_volog_and_lock;

count_volname: proc;
	     volname_count = 0;
	     mount_time = clock;
	     do bvx = 1 to backup_volume_log.next;
		bvlep = addr (backup_volume_log.array (bvx));
		if volname = bvle.volname then do;
		     volname_count = volname_count + 1;
		     pvolog.dump_type = bvle.dump_type;
		     mount_time = min (mount_time, bvle.open_time);
		end;
	     end;

	end count_volname;
scan_vologs: proc;
dcl  volog_name char (32);
	     do stx = 1 to star_entry_count;
		volog_name = star_names (star_entries (stx).nindex);
		call find_volog_and_lock (volog_name);
		if bvlp = null then do;
		     call error_rnt (code, myname, "can not locate volog ^a", volog_name);
		     goto next_volog;
		end;
		call count_volname;
		if volname_count ^= 0 then do;
		     pvolog.next = pvolog.next + 1;
		     pvolog.in_use = pvolog.in_use + 1;
		     pvlep = addr (pvolog.array (pvolog.next));
		     pvle.invocation_count = volname_count;
		     pvle.pvname = before (volog_name, ".");
		     pvolog.mount_time = min (pvolog.mount_time, mount_time);
		end;
		if unlock_volog then call set_lock_$unlock (backup_volume_log.lock, ignore);
		if ^volog_known then do;
		     call hcs_$terminate_noname (bvlp, ignore);
		     bvlp = null;
		end;
next_volog:
	     end;

	end scan_vologs;
check_volname: proc (volname);
dcl  volname char (*);
dcl  num fixed bin;
dcl  char_num char (32);
dcl  start_numeric fixed bin;
	     start_numeric = search (volname, "0123456789");
	     if start_numeric > 3 | start_numeric = 0 then do;
bad_volid:	code = error_table_$bad_volid;
		call error_rnt (code, myname, "Invalid volume name ^a", volname);
		goto finish;
	     end;
	     else do;
		char_num = substr (volname, start_numeric, length (volname) - start_numeric);
		num = cv_dec_check_ (char_num, code);
		if code ^= 0 then goto bad_volid;
	     end;
	     return;
	end check_volname;
     end rebuild_pvolog;




		    set_volume_log.pl1              10/10/89  1422.1rew 10/10/89  1355.3       72567



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(88-03-03,GWMay), approve(89-10-03,MCR8135),
     audit(89-10-04,Beattie), install(89-10-10,MR12.3-1089):
     Added the -incr_sets and -cons_sets control arguments to be used for
     setting the number of dump volume sets to retain in the volume log.
     Add short form of -rg for -reload_group.
                                                   END HISTORY COMMENTS */


set_volume_log: proc;

/* This command allows the caller to set the reload_group filed of the specified volume log */

%page;

/* set flags */
	lock = "0"b;
	volog_dir = ">daemon_dir_dir>volume_backup";
	bvlp = null;
	save_cons_set, save_incr_set = 0;
	set_reload_groups, set_save_cons_set, set_save_incr_set = "0"b;

						/* pick up name of volume log */
	call cu_$arg_ptr (1, argp, argl, code);
	if code ^= 0 then do;
             call com_err_ (code, myname);
arg_err:       call ioa_ (
"Usage: ^a volog {-control_args}
       control_args:  -working_dir, -wd
                      -reload_groups N, -rg N (N > 1)
                      -cons_sets N, -cs N (N > 0, ""all"", ""a"")
                      -incr_sets N, -is N (N > 0, ""all"", ""a"")", myname);
	     goto finish;
	end;

          if substr (ltrim (arg), 1, length ("-")) = "-" then do;
             call com_err_ (error_table_$bad_arg, myname, "^a", arg);
             goto arg_err;
             end;
          else
             volog = arg;
						/* pickup control args if any */
	ac = 2;
	call cu_$arg_count (nargs);
	do while (ac <= nargs);
	     call cu_$arg_ptr (ac, argp, argl, code);
	     if code ^= 0 then do;
no_arg:	        call cu_$arg_ptr (ac-1, argp, argl, code);
	        call com_err_ (code, myname, "Unable to access operand following argument ^a.", arg);
		goto finish;
	     end;
               if arg = "-reload_groups" | arg = "-rg" then do;
		ac = ac + 1;
		call cu_$arg_ptr (ac, argp, argl, code);
		if code ^= 0 then goto no_arg;
		reload_groups = cv_dec_check_ ((arg), code);
		if code ^= 0 then do;
		     call com_err_ (0, myname, "invalid numeric arg ^a", arg);
		     goto finish;
		end;
		if reload_groups < 1 then reload_groups = 1;
		set_reload_groups = "1"b;
	     end;
	  else
	     if arg = "-incr_sets" | arg = "-is" then do;
		ac = ac + 1;
		call cu_$arg_ptr (ac, argp, argl, code);
		if code ^= 0 then goto no_arg;
		if arg = "all" | arg = "a" then
		   save_incr_set = 0;
		else do;
		   save_incr_set = cv_dec_check_ ((arg), code);
		   if code ^= 0 then do;
		      call com_err_ (0, myname, "invalid numeric ^a", arg);
		      goto finish;
		      end;

		   if save_incr_set < 1 then do;
		      call com_err_ (0, myname,
"invalid arg -incr_sets(-is) ^a", arg);
		      goto finish;
		      end;
		   end;
		set_save_incr_set = "1"b;
	     end;
	  else
	     if arg = "-cons_sets" | arg = "-cs" then do;
		ac = ac + 1;
		call cu_$arg_ptr (ac, argp, argl, code);
		if code ^= 0 then goto no_arg;
		if arg = "all" | arg = "a" then
		   save_cons_set = 0;
		else do;
		   save_cons_set = cv_dec_check_ ((arg), code);
		   if code ^= 0 then do;
		      call com_err_ (0, myname, "invalid numeric arg ^a", arg);
		      goto finish;
		      end;

		   if save_cons_set < 1 then do;
		      call com_err_ (0, myname,
"invalid arg -cons_sets(-cs) ^a", arg);
		      goto finish;
		      end;		      
		   end;
		set_save_cons_set = "1"b;
	     end;
	     else if arg = "-wd" | arg = "-working_dir" then volog_dir = get_wdir_ ();
	     else do;
		call com_err_ (error_table_$bad_arg, myname, "^a", arg);
		goto arg_err;
	     end;
	     ac = ac + 1;
	end;

	code = 0;
						/* set cleanup handler to unlock and release */
	call get_bvlp (volog);
	on cleanup call finish_;
						/* get temp segs and set flag */
						/* lock volume log and set flag */
	call lock_volume_log;
	lock = "1"b;
						/* build name list of all dump volumes in log */
						/*  initialize what will be new volume log */
	if set_reload_groups then backup_volume_log.reload_groups = reload_groups;
	if set_save_cons_set then backup_volume_log.Nsaved_cons_sets = save_cons_set;
	if set_save_incr_set then backup_volume_log.Nsaved_incr_sets = save_incr_set;

	call unlock_volume_log;
	lock = "0"b;
finish:
	call finish_;
	return;

err:	call com_err_ (code, myname);
	goto finish;


lock_volume_log: proc;

/* This proc locks the volume log */

	     call set_lock_$lock (backup_volume_log.lock, -1, code);
	     if code = error_table_$invalid_lock_reset then code = 0;
	     else if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to lock volog");
		goto finish;
	     end;
	     return;
	end lock_volume_log;

unlock_volume_log: proc;

/* This proc unlocks the volume log */

	     call set_lock_$unlock (backup_volume_log.lock, code);
	     return;
	end unlock_volume_log;



finish_:	proc;
						/* unlock, terminate, and release as required */
	     if lock then call unlock_volume_log;
	     if bvlp ^= null then
		call adjust_bit_count_ (volog_dir, volog_name, "1"b, (0), ignore);
	     if bvlp ^= null   then call hcs_$terminate_noname (bvlp, ignore);
	     bvlp = null;
	end finish_;

get_bvlp:	proc (name);
dcl  name char (32);
	     call suffixed_name_$make (name, "volog", volog_name, code);
	     if code ^= 0 then do;
		call com_err_ (code, myname, "Unable to contruct volog name for ^a", name);
		goto finish;
	     end;

/* and then ptr */
	     call hcs_$initiate (volog_dir, volog_name, "", 0, 0, bvlp, code);
	     if bvlp = null then do;
		call com_err_ (code, myname, "Unable to get ptr to volog ^a>^a",
		     volog_dir, volog_name);
		goto finish;
	     end;
	end get_bvlp;
%page;
dcl  volog char (32);
dcl  volog_name char(32);
dcl  volog_dir char (168);
dcl  arg char (argl) based (argp);
dcl  myname char (32) int static init ("set_volume_log") options (constant);
dcl  argl fixed bin;
dcl  argp ptr;
dcl  reload_groups fixed bin;
dcl  save_cons_set fixed bin;
dcl  save_incr_set fixed bin;
dcl  lock bit (1) init ("0"b);
dcl  set_reload_groups bit (1);
dcl  set_save_cons_set bit (1);
dcl  set_save_incr_set bit (1);
dcl  nargs fixed bin;
dcl  ac fixed bin;
dcl  code fixed bin (35);
dcl  ignore fixed bin (35);


dcl  cleanup condition;

dcl  error_table_$bad_arg external fixed bin (35);
dcl  error_table_$invalid_lock_reset fixed bin (35) ext;

dcl  adjust_bit_count_ entry (char (*), char (*), bit (1), fixed bin, fixed bin (35));
dcl  cu_$arg_count entry (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  com_err_ entry options (variable);
dcl  suffixed_name_$make entry (char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock entry (bit (36) aligned, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  get_wdir_ entry returns (char(168));

dcl  (length, ltrim, null, substr) builtin;

%include backup_volume_log;
%include backup_pvol_info;
%include fs_vol_label;
%include backup_volume_header;
%include backup_static_variables;

     end set_volume_log;




		    verify_dump_volume.pl1          10/10/89  1422.1r w 10/10/89  1358.7      186354



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/

verify_dump_volume: vdv: proc;

/* This command utility can be used to verify the contents of a dump volume produced by the volume dumper.
   In addition it can also be used to produce a long or short form of a map/table of contents of what
   is written on the dump volume.
*/
/* Coded 11/4/77 by Dave Vinograd */
/* Modified 5/79 by D. Vinograd to make program check error count befor detaching
   so that proc does not go OOB. Also corrected logig that checked
   pattern at beginning of logical record */
/* Modified: 4/27/82 by GA Texada to change error handling on reads.	   */
/* Modified: 8/82 by GA Texada to fix phx13702			   */
/* Modified: 8/82 by GA Texada to fix phx13702			   */
/* Modified 03/12/85 by Greg Texada to fix phx19165, don't give up so soon when resynching (D. Kitson)	*/


/****^  HISTORY COMMENTS:
  1) change(88-10-10,Farley), approve(88-10-10,MCR8005),
     audit(88-10-15,Beattie), install(88-10-17,MR12.2-1173):
     Added new read routine and associated surrounding code to support the
     version 2 volume dump tapes.  These tapes have a pair of unique strings
     that delimit the object data of vtoce_type records.
                                                   END HISTORY COMMENTS */


dcl input_volume_desc    char (256);
dcl stop_vtocx	     fixed bin;
dcl vtocx		     fixed bin;
dcl resynch_retry_count  fixed bin;
dcl resynching	     bit (1);
dcl input_buf	     (divide (nelt, CHARS_PER_WORD, 17, 0)) bit (36) based (recordp);
dcl pattern_match_label  label;
dcl volname	     char (32);
dcl att_desc	     char (256);
dcl ignore	     fixed bin (35);
dcl code		     fixed bin (35);
dcl arg		     char (argl) based (argp);
dcl argl		     fixed bin;
dcl argp		     ptr;
dcl brief		     bit (1);
dcl long		     bit (1);
dcl delimited	     bit (1) aligned;		/* ON = reading object data delimited by unique matching strings */
dcl comment	     char (128) var;
dcl type		     char (10) var;
dcl name		     char (168) var;
dcl i		     fixed bin;
dcl iocbp		     ptr;
dcl nelt		     fixed bin (21);
dcl nel		     fixed bin (21);
dcl objectp	     ptr;
dcl input_buffer_ptr     ptr;
dcl input_buffer_start   fixed bin;
dcl input_buffer_len     fixed bin (21);
dcl old_256K_switch	     bit (2) aligned;
dcl tp		     (3) ptr;

dcl cleanup	     condition;

dcl word		     (size (backup_volume_header)) bit (36) based (recordp);
dcl string	     bit (BITS_PER_WORD * size (backup_volume_header)) based (recordp);
dcl words_skipped	     fixed bin;

dcl (error_table_$improper_data_format,
  error_table_$data_loss,
  error_table_$device_end,
  error_table_$end_of_info,
  error_table_$bad_arg,
  error_table_$badopt,
  error_table_$inconsistent,
  error_table_$root)     fixed bin (35) ext static;
dcl sys_info$seg_size_256K fixed bin (19) ext static;
dcl sys_info$max_seg_size fixed bin (18) ext static;

dcl myname	     char (32) static init ("verify_dump_volume") options (constant);
dcl DELIMITED	     bit (1) aligned internal static options (constant)
		     init ("1"b);
dcl FORWARD_CHAR_POSITIONING fixed bin int static init (3) options (constant);

dcl com_err_	     entry options (variable);
dcl cu_$arg_count	     entry returns (fixed bin);
dcl cu_$arg_ptr	     entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl cv_oct_check_	     entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl debug		     entry;
dcl get_temp_segments_   entry (char (*), (*) ptr, fixed bin (35));
dcl hc_backup_$decode_uidpath entry ((0:15) bit (36), char (*), char (*), fixed bin (35));
dcl hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35));
dcl hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35));
dcl hcs_$truncate_seg    entry (ptr, fixed bin (19), fixed bin (35));
dcl ioa_		     entry options (variable);
dcl ioa_$rsnnl	     entry options (variable);
dcl iox_$attach_ioname   entry (char (*), ptr, char (*), fixed bin (35));
dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));

dcl (addcharno, addr, divide, index, length, min, null, ptr, rtrim, size, substr) builtin;

/**** init local control variables */

    stop_vtocx = -1;
    brief, long = "0"b;
    resynching = "0"b;
    input_volume_desc = "";
    old_256K_switch = ""b;
    tp (*) = null;
    iocbp = null;
    code = 0;
						/* set up cleanup handler */
    on cleanup call finish_;
						/* get name of volume log  - pvname */
    call cu_$arg_ptr (1, argp, argl, code);
    if code ^= 0 then do;
        call ioa_ ("^a: USAGE: ^a volname [-input_volume_desc alternate_attach_description] [-brief|-bf] [-long|-lg] [-stop_vtocx vtocx]", myname, myname);
        return;
      end;
    volname = arg;
						/* get control args */
    i = 2;
    do while (i <= cu_$arg_count ());
      call cu_$arg_ptr (i, argp, argl, code);
      if code ^= 0 then goto err;
      if arg = "-input_volume_desc" then do;
	i = i + 1;
	call cu_$arg_ptr (i, argp, argl, code);
	if code ^= 0 then goto err;
	input_volume_desc = arg;
        end;
      else if arg = "-brief" | arg = "-bf" then brief = "1"b;
      else if arg = "-long" | arg = "-lg" then long = "1"b;
      else if arg = "-stop_vtocx" then do;
	i = i + 1;
	call cu_$arg_ptr (i, argp, argl, code);
	if code ^= 0 then goto err;
	stop_vtocx = cv_oct_check_ (arg, code);
	if code ^= 0 then goto bad_num;
        end;
      else do;
badopt:	call com_err_ (error_table_$badopt, myname, "^a", arg);
	goto finish;
        end;
      i = i + 1;
    end;
						/* create temp segs */
    if brief & long then do;
        call com_err_ (error_table_$inconsistent, myname, "-brief & -long");
        return;
      end;

    call setup_data_segments;
    if code ^= 0 then goto err;

    call attach;
    if code ^= 0 then goto err;

/* The search loop  reads successive records from the dump volume until it encounters a volume log with the name
   that matches pvname.  It then creates a segment, if one does not already exist and copies the data into it. The
   dump volume is read until the end of tape is reached. */

search_loop:
    do while (code = 0);
      call read_volume_record;
    end;
finish:
    call finish_;
    return;

err:
    call com_err_ (code, myname);
    goto finish;
bad_num:
    call com_err_ (error_table_$bad_arg, myname, "^a is not an octal number.", arg);
    goto finish;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


setup_data_segments: proc;

/* This proc sets up the data segments used during the verify. */

    call get_temp_segments_ (myname, tp, code);
    if code ^= 0 then return;

    recordp = tp (1);
    objectp = tp (2);
    input_buffer_ptr = tp (3);
    call hcs_$set_256K_switch ("11"b, (""b), code);
    if code ^= 0 then return;
    call hcs_$set_max_length_seg (objectp, sys_info$seg_size_256K, code);
    if code ^= 0 then return;
    call hcs_$set_max_length_seg (input_buffer_ptr, sys_info$seg_size_256K, code);
    if code ^= 0 then return;
    input_buffer_start = 1;
    input_buffer_len = 0;
    return;

  end setup_data_segments;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


attach: proc;

/* This proc queries the caller for the dump volume name, attaches to it and opens it. */

    if input_volume_desc ^= "" then
      call ioa_$rsnnl (input_volume_desc, att_desc, (0), volname);
    else call ioa_$rsnnl ("tape_mult_ ^a -system", att_desc, (0), volname);

    call iox_$attach_ioname ("input_volume", iocbp, att_desc, code);
    if code ^= 0 then return;

    call iox_$open (iocbp, Stream_input, "0"b, code);
    if code ^= 0 then return;

  end attach;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


detach: proc;

/* This proc closes and detaches the dump volume. */


    call iox_$close (iocbp, ignore);
    call iox_$detach_iocb (iocbp, ignore);
    iocbp = null;					/* be sure */

  end detach;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


resynch_volume: proc;

/* This proc is used for error recovery. It reads the dump volume word by word looking for a match on the
   3 words which are part of the header of the logical dump record. When it gets a match it returns to specified label.
   While resynchronization is in progress , io error handling is suppressed except if we reach the end of a dump
   volume. This code is freely adapted from the volume reloader. */

    resynching = "1"b;
    input_buf (*) = "0"b;
    nel = CHARS_PER_WORD * size (backup_volume_header);
    call read (recordp, nel, nelt, ^DELIMITED, code);
    call check_input_error;

    words_skipped = 0;
    do while (^(word (1) = pattern1 & word (4) = pattern2 & word (7) = pattern3));

      string = substr (string, 37, (size (backup_volume_header) - 1) * BITS_PER_WORD);
      nel = CHARS_PER_WORD;
      call read (addr (word (size (backup_volume_header))),
	 nel, nelt, ^DELIMITED, code);
      call check_input_error;

      words_skipped = words_skipped + 1;
      if words_skipped > 256 * WORDS_PER_PAGE then do;	/* put a limit on it */
	call ioa_ ("^a: resynchronization failed", myname);
	code = error_table_$end_of_info;
	call check_input_error;
        end;
    end;
    call ioa_ ("^a: synchronization completed ^d words skipped", myname,
         words_skipped);
    resynching = "0"b;
    delimited = "0"b;
    code = 0;
    goto pattern_match_label;

  end resynch_volume;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


skip_chars: proc;

/* This proc skips forward on a dump volume. */

    nelt = nel;
    call read (objectp, nel, nelt, delimited, code);
    call check_input_error;

  end skip_chars;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


check_input_error: proc;

/* This proc is used to check all io errors after a read request.  If no error we return.
   If we are at the end of the dump volume, then it is detached. If a volume log has not been found, a new dump volume is
   requested. Otherwise we are done. If the error is the result of a bad read we start resynchronization.
   If it has already been started we just return. */

    if nel ^= nelt | code ^= 0 then do;
        if (code = error_table_$end_of_info | code = error_table_$device_end) then do;
	  if resynching then call com_err_ (code, myname, "Resynching terminated.");
	  call detach;
	  goto finish;
	end;
        else if ^resynching then do;
	  if nel ^= nelt then do;
	      if code = error_table_$data_loss then
	        call com_err_ (code, myname, "Incomplete object detected.");
	      else do;
		if code = 0 then call com_err_ (code, myname, "Read did not complete.");
		else call com_err_ (code, myname, "Reading input volume");
	        end;
	    end;
	  else call com_err_ (code, myname, "Reading input volume");
	  call ioa_ ("^a: Resynching started", myname);
	  resynch_retry_count = 0;
	  call resynch_volume;
	end;
        else do;
	  resynch_retry_count = resynch_retry_count + 1;	/* keep track so we don't do this forever	*/
	  if resynch_retry_count > 64 then do;
	      call com_err_ (code, myname, "I/O error during resynching.");
	      call detach;
	      goto finish;
	    end;
	end;
      end;
  end check_input_error;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


read_volume_record: proc;

/* This proc reads volume dump records and interprets which type they are and
   displays info about them if requested. */

    pattern_match_label = pattern_match;
    delimited = "0"b;
    nel = CHARS_PER_WORD * size (backup_volume_header);
    call read (recordp, nel, nelt, delimited, code);
    call check_input_error;

    if backup_volume_record.pattern1 ^= pattern1
         | backup_volume_record.pattern2 ^= pattern2
         | backup_volume_record.pattern3 ^= pattern3 then do;
        code = error_table_$improper_data_format;
        call check_input_error;
      end;

pattern_match:
    nel = backup_volume_record.rec1_len - size (backup_volume_header) * CHARS_PER_WORD;
    call read (ptr (recordp, size (backup_volume_header)),
         nel, nelt, delimited, code);
    call check_input_error;

    if backup_volume_record.rec2_len > 0 then do;
        if backup_volume_record.rec1_type ^= vtoce_type then do;
	  call ioa_ ("Invalid record header");
	  call debug_it ("Volume record at ^p", recordp);
	end;
      end;

    comment = "";
    vtocx = 0;
    if backup_volume_record.rec1_type = vtoce_type then do;
        vtocx = backup_volume_record.vtocx;
        if stop_vtocx = vtocx then
	call debug_it ("vtoce at ^p", addr (backup_volume_record.vtoce));
        if (long | brief) then name = convert_puid_ ();
        if backup_volume_record.dirsw then type = "dir";
        else type = "seg";
        if backup_volume_record.uid = "0"b then comment = "deleted";
        if backup_volume_record.damaged then comment = comment || " damaged";
        if backup_volume_record.version > backup_volume_record_version_1
	   then delimited = "1"b;			/* object data is delimited */
      end;
    else if backup_volume_record.rec1_type = volume_log_type then do;
        bvlp = recordp;
        name = rtrim (backup_volume_log.pvname) || ".volog";
        type = "volog";
      end;
    else if backup_volume_record.rec1_type = contents_type then do;
        contentsp = recordp;
        name = rtrim (backup_volume_contents.volname) || ".contents";
        type = "contents";
      end;
    else if backup_volume_record.rec1_type = info_type then do;
        infop = recordp;
        name = rtrim (backup_info.dump_volname) || "[info data]";
        type = "info_seg";
      end;
    else do;
        call ioa_ ("Unknown record type ^d", backup_volume_record.rec1_type);
        call debug_it ("Volume record at ^p", recordp);
        goto skip;
      end;

    if brief then call ioa_ ("^a", name);
    if long then call ioa_ ("^o ^80a^-^a^-^a", vtocx, name, type, comment);

skip: nel = backup_volume_record.rec2_len;
    call skip_chars;

  end read_volume_record;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/

read: proc (return_buffer_ptr,
       Nrequested_chars,
       Nreturned_chars,
       Sdelimited,
       code);

dcl return_buffer_ptr    ptr,
  Nrequested_chars	     fixed bin (21),
  Nreturned_chars	     fixed bin (21),
  Sdelimited	     bit (1) aligned,
  code		     fixed bin (35);

dcl input_buffer	     char (256 * CHARS_PER_PAGE)
		     based (input_buffer_ptr);

dcl return_string	     char (Nrequested_chars)
		     based (return_buffer_ptr);

dcl Nassign_chars	     fixed bin (21),
  Nread_chars	     fixed bin (21),
  end_of_record	     fixed bin,
  tape_check1 /* bit (72) */ char (8),
  tape_check2 /* bit (72) */ char (8);

    Nreturned_chars, Nread_chars, code = 0;

    do while (Nreturned_chars < Nrequested_chars & code = 0);
      if input_buffer_len = 0 then do;
	input_buffer_start = 1;

	if Sdelimited & Nreturned_chars = 0 then do;
	    call iox_$get_chars (iocbp,
	         addr (tape_check1), length (tape_check1), Nread_chars, code);
	    if code ^= 0 then return;
	  end;

	if return_buffer_ptr = null then do;
	    call iox_$position (iocbp, FORWARD_CHAR_POSITIONING,
	         Nrequested_chars - Nreturned_chars, code);
	    Nreturned_chars = Nreturned_chars + Nrequested_chars;
	  end;
	else do;
	    call iox_$get_chars (iocbp,
	         addcharno (return_buffer_ptr, Nreturned_chars),
	         Nrequested_chars - Nreturned_chars, Nread_chars, code);
	    Nreturned_chars = Nreturned_chars + Nread_chars;
	  end;
	if code ^= 0 then return;

	if Sdelimited then do;
	    call iox_$get_chars (iocbp,
	         addr (tape_check2), length (tape_check2), Nread_chars, code);
	    if code ^= 0 then
	      return;

	    if tape_check1 ^= tape_check2 then do;
						/* found a short segment, move       */
						/* return string into the temp input */
						/* buffer and start parsing          */
	        input_buffer_len = Nreturned_chars;
	        substr (input_buffer, 1, input_buffer_len) =
		   return_string;
	      end;
	  end;
        end;

      else
	 if Sdelimited then do;
	tape_check1 = substr (input_buffer,
	     input_buffer_start, length (tape_check1));
	tape_check2 = "";
	input_buffer_start =
	     input_buffer_start + length (tape_check1);
	input_buffer_len =
	     input_buffer_len - length (tape_check1);
        end;

      if input_buffer_len > 0 then do;
	Nassign_chars =
	     min (input_buffer_len, Nrequested_chars);

	if Sdelimited then do;
	    if tape_check1 ^= tape_check2 then do;
	        end_of_record = index (substr (input_buffer, input_buffer_start,
		   input_buffer_len), tape_check1);
	        if end_of_record > 0 then do;
		  Nassign_chars = end_of_record - 1;
		  if Nrequested_chars ^= Nassign_chars then
		    code = error_table_$data_loss;
		end;
	      end;
	  end;

	if return_buffer_ptr ^= null then
	  return_string = substr (input_buffer,
	       input_buffer_start, Nassign_chars);
	Nreturned_chars = Nassign_chars;

	input_buffer_start =
	     input_buffer_start + Nassign_chars;
	input_buffer_len =
	     input_buffer_len - Nassign_chars;

	if Sdelimited & input_buffer_len > 0 then do;
	    input_buffer_start =
	         input_buffer_start + length (tape_check2);
	    substr (input_buffer, 1, input_buffer_len) =
	         substr (input_buffer, input_buffer_start,
	         input_buffer_len - length (tape_check2))
	         || tape_check2;
	    input_buffer_start = 1;
	  end;
        end;
    end;

    return;
  end read;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


finish_: proc;
    if iocbp ^= null then call detach;
    if tp (1) ^= null then do;
        call hcs_$truncate_seg (objectp, 0, ignore);	/* clean up our 256K segs */
        call hcs_$truncate_seg (input_buffer_ptr, 0, ignore);
        call hcs_$set_max_length_seg (objectp, (sys_info$max_seg_size), ignore);
        call hcs_$set_max_length_seg (input_buffer_ptr, (sys_info$max_seg_size), ignore);
        call release_temp_segments_ (myname, tp, ignore);
        call hcs_$set_256K_switch (old_256K_switch, (""b), ignore);
      end;
  end finish_;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


convert_puid_: proc returns (char (168));

/* This proc is used to convert a unique id pathname to an ascii pathname  */

dcl dn		     char (168);
dcl en		     char (32);
dcl ret_dn	     char (168);
dcl ec		     fixed bin (35);
dcl seg_fault_error	     condition;
    on seg_fault_error goto ret_unk;
    call hc_backup_$decode_uidpath (backup_volume_record.uid_path, dn, en, ec);
    if ec = error_table_$root then ;
    else if ec ^= 0 then
ret_unk: return ("UNKNOWN_PATH>" || rtrim (backup_volume_record.primary_name, " "));
    call ioa_$rsnnl ("^a^[>^]^[^a>^;^s^]^a", ret_dn, (0), dn, dn ^= ">", en ^= "", en, backup_volume_record.primary_name);
    return (ret_dn);
  end convert_puid_;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


debug_it: proc (string, p);
dcl string	     char (*);
dcl p		     ptr;
    call ioa_ (string, p);
    call ioa_ ("in debug");
    call debug;
  end debug_it;
%page; %include backup_info;
%page; %include backup_pvol_info;
%page; %include backup_static_variables;
%page; %include backup_volume_contents;
%page; %include backup_volume_header;
%page; %include backup_volume_log;
%page; %include backup_volume_record;
%page; %include fs_vol_label;
%page; %include iox_dcls;
%page; %include iox_modes;
%page; %include vtoce;
%page; %include system_constants;

  end verify_dump_volume;




		    volume_cross_check.pl1          10/10/89  1422.1rew 10/10/89  1355.4      134055



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(89-08-31,GWMay), approve(89-10-03,MCR8135),
     audit(89-10-04,Beattie), install(89-10-10,MR12.3-1089):
     Updated to process version 3 for backup_volume_log.incl.pl1 structures.
                                                   END HISTORY COMMENTS */


/* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/

volume_cross_check: proc;

/* This commands cross checks the characteristics of a volume dumper output medium in the volume pool,
   the pvolog, and the various vologs for consistency,  and rebuilds the pvolog if required */

/* Written: In antiquity by D. Vinograd
   Modified: 4/12/83 by GA Texada to not delete the pvolog's for volumes that are reserved.
   Modified: 7/11/83 by GA Texada to force the comment in the volume pool to match the pvolog.
   Modified: 2/29/84 by GA Texada to check the header patterns in the volog and the version (phx16935).
*/

dcl (volname, ename)     char (32);
dcl (argp, vpp)	     ptr;
dcl (new_pool_path, sys_dir) char (168);
dcl (narg, total_volname_count, volname_count) fixed bin;
dcl comment	     char (64);
dcl volume_pool_time     fixed bin (71);
dcl (found, long, brief) bit (1);
dcl (volog_dir, pvolog_dir, contents_dir) char (168);
dcl arg		     char (argl) based (argp);
dcl (argl, bvx, olx, ac) fixed bin;
dcl (code, ignore)	     fixed bin (35);
dcl (volume_pool_state, volume_pool_type) fixed bin;

dcl lock_wait_time	     fixed bin static init (60) options (constant);
dcl free		     fixed bin static init (1) options (constant);
dcl reserved	     fixed bin static init (3) options (constant);
dcl allocated	     fixed bin static init (2) options (constant);
dcl myname	     char (32) static int init ("volume_cross_check") options (constant);
dcl ascii_states	     (3) char (4) int static init ("incr", "cons", "comp") options (constant);

dcl cleanup	     condition;

dcl com_err_	     entry options (variable);
dcl cu_$arg_count	     entry (fixed bin);
dcl cu_$arg_ptr	     entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl delete_$path	     entry (char (*), char (*), bit (6), char (*), fixed bin (35));
dcl error_rnt	     entry variable options (variable);
dcl get_wdir_	     entry returns (char (168));
dcl hcs_$initiate	     entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl ioa_		     entry options (variable);
dcl manage_volume_pool_$allocate entry (ptr, entry options (variable), char (*), char (*), char (*), fixed bin (35));
dcl manage_volume_pool_$free entry (ptr, entry options (variable), char (*), fixed bin (35));
dcl manage_volume_pool_$set_pool_path entry (entry options (variable), char (*), ptr, fixed bin (35));
dcl manage_volume_pool_$status entry (ptr, entry options (variable), char (*), char (*), fixed bin (71), fixed bin, fixed bin (35));
dcl rebuild_pvolog_	     entry (char (*), char (*), entry options (variable), ptr, fixed bin (35));
dcl set_lock_$lock	     entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl set_lock_$unlock     entry (bit (36) aligned, fixed bin (35));
dcl suffixed_name_$make  entry (char (*), char (*), char (*), fixed bin (35));

dcl error_table_$badopt  ext fixed bin (35);
dcl error_table_$invalid_lock_reset ext fixed bin (35);
dcl error_table_$noentry ext fixed bin (35);
dcl error_table_$unimplemented_version fixed bin (35) ext static;

dcl (rtrim, substr, abs, null, addr) builtin;

    bvlp, pvlp = null;
    sys_dir = ">daemon_dir_dir>volume_backup";
    error_rnt = com_err_;
    long, brief, found = "0"b;
    volume_pool_time = 0;
    volume_pool_state = 0;
    code = 0;
    call cu_$arg_ptr (1, argp, argl, code);
    if code ^= 0 then do;
argerr: call com_err_ (0, myname, "USAGE: ^a volume [-wd|-working_dir]  ", myname);
        return;
      end;
    if substr (arg, 1, 1) = "-" then goto argerr;
    volname = arg;
    call cu_$arg_count (narg);
    ac = 2;
    do while (ac <= narg);
      call cu_$arg_ptr (ac, argp, argl, code);
      if code ^= 0 then do;
	call com_err_ (code, myname, "Unable to access arg after ^a", arg);
	goto finish;
        end;
      if arg = "-working_dir" | arg = "-wd" then sys_dir = get_wdir_ ();
      else if arg = "-long" | arg = "-lg" then long = "1"b;
      else if arg = "-bf" | arg = "-brief" then brief = "1"b;
      else do;
	call com_err_ (error_table_$badopt, myname, "^a", arg);
	goto finish;
        end;
      ac = ac + 1;
    end;
    volog_dir = sys_dir;
    pvolog_dir = rtrim (sys_dir) || ">pvolog";
    contents_dir = rtrim (sys_dir) || ">contents";
    new_pool_path = rtrim (sys_dir) || ">Volume_Dumper";
    call manage_volume_pool_$set_pool_path (error_rnt, new_pool_path, vpp, code);
    if code ^= 0 then goto finish;
    call manage_volume_pool_$status (vpp, error_rnt, volname, comment, volume_pool_time, volume_pool_state, code);
    if code ^= 0 then goto finish;
    on cleanup call finish_;
    if long then call ioa_ ("Processing ^a", volname);
    if comment = "incr" then volume_pool_type = incr;
    else if comment = "cons" then volume_pool_type = cons;
    else if comment = "comp" then volume_pool_type = comp;
    else if comment = "" | comment = "free" then goto finish;
    else do;
        call com_err_ (0, myname, "Unknown volume pool type ^a for volume ^a.
Use manual methods to investigate/free.", comment, volname);
        goto finish;
      end;
    call find_pvolog_and_lock (volname);
    if ^found then do;
        if volume_pool_state = free then goto finish;
        else if volume_pool_state = allocated then do;
	  call com_err_ (code, myname, "Volume ^a not in free pool but pvolog not found", volname);
	  call rebuild_pvolog (volname);
	end;
        else if volume_pool_state = reserved then goto finish;
        else do;
unknown_state:
	  call com_err_ (0, myname, "Unknown volume state for ^a. It will be rebuilt", volname);
	  goto freeit;
	end;
      end;
    else do;
        if volume_pool_state = free then do;
	  call com_err_ (0, myname, "Volume ^a in free state but pvolog exists", volname);
	  call rebuild_pvolog (volname);
	end;
        else if volume_pool_state = reserved & pvolog.in_use ^= 0 then do;
	  call com_err_ (0, myname, "Volume ^a reserved but pvolog has non 0 in use count", volname);
	  call rebuild_pvolog (volname);
	end;
        else if volume_pool_state = reserved then goto finish; /* could be preattached to current dumper	*/
        else if volume_pool_state = allocated then ;
        else do;
	  goto unknown_state;
	end;
      end;

    if volume_pool_type ^= pvolog.dump_type then do;
        call com_err_ (0, myname, "Volume pool and pvolog disagree as to dump type for ^a,
rebuilding to match pvolog.", volname);
freeit: call manage_volume_pool_$free (vpp, error_rnt, volname, ignore);
        volume_pool_state = free;
        volume_pool_type = pvolog.dump_type;
        call rebuild_pvolog (volname);
      end;
    total_volname_count = 0;
    do olx = 1 to pvolog.next;
      pvlep = addr (pvolog.array (olx));
      if pvle.invocation_count ^= 0 then do;
	call find_volog_and_lock ((pvle.pvname));
	if ^found then do;
	    call com_err_ (code, myname, "Unable to find volume log ^a", pvle.pvname);
	    goto next;
	  end;
	else if code ^= 0 then do;			/* must have a header or version problem	*/
	    call cleanup_volog ();			/* unlock and term				*/
	    goto next;				/* step past the bad one			*/
	  end;

	call count_volname (volname);
	total_volname_count = total_volname_count + volname_count;
	if volname_count ^= pvle.invocation_count then do;
	    if ^brief then call com_err_ (0, myname, "Invocation count for ^a differs by ^d from volume log ^a",
		 volname, abs (volname_count - pvle.invocation_count), pvle.pvname);
	    call cleanup_volog;
	    call rebuild_pvolog (volname);
	    goto finish;
	  end;
	call cleanup_volog;
        end;
next:
    end;

    if total_volname_count = 0 then do;
        call com_err_ (0, myname,
	"Volume ^a not found in any volog specified in pvolog", volname);
        call rebuild_pvolog (volname);
      end;
finish:						/* cleanup - unlock and terminate */
    call finish_;
    return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


finish_: proc;
    if pvlp ^= null then call set_lock_$unlock (pvolog.lock, ignore);
    if pvlp ^= null then call hcs_$terminate_noname (pvlp, ignore);
    if bvlp ^= null then call set_lock_$unlock (backup_volume_log.lock, ignore);
    if bvlp ^= null then call hcs_$terminate_noname (bvlp, ignore);

  end finish_;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


find_pvolog_and_lock: proc (volname);
dcl volname	     char (*);
dcl pvolog_name	     char (32);
    found = "0"b;
    pvlp = null;
    call suffixed_name_$make (volname, "pvolog", pvolog_name, code);
    if code ^= 0 then do;
        call com_err_ (code, myname, "Unable to construct pvolog name from ^a", volname);
        goto finish;
      end;
    call hcs_$initiate (pvolog_dir, pvolog_name, "", 0, 0, pvlp, code);
    if pvlp = null then return;
    found = "1"b;
    call set_lock_$lock (pvolog.lock, lock_wait_time, code);
    if code ^= 0 then do;
        if code = error_table_$invalid_lock_reset then code = 0;
        else do;
	  call com_err_ (code, myname, "Unable to lock volume log ^a", pvolog_name);
	  goto finish;
	end;
      end;
  end find_pvolog_and_lock;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


find_volog_and_lock: proc (volname);
dcl volname	     char (*);
dcl volog_name	     char (32);
    found = "0"b;
    bvlp = null;
    call suffixed_name_$make (volname, "volog", volog_name, code);
    if code ^= 0 then do;
        call com_err_ (code, myname, "Unable to construct volog name from ^a", volname);
        goto finish;
      end;
    call hcs_$initiate (volog_dir, volog_name, "", 0, 0, bvlp, code);
    if bvlp = null then return;
    found = "1"b;
    call set_lock_$lock (backup_volume_log.lock, lock_wait_time, code);
    if code ^= 0 then do;
        if code = error_table_$invalid_lock_reset then code = 0;
        else do;
	  call com_err_ (code, myname, "Unable to lock volume log ^a", volog_name);
	  goto finish;
	end;
      end;
    if (backup_volume_log.header.pattern1 ^= pattern1) | (backup_volume_log.header.pattern2 ^= pattern2)
      | (backup_volume_log.header.pattern3 ^= pattern3) then do;
        code = -1;					/* junk					*/
        call com_err_ (0, myname, "Volume log ^a^[>^]^a header patterns are not correct.",
	volog_dir, (volog_dir ^= ">"), volog_name);
        return;

      end;
    if (backup_volume_log.version = backup_volume_log_version_1) |
      (backup_volume_log.version = backup_volume_log_version_2) |
      (backup_volume_log.version = backup_volume_log_version_3) then ;
    else do;
        code = error_table_$unimplemented_version;
        call com_err_ (code, myname, "^a^[>^]^a.", volog_dir, (volog_dir ^= ">"), volog_name);
        return;
      end;

  end find_volog_and_lock;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


count_volname: proc (volname);
dcl volname	     char (*);
    volname_count = 0;
    do bvx = 1 to backup_volume_log.next;
      bvlep = addr (backup_volume_log.array (bvx));
      if volname = bvle.volname then do;
	volname_count = volname_count + 1;
	volume_pool_type = bvle.dump_type;
        end;
    end;

  end count_volname;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/


rebuild_pvolog: proc (volname);
dcl volname	     char (*);
    call com_err_ (0, myname, "Forcing rebuild of ^a.pvolog", volname);
    call rebuild_pvolog_ (volog_dir, volname, error_rnt, pvlp, code);
    if code ^= 0 then do;
        call com_err_ (code, myname, "Rebuild failed");
        goto finish;
      end;
    if pvlp ^= null then do;
        if volume_pool_state ^= allocated then
	   call manage_volume_pool_$allocate (vpp, error_rnt, volname, ascii_states (volume_pool_type), "", code);
        if code ^= 0 then
	   call error_rnt (code, myname, "Unable to mark ^a allocated in volume pool", volname);
      end;
    else do;
        call delete_contents_segs (volname);
        if volume_pool_state ^= free then do;
	  call manage_volume_pool_$free (vpp, error_rnt, volname, code);
	  if code ^= 0 then
	       call error_rnt (code, myname, "Unable to mark ^a free in volume pool", volname);
	end;
      end;
    goto finish;
  end rebuild_pvolog;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/

delete_contents_segs: proc (volname);
dcl seg_type	     char (32);
dcl volname	     char (*);
    do seg_type = "contents", "contents_names";
      call suffixed_name_$make (volname, seg_type, ename, code);
      if code ^= 0 then do;
	call error_rnt (code, myname, "Unable to create ^a name from ^a", seg_type, volname);
	return;
        end;
      call delete_$path (contents_dir, ename, "100111"b, "", code);
      if code ^= 0 & code ^= error_table_$noentry then
	 call error_rnt (code, myname, "Unable to delete ^a>^a ", contents_dir, ename);
    end;
  end delete_contents_segs;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/

cleanup_volog: proc;
    call set_lock_$unlock (backup_volume_log.lock, ignore);
    call hcs_$terminate_noname (bvlp, ignore);
    bvlp = null;

  end cleanup_volog;

%include backup_volume_log;

%include pvolog;
%include backup_pvol_info;

%include fs_vol_label;

%include backup_volume_header;
%include backup_static_variables;

  end volume_cross_check;




		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
