
*copyc osd$default_pragmats

MODULE clm$tape_validation_commands;

*copyc bap$fetch_tape_validation
*copyc bap$get_tape_security_state
*copyc bap$put_tape_security_state
*copyc bap$store_tape_validation
*copyc clt$value
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parameter_list
*copyc clp$evaluate_parameters
*copyc clp$trimmed_string_size
*copyc clt$display_control
*copyc clt$path_display_chunks
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal
*copyc oss$job_paged_literal
*copyc ost$status
?? EJECT ??

  PROCEDURE [XDCL, #GATE] clp$display_tape_validate_cmd (
        parameter_list: clt$parameter_list;
    VAR status: ost$status);


{  PROCEDURE display_tape_validation, distv (
{    output, o: FILE = $output
{    status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 9, 20, 8, 37, 45, 231],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['O                              ',clc$abbreviation_entry, 1],
    ['OUTPUT                         ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ 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$optional_default_parameter, 0, 7],
{ PARAMETER 2
    [3, 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],
    '$output'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$output = 1,
      p$status = 2;

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



*copyc clp$get_path_name
*copyc clp$put_path_subtitle
*copyc clp$reset_for_next_display_page
*copyc clp$new_display_line
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$put_partial_display
*copyc clp$horizontal_tab_display
*copyc clp$get_path_description
*copyc clp$get_parameter
*copyc clp$open_display
*copyc clp$close_display
*copyc clp$put_partial_display
*copyc clp$put_display
*copyc clv$display_variables
*copyc clv$value_descriptors
*copyc clp$abort_handler
*copyc clp$new_page_procedure
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_file

    CONST
      max_tape_validation_size = 4;

    VAR
      tape_validation_string: [STATIC, READ, oss$job_paged_literal]
       array [bat$tape_validation_state] of record
        size: 1 .. max_tape_validation_size,
        value: string (max_tape_validation_size),
      recend := [[4, 'none'],[2, 'on'], [3, 'off']];

?? EJECT ??

    PROCEDURE put_subtitle (VAR display_control: clt$display_control;
      VAR status: ost$status);

      clv$subtitles_built := TRUE;

    PROCEND put_subtitle;

?? EJECT ??

    PROCEDURE put_attribute (header: string ( * );
          value: string ( * ));

      VAR
        ignore_status: ost$status,
        start_option: amt$term_option,
        edited_header: string (tab_over);

      CONST
        max_attribute_name_size = 22,
        tab_over = max_attribute_name_size + 3;

      status.normal := TRUE;
      start_option := amc$start;
      edited_header := header;
      edited_header (tab_over - 1) := ':';

      clp$put_partial_display (display_control, edited_header, clc$no_trim, start_option, status);
      IF NOT status.normal THEN
        clp$close_display (display_control, ignore_status);
        EXIT clp$display_tape_validate_cmd;
      IFEND;
      clp$put_partial_display (display_control, value, clc$trim, amc$terminate, status);
      IF NOT status.normal THEN
        clp$close_display (display_control, ignore_status);
        EXIT clp$display_tape_validate_cmd;
      IFEND;
    PROCEND put_attribute;
?? EJECT ??

    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND clean_up;

 {  Begin main procedure  }

    VAR
      value: clt$value,
      display_control: clt$display_control,
      enforce_tape_security: bat$tape_validation_state,
      output_file: clt$file,
      output_open: boolean,
      tape_validation: bat$tape_validation_state;

    status.normal := TRUE;

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

    clp$convert_string_to_file (pvt [p$output].value^.file_value^, output_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    output_open := FALSE;
    osp$establish_condition_handler (^clp$abort_handler, false);

    clp$open_display (output_file, ^clp$new_page_procedure, display_control, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    output_open := TRUE;
    clv$titles_built := FALSE;
    clv$subtitles_built := FALSE;
    clv$command_name := 'display_tape_validation';

    IF display_control.page_width < clc$narrow_page_width THEN
      clv$page_width := clc$narrow_page_width;
    ELSEIF display_control.page_width > clc$wide_page_width THEN
      clv$page_width := clc$wide_page_width;
    ELSE
      clv$page_width := display_control.page_width;
    IFEND;

    bap$fetch_tape_validation( tape_validation, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    put_attribute ('Validate_Tape_Access', tape_validation_string [tape_validation].value
        (1, tape_validation_string [tape_validation].size));

    bap$get_tape_security_state(enforce_tape_security, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    put_attribute ('Enforce_Tape_Security', tape_validation_string [enforce_tape_security].value
        (1, tape_validation_string [enforce_tape_security].size));
    clp$close_display (display_control, status);
    IF status.normal THEN
      output_open := FALSE;
    IFEND;

  PROCEND clp$display_tape_validate_cmd;
?? EJECT ??

  PROCEDURE [XDCL, #GATE] clp$change_tape_validation_cmd (
        parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE change_tape_validation, chatv (
{   validate_tape_access, vta: boolean = $optional
{   enforce_tape_security, ets: (BY_NAME) boolean = $optional
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  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,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 2, 1, 0, 0, 17, 638],
    clc$command, 5, 3, 0, 0, 0, 0, 3, ''], [
    ['ENFORCE_TAPE_SECURITY          ',clc$nominal_entry, 2],
    ['ETS                            ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['VALIDATE_TAPE_ACCESS           ',clc$nominal_entry, 1],
    ['VTA                            ',clc$abbreviation_entry, 1]],
    [
{ PARAMETER 1
    [4, 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$optional_parameter, 0
  , 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [3, 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$boolean_type]],
{ PARAMETER 2
    [[1, 0, clc$boolean_type]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$validate_tape_access = 1,
      p$enforce_tape_security = 2,
      p$status = 3;

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

    VAR
      enforce_tape_security: bat$tape_validation_state,
      value: clt$value,
      tape_validation: bat$tape_validation_state;

    status.normal := TRUE;

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

    IF pvt [p$validate_tape_access].specified OR pvt [p$enforce_tape_security].specified THEN
      IF pvt [p$validate_tape_access].specified THEN
        IF pvt [p$validate_tape_access].value^.boolean_value.value THEN
          tape_validation := bac$tape_validation_on;
        ELSE
          tape_validation := bac$tape_validation_off;
        IFEND;
        bap$store_tape_validation (tape_validation, status);
      IFEND;

      IF pvt [p$enforce_tape_security].specified THEN
        IF pvt [p$enforce_tape_security].value^.boolean_value.value THEN
          enforce_tape_security := bac$tape_validation_on;
        ELSE
          enforce_tape_security := bac$tape_validation_off;
        IFEND;
        bap$put_tape_security_state (enforce_tape_security, status);
      IFEND;
    ELSE
     osp$set_status_abnormal ('CL', cle$required_parameter_omitted,
            'ENFORCE_TAPE_SECURITY or VALIDATE_TAPE_ACCESS', status);
    IFEND;
  PROCEND clp$change_tape_validation_cmd;

MODEND clm$tape_validation_commands;
