?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := ' NOS/VE Backup/Restore Utilities:  backup_file ', EJECT ??
MODULE pum$backup_file;
{PURPOSE:
{     this module contains procedures required to produce a BACKUP copy
{  of a specified file as well as a BACKUP copy of each cycle
{  registered in the file.
?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pud$backup_file
*copyc pud$hierarchy_list
*copyc pud$list_options
*copyc ost$status
*copyc ost$string
*copyc ost$user_identification
*copyc put$file_display_info
*copyc put$file_identifier
*copyc stt$set_name
?? POP ??
*copyc clp$evaluate_parameters
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$set_status_abnormal
*copyc pfp$find_cycle_array
*copyc pfp$find_cycle_array_extended
*copyc pfp$find_cycle_array_version_2
*copyc pfp$find_cycle_directory
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_file_description
*copyc pfp$find_next_info_record
*copyc pfp$get_family_set
*copyc pfp$get_item_info
*copyc pup$abort_output
*copyc pup$backup_cycle
*copyc pup$backup_cycle_request
*copyc pup$build_catalog_header
*copyc pup$build_entry
*copyc pup$build_hierarchy_list
*copyc pup$check_cycle_access
*copyc pup$check_if_item_excluded
*copyc pup$check_site_backup_options
*copyc pup$crack_pf_file_reference
*copyc pup$display_backup_output_total
*copyc pup$display_excluded_item
*copyc pup$display_line
*copyc pup$excluded_highest_cycles
*copyc pup$get_summary_status
*copyc pup$initialize_backup_listing
*copyc pup$output_file
*copyc pup$sort_cycle_array_version_2
*copyc pup$verify_file_path
*copyc pup$write_excluded_cycle
*copyc pup$write_file_display
*copyc pup$write_os_status
*copyc pup$write_status_to_listing
*copyc puv$backup_file_id
*copyc puv$backup_information
*copyc puv$bacpf_backup_file_version
*copyc puv$display_excluded_items
*copyc puv$global_backup_file_id
*copyc puv$include_archive_information
*copyc puv$null_original_unique_name
*copyc puv$null_res_cycle_array_ent_sp
*copyc puv$trace_selected
?? TITLE := '    Global Variables', EJECT ??
?? TITLE := '    [XDCL] pup$backup_file ', EJECT ??

  PROCEDURE [XDCL] pup$backup_file
    (    pf_entry: put$entry;
         password_provided: boolean;
         password: pft$password;
         pf_utility_catalog_header: put$catalog_header;
         pf_utility_hierarchy_list: put$hierarchy_list;
     VAR pf_backup_file_id: put$file_identifier;
         file_item_info: pft$p_info_record;
     VAR status: ost$status);

    VAR
      action_descriptor: put$action_descriptor,
      backup_item_info: put$backup_item_info,
      cycle_entry: put$entry,
      cycle_included: boolean,
      cycle_selector: pft$cycle_selector,
      file_display_info: put$file_display_info,
      file_archive_info: amt$segment_pointer,
      i: put$half_integer,
      ignore_status: ost$status,
      j: pft$array_index,
      local_password: pft$password,
      local_status: ost$status,
      p_cycle_array_version_1: pft$p_cycle_array,
      p_cycle_array_version_2: ^pft$cycle_array_version_2,
      p_cycle_array_extended_record: pft$p_info_record,
      p_cycle_directory_array: pft$p_cycle_directory_array,
      p_cycle_info_record: pft$p_info_record,
      p_file_description: pft$p_file_description;

    display (' entering pup$backup_file');
    status.normal := TRUE;
    local_status.normal := TRUE;
    pfp$find_file_description (file_item_info, p_file_description, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    file_display_info.display := TRUE;
    file_display_info.pf_entry := pf_entry;
    file_display_info.p_file_description := p_file_description;
    IF password_provided THEN
      local_password := password;
    ELSE
      local_password := p_file_description^.password;
    IFEND;
    IF puv$display_excluded_items THEN
      pup$write_file_display (pf_entry, p_file_description^.charge_id.account,
            p_file_description^.charge_id.project, ignore_status);
      file_display_info.display := FALSE;
    IFEND;
    backup_item_info.item_type := puc$backup_item_file_info;
    backup_item_info.file_item_info := file_item_info;
    pup$output_file (pf_entry, pf_utility_catalog_header, backup_item_info, pf_utility_hierarchy_list,
          pf_backup_file_id, status);
    IF NOT status.normal THEN
      pup$abort_output (pf_entry, pf_backup_file_id, status, local_status);
      RETURN;
    IFEND;
    IF puv$bacpf_backup_file_version = puc$backup_file_version_1 THEN
      pfp$find_cycle_array (file_item_info, p_cycle_array_version_1, status);
      IF status.normal AND (p_cycle_array_version_1 = NIL) THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_cycle_array, '', status);
      IFEND;
      display (' pfp$find_cycle_array');
      display_status (status);
    ELSEIF puv$bacpf_backup_file_version = puc$backup_file_version_2 THEN
      pfp$find_cycle_array_version_2 (file_item_info, p_cycle_array_version_2, status);
      IF status.normal AND (p_cycle_array_version_2 = NIL) THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_cycle_array, '', status);
      IFEND;
      display (' pfp$find_cycle_array_version_2');
      display_status (status);
    IFEND;
    IF status.normal THEN
      pfp$find_cycle_array_extended (file_item_info, p_cycle_array_extended_record, status);
      display (' pfp$find_cycle_array_extended');
      display_status (status);
      IF status.normal THEN
        pfp$find_cycle_directory (p_cycle_array_extended_record, p_cycle_directory_array, status);
        display (' pfp$find_cycle_directory');
        display_status (status);
        IF status.normal THEN
          IF puv$bacpf_backup_file_version = puc$backup_file_version_1 THEN
            PUSH p_cycle_array_version_2: [1 .. UPPERBOUND (p_cycle_array_version_1^)];
            FOR j := 1 TO UPPERBOUND (p_cycle_array_version_1^) DO
              p_cycle_array_version_2^ [j].bytes_allocated := 0;
              p_cycle_array_version_2^ [j].cycle_damage_symptoms := $fst$cycle_damage_symptoms [];
              p_cycle_array_version_2^ [j].cycle_number := p_cycle_array_version_1^ [j].cycle_number;
              p_cycle_array_version_2^ [j].cycle_statistics := p_cycle_array_version_1^ [j].cycle_statistics;
              p_cycle_array_version_2^ [j].data_modification_date_time :=
                    p_cycle_array_version_1^ [j].cycle_statistics.modification_date_time;
              p_cycle_array_version_2^ [j].data_residence := pfc$unreleasable_data;
              p_cycle_array_version_2^ [j].device_class := rmc$mass_storage_device;
              p_cycle_array_version_2^ [j].eoi := 0;
              p_cycle_array_version_2^ [j].expiration_date_time :=
                    p_cycle_array_version_1^ [j].expiration_date_time;
              p_cycle_array_version_2^ [j].original_unique_name := puv$null_original_unique_name;
              p_cycle_array_version_2^ [j].sparse_allocation := FALSE;
              p_cycle_array_version_2^ [j].cycle_reservation.cycle_reserved := FALSE;
              p_cycle_array_version_2^ [j].reserved_cycle_array_entry_sp :=
                    puv$null_res_cycle_array_ent_sp;
            FOREND;
          IFEND;
          IF pup$excluded_highest_cycles () > 0 THEN
            pup$sort_cycle_array_version_2 (p_cycle_array_version_2^);
          IFEND;
          file_archive_info.sequence_pointer := NIL;
          FOR i := LOWERBOUND (p_cycle_array_version_2^) TO (UPPERBOUND (p_cycle_array_version_2^)) DO
            cycle_selector.cycle_option := pfc$specific_cycle;
            cycle_selector.cycle_number := p_cycle_array_version_2^ [i].cycle_number;
            pup$build_entry (pf_entry.pfn, cycle_selector, puc$valid_cycle_entry, cycle_entry);
            pup$check_cycle_inclusion (pf_utility_catalog_header, cycle_entry, p_cycle_array_version_2^, i,
                  cycle_included, action_descriptor);
            IF cycle_included THEN
              {
              {    This code takes advantage of the fact that the cycle array and the cycle directory array
              {  contain the same cycle numbers in the same order.
              {
              pfp$find_direct_info_record (^p_cycle_array_extended_record^.body,
                    p_cycle_directory_array^ [i].info_offset, p_cycle_info_record, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              pup$backup_cycle (cycle_entry, local_password, pf_utility_catalog_header,
                    p_cycle_array_version_2^ [i], pf_utility_hierarchy_list, { check_cycle_included } TRUE,
                    file_display_info, p_cycle_info_record, file_archive_info, p_cycle_array_extended_record,
                    p_cycle_directory_array, pf_backup_file_id, status);
              pup$write_status_to_listing (cycle_entry, status, local_status);
              IF NOT puv$global_backup_file_id.backup_file_open THEN
                {
                { pup$backup_catalog encountered an error writing to the backup_file and closed it.
                { Return the abnormal status to the caller.
                {
                RETURN;
              IFEND;
              status.normal := TRUE;
            ELSE
              pup$write_excluded_cycle (cycle_entry, p_cycle_array_version_2^ [i], puc$unknown_cycle_size,
                    puv$unknown_global_file_name, {recorded vsn} NIL, p_cycle_array_extended_record,
                    p_cycle_directory_array, action_descriptor, local_status);
            IFEND;
          FOREND;
          IF file_archive_info.sequence_pointer <> NIL THEN
            mmp$delete_scratch_segment (file_archive_info, local_status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$backup_file;

?? TITLE := '    [XDCL] pup$backup_file_command ', EJECT ??

  PROCEDURE [XDCL] pup$backup_file_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      cycle_selector: pft$cycle_selector,
      cycle_specified: boolean,
      local_status: ost$status,
      p_path: ^pft$path,
      password: pft$password,
      path_container: clt$path_container;

    crack_backup_file (parameter_list, p_path, path_container, cycle_specified, cycle_selector, password,
          status);
    IF status.normal THEN
      IF cycle_specified THEN
        pup$backup_cycle_request (p_path^, cycle_selector, password, puv$backup_file_id, status);
      ELSE
        pup$backup_file_request (p_path^, password, puv$backup_file_id, status);
      IFEND;
    IFEND;
  PROCEND pup$backup_file_command;

?? TITLE := '    pup$backup_file_request ', EJECT ??

  PROCEDURE pup$backup_file_request
    (    file_path: pft$path;
         password: pft$password;
     VAR pf_backup_file_id: put$file_identifier;
     VAR status: ost$status);

    VAR
      dummy_cycle_selector: pft$cycle_selector,
      file_info_selections: pft$file_info_selections,
      file_item_info: amt$segment_pointer,
      group: pft$group,
      local_status: ost$status,
      p_body: pft$p_info,
      p_directory_array: pft$p_directory_array,
      p_hierarchy_list: ^put$hierarchy_list,
      p_info_record: pft$p_info_record,
      p_item_record: pft$p_info_record,
      pf_entry: put$entry,
      pf_lfn: amt$local_file_name,
      set_name: stt$set_name;

    status.normal := TRUE;

    pfp$get_family_set (file_path [pfc$family_name_index], set_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pup$build_entry (file_path [UPPERBOUND (file_path)], dummy_cycle_selector, puc$valid_pf_entry, pf_entry);
    PUSH p_hierarchy_list: [1 .. UPPERBOUND (file_path)];
    pup$build_catalog_header (set_name, ^file_path, p_hierarchy_list^.catalog_header);
    pup$build_hierarchy_list (pf_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^, status);
    IF status.normal THEN
      pup$verify_file_path (file_path, status);
      IF status.normal THEN
        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, file_item_info, status);
        IF status.normal THEN
          IF puv$bacpf_backup_file_version = puc$backup_file_version_1 THEN
            IF puv$include_archive_information THEN
              file_info_selections := - $pft$file_info_selections [pfc$file_cycles_version_2];
            ELSE
              file_info_selections :=
                    - $pft$file_info_selections [pfc$archive_descriptors, pfc$file_cycles_version_2];
            IFEND;
          ELSEIF puv$bacpf_backup_file_version = puc$backup_file_version_2 THEN
            IF puv$include_archive_information THEN
              file_info_selections := - $pft$file_info_selections [pfc$file_cycles];
            ELSE
              file_info_selections :=
                    - $pft$file_info_selections [pfc$archive_descriptors, pfc$file_cycles];
            IFEND;
          IFEND;
          group.group_type := pfc$public;
          RESET file_item_info.sequence_pointer;
          pfp$get_item_info (file_path, group, $pft$catalog_info_selections [], file_info_selections,
                file_item_info.sequence_pointer, status);
          IF status.normal THEN
            RESET file_item_info.sequence_pointer;
            pfp$find_next_info_record (file_item_info.sequence_pointer, p_info_record, status);
            IF status.normal THEN
              pfp$find_directory_array (p_info_record, p_directory_array, status);
              IF status.normal AND (p_directory_array <> NIL) THEN
                p_body := ^p_info_record^.body;
                pfp$find_direct_info_record (p_body, p_directory_array^ [LOWERBOUND (p_directory_array^)].
                      info_offset, p_item_record, status);
                IF status.normal THEN
                  pup$initialize_backup_listing (p_hierarchy_list^, pf_backup_file_id, puv$backup_information,
                        status);
                  IF status.normal THEN
                    pup$backup_file (pf_entry, {password_provided =} TRUE, password,
                          p_hierarchy_list^.catalog_header, p_hierarchy_list^, pf_backup_file_id,
                          p_item_record, status);
                  IFEND;
                  pup$display_backup_output_total;
                  pup$get_summary_status (status);
                  pup$write_os_status (status, local_status);
                IFEND;
              IFEND;
            IFEND;
          IFEND;
          mmp$delete_scratch_segment (file_item_info, local_status);
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$backup_file_request;

?? TITLE := '    [XDCL] pup$check_cycle_inclusion ', EJECT ??

  PROCEDURE [XDCL] pup$check_cycle_inclusion
    (    catalog_header: put$catalog_header;
         cycle_entry: put$entry;
         sorted_cycle_array: pft$cycle_array_version_2;
         cycle_array_index: integer;
     VAR cycle_included: boolean;
     VAR action_descriptor: put$action_descriptor);

    VAR
      cycle_excluded: boolean;

    action_descriptor := '';
    cycle_included := TRUE;
    pup$check_site_backup_options (sorted_cycle_array [cycle_array_index], cycle_included);
    IF NOT cycle_included THEN
      action_descriptor := 'EXCLUDE SITE';
    ELSE
      IF cycle_array_index > (UPPERBOUND (sorted_cycle_array) - pup$excluded_highest_cycles ()) THEN
        cycle_included := FALSE;
        action_descriptor := 'EXCLUDE HIGH';
      ELSE
        pup$check_if_item_excluded (cycle_entry, catalog_header, cycle_excluded);
        cycle_included := NOT cycle_excluded;
        IF cycle_excluded THEN
          action_descriptor := 'EXCLUDE FILE';
        ELSE
          pup$check_cycle_access (sorted_cycle_array [cycle_array_index], cycle_included);
          IF NOT cycle_included THEN
            action_descriptor := 'EXCLUDE CYCLE';
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND pup$check_cycle_inclusion;


?? TITLE := '    crack_backup_file ', EJECT ??

  PROCEDURE crack_backup_file
    (    parameter_list: clt$parameter_list;
     VAR p_path: ^pft$path;
     VAR path_container: clt$path_container;
     VAR cycle_specified: boolean;
     VAR cycle_selector: pft$cycle_selector;
     VAR password: pft$password;
     VAR status: ost$status);


{ PROCEDURE (osm$bacf) backup_file, bacf (
{   file, f: file = $required
{   password, pw: (SECURE) any of
{       key
{         none
{       keyend
{       name
{     anyend = none
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 5] of clt$pdt_parameter_name,
        parameters: array [1 .. 3] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 1] of clt$keyword_specification,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
          default_value: string (4),
        recend,
        type3: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [87, 10, 20, 12, 57, 6, 159], clc$command, 5, 3, 1, 0, 0, 0, 3, 'OSM$BACF'],
            [['F                              ', clc$abbreviation_entry, 1],
            ['FILE                           ', clc$nominal_entry, 1],
            ['PASSWORD                       ', clc$nominal_entry, 2],
            ['PW                             ', clc$abbreviation_entry, 2],
            ['STATUS                         ', clc$nominal_entry, 3]], [
{ PARAMETER 1
      [2, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
      [3, clc$normal_usage_entry, clc$secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 69, clc$optional_default_parameter, 0, 4],
{ PARAMETER 3
      [5, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
            clc$optional_parameter, 0, 0]],
{ PARAMETER 1
      [[1, 0, clc$file_type]],
{ PARAMETER 2
      [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type], FALSE, 2], 44,
            [[1, 0, clc$keyword_type], [1], [['NONE                           ', clc$nominal_entry,
            clc$normal_usage_entry, 1]]], 5, [[1, 0, clc$name_type], [1, osc$max_name_size]], 'none'],
{ PARAMETER 3
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$file = 1,
      p$password = 2,
      p$status = 3;

    VAR
      pvt: array [1 .. 3] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{crack file
    pup$crack_pf_file_reference (pvt [p$file].value^.file_value^,
          $put$cycle_reference_selections [puc$cycle_omitted, puc$specific_cycle, puc$highest_cycle,
          puc$lowest_cycle], 'FILE', path_container, p_path, cycle_specified, cycle_selector, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$password].value^.kind = clc$name THEN
      password := pvt [p$password].value^.name_value;
    ELSE {keyword = NONE}
      password := osc$null_name;
    IFEND;
  PROCEND crack_backup_file;
MODEND pum$backup_file;
