MODULE nam$file_access_me;
?? LEFT := 1, RIGHT := 110 ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc nac$network_management_catalog
*copyc nac$reserved_saps
*copyc nae$file_access_me_conditions
*copyc nat$gt_interface
*copyc nat$gt_event
*copyc nat$network_message_priority
*copyc nlt$protocol
*copyc ost$date_time
?? POP ??
*copyc amp$get_next
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc baf$task_file_entry_p
*copyc clp$get_next_scl_proc_line
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc nap$condition_handler_trace
*copyc nap$open_di_dump_file
*copyc nap$open_di_load_file
*copyc nap$display_message
*copyc nap$gt_accept_connection
*copyc nap$gt_await_activity_complete
*copyc nap$gt_close_sap
*copyc nap$gt_disconnect
*copyc nap$gt_open_sap
*copyc nap$gt_send_data
*copyc nap$gt_receive_connect_event
*copyc nap$gt_receive_connection_event
*copyc nap$gt_reject_connection
*copyc nap$increment_file_access_stats
*copyc nap$open_entry_point
*copyc nap$open_module
*copyc nap$open_procedure
*copyc nlp$register_title
*copyc nlp$delete_registered_title
*copyc osp$append_status_file
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pfp$attach
*copyc pfp$convert_pf_path_to_fs_path
*copyc pfp$find_cycle_array
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$get_multi_item_info
*copyc pmp$close_object_library
*copyc pmp$get_unique_name
*copyc pmp$log
*copyc osv$lower_to_upper

  CONST
    current_version = '01',
    current_version_size = 2;

  CONST
    create_request_id = 0,
    open_request_id = 2,
    delete_request_id = 4,
    close_request_id = 6,
    write_request_id = 8,
    read_request_id = 10,

    create_response_id = 1,
    open_response_id = 3,
    delete_response_id = 5,
    close_response_id = 7,
    write_response_id = 9,
    read_response_id = 11,

{ Response codes

    normal_response = 0,

{Abnormal response codes

    unspecified_error = 0,
    security_error = 1,
    insufficient_space = 2,
    unrecoverable_io_error = 3,
    file_does_not_exist = 4,
    invalid_file_position = 5,
    file_service_unavailable = 6,
    protocol_error = 7,
    unexpected_close = 8,
    no_seek_on_sequential_file = 9,
    bad_byte_count = 10,
    bad_file_name = 11,

    version = 1;

  CONST
    nac$max_connections = 1000,
    nac$max_dumps = 1000,
    max_data_block = 0ffff(16),
    unit_separator = $CHAR (1f(16));

  TYPE
    network_file_position = 0 .. 0ffffffff(16);

  TYPE
    network_file_size = 0 .. 0ffffffff(16);

  TYPE
    request_header = packed record
      version_number: 0 .. 0ffff(16),
      unused1: boolean,
      access_style: access_style, { create and open requests only }
      unused3: boolean,
      request_id: 0 .. 1f(16),
    recend;

  TYPE
    open_state_request_pdu = record
      header: request_header,
      access_mode: access_mode, { CREATE + OPEN requests only }

{ file_name: string (*)     Variable field of PDU

    recend;

  TYPE
    close_request_pdu = record
      header: request_header,
      filler: 0 .. 0ff(16),
    recend;

  TYPE
    write_request_pdu = record
      header: request_header,
      filler: 0 .. 0ff(16),
      file_position: network_file_position,

{ data: SEQ ( * ),  Data to be        written

    recend;

  TYPE
    read_request_pdu = record
      header: request_header,
      filler: 0 .. 0ff(16),
      file_position: network_file_position,
      length: 0 .. max_data_block,
    recend;

  TYPE
    response_header = packed record
      normal: boolean,
      unused: boolean,
      eoi: boolean, { read responses only }
      response_id: 0 .. 1f(16),
      response_code: 0 .. 0ff(16),
    recend;

  TYPE
    create_response_pdu = record
      header: response_header,
    recend;

  TYPE
    open_response_pdu = record
      header: response_header,
      file_size: network_file_size,
    recend;

  TYPE
    delete_response_pdu = record
      header: response_header,
    recend;

  TYPE
    close_response_pdu = record
      header: response_header,
    recend;

  TYPE
    write_response_pdu = record
      header: response_header,
      file_position: network_file_position,
    recend;

  TYPE
    read_response_pdu = record
      header: response_header,
      file_position: network_file_position,

{ data: SEQ ( * ),       Data read from file

    recend;

  TYPE
    title_info = record
      register: boolean,
      path: ^pft$path,
      network_fn_pattern: ost$string,
      min_file_name_size: 0 .. osc$max_string_size,
      max_file_name_size: 0 .. osc$max_string_size,
      password: nat$directory_password,
      case file_type: network_file_type of
      = boot, configuration, domain_name_server, dump, entry_point, exception, object_module, load_procedure,
            terminal_procedure, user_procedure =
        directory_identifier: nat$directory_entry_identifier,
        title: title_string,
        title_registered: boolean,
      = validation =
        validation_info: ^array [1 .. * ] of validation_title_info,
      casend,
    recend;

  TYPE
    validation_title_info = record
      directory_identifier: nat$directory_entry_identifier,
      title: title_string,
      title_registered: boolean,
    recend;

  TYPE
    title_array = array [boot .. validation] of title_info;

  TYPE
    access_mode = (am$read_write, am$write, am$read);

  TYPE
    fa_state = (closed, open, file_access, write_incomplete);

  TYPE
    access_style = (as$sequential, as$random);

  TYPE
    network_file_type = (boot, configuration, domain_name_server, dump, entry_point, exception, object_module,
          load_procedure, terminal_procedure, user_procedure, validation);

  TYPE
    title_string = record
      size: 0 .. nac$max_title_length,
      value: string (nac$max_title_length),
    recend;

  TYPE
    connection_information = record
      access_mode: access_mode,
      access_style: access_style,
      activity_status: ost$activity_status,
      connection_id: nat$gt_connection_id,
      current_position: network_file_position,
      data_area: array [1 .. 1] of nat$data_fragment,
      data_buffer: SEQ (REP 40(16) of cell),
      lfn: amt$local_file_name,
      file_id: amt$file_identifier,
      file_data: ^SEQ ( * ),
      file_type: network_file_type,
      file_size: network_file_size,
      state: fa_state,
      write_error: boolean,
      next_connection: ^connection_information,
      event: nat$gt_event,
    recend;

  CONST
    vnc$database_file_id='NETWORK VALIDATION DATABASE FILE VERSION 1';

  CONST
    vnc$database_file_id_size = 42;
  CONST
    vnc$date_time_size = 23,
    vnc$max_username_size = 31;

  CONST
    vnc$encrypted_password_size = 13;

  CONST
    vnc$max_delimited_password_size = 12,
    vnc$min_delimited_password_size = 7;

  CONST
    vnc$salt_size = 2;

  TYPE
    vnt$delimited_password = string (vnc$max_delimited_password_size);

  TYPE
    vnt$encrypted_password = string (vnc$encrypted_password_size);

  TYPE
    vnt$salt = string (vnc$salt_size);
  TYPE
    vnt$user_database = array [1 .. *] of vnt$validation_record;

  TYPE
    vnt$validation_record = record
      username: string(vnc$max_username_size),
      password: vnt$encrypted_password,
      date_time: ost$date_time,
    recend;

  VAR
    active_connections: 0 .. nac$max_connections := 0,
    connection_list: ^connection_information := NIL,
    max_connections: 1 .. nac$max_connections,
    max_dumps: 0 .. nac$max_dumps,
    max_dump_size: 0 .. amc$file_byte_limit,
    temp_data_frag: array [1 .. 1] of nat$data_fragment,
    titles_registered: 0 .. 9 := 0,
    trash_container: SEQ (REP 1024 of cell),
    wait_list: ^nat$gt_wait_list,
    wait_list_seq: ^SEQ ( * );

  VAR
    configuration_library_path: array [1 .. 5] of pft$name :=
          [nac$management_family, nac$management_master_catalog, nac$cdcnet_subcatalog,
          nac$site_controlled_subcatalog, nac$configuration_library];

  VAR
    min_file_path: array [1 .. 4] of pft$name := [nac$management_family, nac$management_master_catalog,
          nac$cdcnet_subcatalog, * ];

  VAR
    dns_boot_path: array [1 .. 5] of pft$name := [nac$management_family, nac$management_master_catalog,
          nac$tcp_ip_subcatalog, nac$dns_subcatalog, * ];

  VAR
    exception_list_path: array [1 .. 5] of pft$name := [nac$management_family, nac$management_master_catalog,
          nac$cdcnet_subcatalog, nac$site_controlled_subcatalog, nac$exception_list];

  VAR
    object_library_path: array [1 .. 5] of pft$name := [nac$management_family, nac$management_master_catalog,
          nac$cdcnet_subcatalog, nac$version_subcatalog, nac$di_object_library];

  VAR
    procedures_path: array [1 .. 6] of pft$name := [nac$management_family, nac$management_master_catalog,
          nac$cdcnet_subcatalog, nac$site_controlled_subcatalog, nac$procedures_subcatalog, * ];

  VAR
    validation_path: array [1 .. 6] of pft$name := [nac$management_family, nac$management_master_catalog,
          nac$network_subcatalog, nac$validations_subcatalog, * , nac$validation_library_name];

  VAR
    title_list: title_array := [[FALSE, ^object_library_path, [5, 'BOOT#'], 13, 14, 0, boot, * , [5, '$BOOT'],
          FALSE],

    [FALSE, ^configuration_library_path, [14, 'CONFIGURATION#'], 26, 26, 0, configuration, * , [14,
          '$CONFIGURATION'], FALSE],

    [FALSE, ^dns_boot_path, [4, 'DNS#'], 5, 35, 0, domain_name_server, * , [19, '$DOMAIN_NAME_SERVER'],
          FALSE],

    [FALSE, ^min_file_path, [5, 'DUMP#'], 35, 35, 0, dump, * , [5, '$DUMP'], FALSE],

    [FALSE, ^object_library_path, [6, 'ENTRY#'], 12, 42, 0, entry_point, * , [8, '$LIBRARY'], FALSE],

    [FALSE, ^exception_list_path, [14, 'EXCEPTION_LIST'], 14, 14, 0, exception, * , [10, '$EXCEPTION'],
          FALSE],

    [FALSE, ^object_library_path, [7, 'MODULE#'], 13, 43, 0, object_module, * , [8, '$LIBRARY'], FALSE],

    [FALSE, ^procedures_path, [15, 'LOAD_PROCEDURE#'], 16, 46, 0, load_procedure, * , [15, '$LOAD_PROCEDURE'],
          FALSE],

    [FALSE, ^procedures_path, [19, 'TERMINAL_PROCEDURE#'], 20, 50, 0, terminal_procedure, * , [19,
          '$TERMINAL_PROCEDURE'], FALSE],

    [FALSE, ^procedures_path, [15, 'USER_PROCEDURE#'], 16, 46, 0, user_procedure, * , [15, '$USER_PROCEDURE'],
          FALSE],

    [FALSE, ^validation_path, [13, 'VALIDATION#' CAT current_version], 14, 76, 0, validation, NIL]];

?? TITLE := 'exit_condition_handler', EJECT ??

  PROGRAM nap$file_access_me
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


    PROCEDURE exit_condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        local_status: ost$status,
        output_data: array [1 .. 1] of nat$data_fragment;

      nap$condition_handler_trace (condition, save_area);
      delete_titles;
      output_data [1].address := NIL;
      output_data [1].length := 0;
      WHILE connection_list <> NIL DO
        nap$gt_disconnect (connection_list^.connection_id, output_data, local_status);
        delete_connection (connection_list);
      WHILEND;
      nap$gt_close_sap (sap, local_status);

    PROCEND exit_condition_handler;
?? TITLE := 'nap$file_access_me', EJECT ??

    VAR
      activity_status: ost$activity_status,
      address: nat$internet_address,
      connection: ^connection_information,
      connect_buffer: [STATIC] SEQ (REP 20(16) of cell),
      connect_data: [STATIC] array [1 .. 1] of nat$data_fragment :=
            [[^connect_buffer, #SIZE (connect_buffer)]],
      connect_event: nat$gt_connect_event,
      data: ^SEQ ( * ),
      index: integer,
      input_pdu: ^SEQ ( * ),
      new_connection: ^connection_information,
      open_state_pdu: ^open_state_request_pdu,
      output_data: [STATIC] array [1 .. 1] of nat$data_fragment := [[NIL, 0]],
      request_pdu: ^request_header,
      sap: nat$gt_sap_identifier,
      sap_id: nat$internet_sap_identifier;

    process_parameters (parameter_list, title_list, max_connections, max_dumps, max_dump_size, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^exit_condition_handler);

    nap$gt_open_sap (max_connections, nac$system_message_priority, FALSE, sap, address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    register_titles (address, sap);

    ALLOCATE wait_list_seq: [[REP (max_connections + 1) OF nat$gt_activity]];
    RESET wait_list_seq;
    NEXT wait_list: [1 .. 1] IN wait_list_seq;

    wait_list^ [1].activity := nac$gt_await_connect_request;
    wait_list^ [1].sap_id := sap;
    nap$gt_receive_connect_event (sap, connect_data, osc$nowait, connect_event, activity_status, status);
    IF NOT status.normal THEN
      nap$display_message (status);
      EXIT nap$file_access_me;
    IFEND;

  /main_loop/
    WHILE (titles_registered > 0) OR (active_connections > 0) DO
      nap$gt_await_activity_complete (wait_list^, index, status);
      IF status.normal THEN
        output_data [1].address := NIL;
        output_data [1].length := 0;
        IF index = 1 THEN
          IF connect_event.source.kind = osi THEN
            #UNCHECKED_CONVERSION (connect_event.source.osi_address.
                  transport_sap_selector (1, connect_event.source.osi_address.transport_sap_selector_length),
                  sap_id);
          ELSE
            sap_id := connect_event.source.internet_address.sap;
          IFEND;
          IF activity_status.status.normal AND (sap_id = nac$xi_cdna_file_access_sap +
                nac$transport_sap_offset) AND (active_connections < max_connections) THEN
            ALLOCATE new_connection;
            IF new_connection = NIL THEN

{ allocate failed

              nap$gt_reject_connection (connect_event.connection, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
            ELSE
              new_connection^.state := open;
              new_connection^.connection_id := connect_event.connection;
              new_connection^.data_area [1].address := ^new_connection^.data_buffer;
              new_connection^.data_area [1].length := #SIZE (new_connection^.data_buffer);
              new_connection^.next_connection := connection_list;
              nap$gt_accept_connection (new_connection^.connection_id, output_data, NIL, status);
              IF status.normal THEN
                active_connections := active_connections + 1;

{! Statistics begin

                nap$increment_file_access_stats (1, active_connection);

{! Statistics end

                connection_list := new_connection;
                update_wait_list (connect_event.connection);
                temp_data_frag [1].address := new_connection^.data_area [1].address;
                temp_data_frag [1].length := new_connection^.data_area [1].length;
                nap$gt_receive_connection_event (new_connection^.connection_id, temp_data_frag, osc$nowait,
                      new_connection^.event, new_connection^.activity_status, status);
                IF NOT status.normal THEN
                  nap$display_message (status);
                  delete_connection (new_connection);
                IFEND;
              ELSE
                nap$display_message (status);
                FREE new_connection;
                nap$gt_reject_connection (connect_event.connection, output_data, status);
                IF NOT status.normal THEN
                  nap$display_message (status);
                IFEND;
              IFEND;
            IFEND;
          ELSEIF activity_status.status.normal THEN
            pmp$log ('FA - CONNECTION REJECTED', status);
            nap$gt_reject_connection (connect_event.connection, output_data, status);
            IF NOT status.normal THEN
              nap$display_message (status);
            IFEND;
          IFEND;
          nap$gt_receive_connect_event (sap, connect_data, osc$nowait, connect_event, activity_status,
                status);
          IF NOT status.normal THEN
            nap$display_message (status);
            EXIT nap$file_access_me;
          IFEND;
        ELSE
          find_connection (wait_list^ [index].receive_connection_id, connection);
          IF (connection <> NIL) AND connection^.activity_status.status.normal THEN
            CASE connection^.event.kind OF
            = nac$gt_data_event =
              CASE connection^.state OF
              = open =
                data := ^connection^.data_buffer;
                RESET data;
                NEXT input_pdu: [[REP connection^.event.data.data_length OF cell]] IN data;
                RESET input_pdu;
                NEXT open_state_pdu IN input_pdu;
                IF (open_state_pdu <> NIL) AND connection^.event.data.end_of_message AND
                      (#SIZE (open_state_pdu^) < connection^.event.data.data_length) AND
                      (open_state_pdu^.header.version_number = version) THEN
                  CASE open_state_pdu^.header.request_id OF

                  = create_request_id =
                    create_file (input_pdu, open_state_pdu, connection^);

                  = open_request_id =
                    open_file (input_pdu, open_state_pdu, connection^);

                  = delete_request_id =
                    delete_file (input_pdu, open_state_pdu, connection^);
                  ELSE
                    pmp$log ('FA - INVALID REQUEST FOR OPEN STATE', status);
                    nap$gt_disconnect (connection^.connection_id, output_data, status);
                    IF NOT status.normal THEN
                      nap$display_message (status);
                    IFEND;
                    delete_connection (connection);
                  CASEND;
                ELSE
                  pmp$log ('FA - INVALID PDU FOR OPEN STATE', status);
                  nap$gt_disconnect (connection^.connection_id, output_data, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                  IFEND;
                  delete_connection (connection);
                IFEND;

              = file_access =
                data := ^connection^.data_buffer;
                RESET data;
                NEXT input_pdu: [[REP connection^.event.data.data_length OF cell]] IN data;
                RESET input_pdu;
                NEXT request_pdu IN input_pdu;
                IF (request_pdu <> NIL) THEN
                  RESET input_pdu;
                  CASE request_pdu^.request_id OF

                  = close_request_id =
                    close_file (input_pdu, connection^);

                  = write_request_id =
                    write_file (input_pdu, connection^);

                  = read_request_id =
                    read_file (input_pdu, connection^);
                  ELSE
                    pmp$log ('FA - INVALID REQUEST FOR FILE_ACCESS STATE', status);
                    nap$gt_disconnect (connection^.connection_id, output_data, status);
                    IF NOT status.normal THEN
                      nap$display_message (status);
                    IFEND;
                    delete_connection (connection);
                  CASEND;
                ELSE
                  pmp$log ('FA - INVALID PDU FOR FILE_ACCESS STATE', status);
                  nap$gt_disconnect (connection^.connection_id, output_data, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                  IFEND;
                  delete_connection (connection);
                IFEND;

              = write_incomplete =

{ Data is written directly to the dump file.

                incomplete_write (connection^);
              ELSE
                pmp$log ('FA - INVALID STATE', status);
                nap$gt_disconnect (connection^.connection_id, output_data, status);
                IF NOT status.normal THEN
                  nap$display_message (status);
                IFEND;
                delete_connection (connection);
              CASEND;

            = nac$gt_expedited_data_event =
              pmp$log ('FA - X-DATA EVENT', status);
              nap$gt_disconnect (connection^.connection_id, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
              delete_connection (connection);

            = nac$gt_disconnect_event =
              delete_connection (connection);
              pmp$log ('FA - DISCONNECT EVENT', status);
            ELSE
              pmp$log ('FA - UNKNOWN GT EVENT', status);
              nap$gt_disconnect (connection^.connection_id, output_data, status);
              delete_connection (connection);
            CASEND;
          ELSE
            nap$gt_disconnect (wait_list^ [index].receive_connection_id, output_data, status);
            IF NOT status.normal THEN
              nap$display_message (status);
            IFEND;
            IF connection <> NIL THEN
              delete_connection (connection);
            ELSE
              pmp$log ('FA - EVENT ON NON-EXISTENT CONNECTION', status);
            IFEND;
          IFEND;
        IFEND;
      ELSE
        EXIT /main_loop/;
      IFEND;
    WHILEND /main_loop/;
  PROCEND nap$file_access_me;
?? TITLE := 'create_file', EJECT ??

  PROCEDURE create_file
    (VAR input_pdu: ^SEQ ( * );
     VAR create_pdu: ^open_state_request_pdu;
     VAR connection: connection_information);

    CONST
      dump_type_length = 4,
      system_length = 12,
      timestamp_length = 12;

    VAR
      create_response: create_response_pdu,
      dump_file_name: ost$name,
      file_type_available: boolean,
      network_file_name: ^string ( * ),
      network_file_name_length: 0 .. osc$max_string_size,
      opened: boolean,
      output_data: array [1 .. 1] of nat$data_fragment,
      path: ^pft$path,
      status: ost$status;

    create_response.header.response_id := create_response_id;
    connection.access_mode := create_pdu^.access_mode;
    connection.access_style := create_pdu^.header.access_style;
    network_file_name_length := #SIZE (input_pdu^) - #SIZE (create_pdu^);
    NEXT network_file_name: [network_file_name_length] IN input_pdu;
    get_file_info (network_file_name, path, connection.file_type, dump_file_name, status);
    IF status.normal THEN
      CASE connection.file_type OF
      = dump =
        IF connection.access_mode = am$write THEN
          nap$open_di_dump_file (dump_file_name (dump_type_length + 2, system_length),
                dump_file_name (dump_type_length + system_length + 3, timestamp_length),
                dump_file_name (1, dump_type_length), max_dumps, max_dump_size, connection.file_id,
                connection.file_data, opened, status);
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$invalid_access_mode, network_file_name^, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (nac$status_id, nae$invalid_file_access_request, network_file_name^, status);
      CASEND;
    IFEND;
    output_data [1].address := ^create_response;
    output_data [1].length := #SIZE (create_response);
    create_response.header.normal := status.normal;
    IF status.normal THEN
      create_response.header.response_code := normal_response;
      connection.file_size := 0;
      connection.current_position := 0;
      connection.state := file_access;
      nap$gt_send_data (connection.connection_id, output_data, TRUE, osc$wait, connection.activity_status,
            status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      temp_data_frag [1].address := connection.data_area [1].address;
      temp_data_frag [1].length := connection.data_area [1].length;
      nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait, connection.event,
            connection.activity_status, status);
      IF NOT status.normal THEN
        nap$display_message (status);
        delete_connection (^connection);
      IFEND;
    ELSE
      CASE status.condition OF
      = nae$invalid_file_access_request =
        create_response.header.response_code := file_service_unavailable;
      = nae$invalid_access_mode =
        create_response.header.response_code := security_error;
      = nae$bad_file_access_file_name, pfe$bad_last_subcatalog_name, pfe$bad_nth_subcatalog_name,
            pfe$bad_permanent_file_name =
        create_response.header.response_code := bad_file_name;
      = nae$max_files_reached =
        create_response.header.response_code := insufficient_space;
      ELSE
        create_response.header.response_code := unrecoverable_io_error;
        check_file_type_availability (connection.file_type, file_type_available);
      CASEND;
      nap$display_message (status);
      nap$gt_disconnect (connection.connection_id, output_data, status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      delete_connection (^connection);
    IFEND;
  PROCEND create_file;
?? TITLE := 'open_file', EJECT ??

  PROCEDURE open_file
    (VAR input_pdu: ^SEQ ( * );
     VAR open_pdu: ^open_state_request_pdu;
     VAR connection: connection_information);

    CONST
      max_card_type_length = 4,
      object_code_version_length = 4;

    VAR
      card_name: string (max_card_type_length),
      card_type: nat$card_type,
      file_type_available: boolean,
      item_name: ost$name,
      network_file_name: ^string ( * ),
      network_file_name_length: 0 .. osc$max_string_size,
      opened: boolean,
      open_response: open_response_pdu,
      output_data: array [1 .. 1] of nat$data_fragment,
      path: ^pft$path,
      status: ost$status;

    connection.access_mode := open_pdu^.access_mode;
    connection.access_style := open_pdu^.header.access_style;
    network_file_name_length := #SIZE (input_pdu^) - #SIZE (open_pdu^);
    NEXT network_file_name: [network_file_name_length] IN input_pdu;
    get_file_info (network_file_name, path, connection.file_type, item_name, status);
    IF status.normal THEN
      IF connection.access_mode = am$read THEN
        CASE connection.file_type OF
        = boot =
          card_name := item_name (object_code_version_length + 2, max_card_type_length);
          IF card_name = 'ESCI' THEN
            card_type := nac$esci_boot_card;
          ELSEIF card_name = 'HDLC' THEN
            card_type := nac$cim_boot_card;
          ELSEIF card_name = 'MCI ' THEN
            card_type := nac$mci_boot_card;
          ELSE
            osp$set_status_abnormal (nac$status_id, nae$invalid_file_access_request, network_file_name^,
                  status);
          IFEND;
          IF status.normal THEN
            nap$open_di_load_file (item_name (1, object_code_version_length), card_type, connection.file_id,
                  connection.file_data, opened, status);
          IFEND;
        = exception, domain_name_server =
          open_sequential_file (path^, connection.file_id, connection.file_data, status);
        = entry_point =
          nap$open_entry_point (path^, item_name, connection.file_id, connection.file_data, connection.lfn,
                status);
        = object_module =
          nap$open_module (path^, item_name, connection.file_id, connection.file_data, connection.lfn,
                status);
        = configuration, load_procedure, terminal_procedure, user_procedure =
          open_scl_procedure (path^, item_name, connection.file_id, connection.file_data, status);
        = validation =
          open_validation_procedure (path^, item_name, connection.file_data, status);
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$invalid_file_access_request, network_file_name^,
                status);
        CASEND;
      ELSE
        osp$set_status_abnormal (nac$status_id, nae$invalid_access_mode, network_file_name^, status);
      IFEND;
    IFEND;
    output_data [1].address := ^open_response;
    output_data [1].length := #SIZE (open_response);
    open_response.header.response_id := open_response_id;
    open_response.header.normal := status.normal;
    IF status.normal THEN

{! Statistics begin

      nap$increment_file_access_stats (1, file_access_request);

{! Statistics end

      open_response.header.response_code := normal_response;
      connection.file_size := #SIZE (connection.file_data^);
      open_response.file_size := connection.file_size;
      connection.current_position := 0;
      connection.state := file_access;
      nap$gt_send_data (connection.connection_id, output_data, TRUE, osc$wait, connection.activity_status,
            status);
      temp_data_frag [1].address := connection.data_area [1].address;
      temp_data_frag [1].length := connection.data_area [1].length;
      nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait, connection.event,
            connection.activity_status, status);
      IF NOT status.normal THEN
        nap$display_message (status);
        delete_connection (^connection);
      IFEND;
    ELSE
      open_response.file_size := 0;
      CASE status.condition OF
      = nae$invalid_file_access_request =
        open_response.header.response_code := file_service_unavailable;
      = nae$invalid_access_mode, pfe$usage_not_permitted, pfe$incorrect_password, pfe$bad_password =
        open_response.header.response_code := security_error;
      = nae$bad_file_access_file_name, pfe$bad_last_subcatalog_name, pfe$bad_nth_subcatalog_name,
            pfe$bad_permanent_file_name, nae$invalid_user_name =
        open_response.header.response_code := bad_file_name;
      = pfe$pf_system_error, nae$record_size_overflow, amc$min_ecc_validation .. amc$max_ecc_program_action =
        open_response.header.response_code := unrecoverable_io_error;
      ELSE
        open_response.header.response_code := file_does_not_exist;
        check_file_type_availability (connection.file_type, file_type_available);
      CASEND;
      IF status.condition <> nae$invalid_user_name THEN
        nap$display_message (status);
      IFEND;
      nap$gt_disconnect (connection.connection_id, output_data, status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      delete_connection (^connection);
    IFEND;
  PROCEND open_file;
?? TITLE := 'delete_file', EJECT ??

  PROCEDURE delete_file
    (VAR input_pdu: ^SEQ ( * );
     VAR delete_pdu: ^open_state_request_pdu;
     VAR connection: connection_information);

    VAR
      delete_response: delete_response_pdu,
      file_type_available: boolean,
      network_file_name: ^string ( * ),
      network_file_name_length: 0 .. osc$max_string_size,
      lowest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$lowest_cycle],
      password: [STATIC, READ] pft$password := ' ',
      output_data: array [1 .. 1] of nat$data_fragment,
      path: ^pft$path,
      status: ost$status,
      unused_name_param: ost$name;

{ NO DELETES OF ANY FILES ARE CURRENTLY ALLOWED

    output_data [1].address := ^delete_response;
    output_data [1].length := #SIZE (delete_response);
    delete_response.header.response_id := delete_response_id;
    delete_response.header.normal := FALSE;
    delete_response.header.response_code := security_error;
    nap$gt_disconnect (connection.connection_id, output_data, status);
    IF NOT status.normal THEN
      nap$display_message (status);
    IFEND;
    delete_connection (^connection);

{   network_file_name_length := #SIZE (input_pdu^) - #SIZE (delete_pdu^);
{   NEXT network_file_name: [network_file_name_length] IN input_pdu;
{   get_file_info (network_file_name, path, connection.file_type, unused_name_param, status);
{   IF status.normal THEN
{     pfp$purge (path^, lowest_cycle, password, status);
{   IFEND;
{   output_data [1].address := ^delete_response;
{   output_data [1].length := #SIZE (delete_response);
{   delete_response.header.response_id := delete_response_id;
{   delete_response.header.normal := status.normal;
{   IF status.normal THEN
{     delete_response.header.response_code := normal_response;
{   ELSE
{     CASE status.condition OF
{     = nae$invalid_file_access_request =
{       delete_response.header.response_code := file_service_unavailable;
{     = nae$bad_file_access_file_name, pfe$bad_last_subcatalog_name, pfe$bad_nth_subcatalog_name,
{           pfe$bad_permanent_file_name =
{       open_response.header.response_code := bad_file_name;
{     = pfe$pf_system_error =
{       delete_response.header.response_code := unrecoverable_io_error;
{     = pfe$usage_not_permitted, pfe$incorrect_password, pfe$bad_password =
{       delete_response.header.response_code := security_error;
{     ELSE
{       delete_response.header.response_code := file_does_not_exist;
{       check_file_type_availability (connection.file_type, file_type_available);
{     CASEND;
{     nap$display_message (status);
{   IFEND;
{   nap$gt_disconnect (connection.connection_id, output_data, status);
{   IF NOT status.normal THEN
{     nap$display_message (status);
{   IFEND;
{   delete_connection (^connection);

  PROCEND delete_file;
?? TITLE := 'close_file', EJECT ??

  PROCEDURE close_file
    (VAR input_pdu: ^SEQ ( * );
     VAR connection: connection_information);

    VAR
      close_pdu: ^close_request_pdu,
      close_response: close_response_pdu,
      entire_file: ^SEQ ( * ),
      file_name: amt$local_file_name,
      local_status: ost$status,
      output_data: array [1 .. 1] of nat$data_fragment,
      segment_pointer: amt$segment_pointer,
      status: ost$status;

    status.normal := TRUE;
    output_data [1].address := NIL;
    output_data [1].length := 0;
    NEXT close_pdu IN input_pdu;
    IF (close_pdu <> NIL) AND connection.event.data.end_of_message THEN
      IF (connection.file_type <> entry_point) AND (connection.file_type <> object_module) THEN
        IF connection.access_mode <> am$read THEN
          RESET connection.file_data;
          NEXT entire_file: [[REP connection.file_size OF cell]] IN connection.file_data;
          segment_pointer.kind := amc$sequence_pointer;
          segment_pointer.sequence_pointer := connection.file_data;
          amp$set_segment_eoi (connection.file_id, segment_pointer, status);
        IFEND;
        IF connection.file_type <> validation THEN
          file_name := baf$task_file_entry_p (connection.file_id)^.local_file_name;
          fsp$close_file (connection.file_id, local_status);
          amp$return (file_name, local_status);
        ELSEIF connection.file_data <> NIL THEN
          FREE connection.file_data;
          local_status.normal := TRUE;
        IFEND;
      ELSE
        pmp$close_object_library (connection.file_id, local_status);
        amp$return (connection.lfn, local_status);
      IFEND;
      connection.state := closed;
      IF status.normal THEN
        status := local_status;
      IFEND;
      output_data [1].address := ^close_response;
      output_data [1].length := #SIZE (close_response);
      close_response.header.response_id := close_response_id;
      close_response.header.normal := status.normal;
      IF status.normal THEN
        close_response.header.response_code := normal_response;
      ELSE
        close_response.header.response_code := unrecoverable_io_error;
        nap$display_message (status);
      IFEND;
    IFEND;
    nap$gt_disconnect (connection.connection_id, output_data, status);
    IF NOT status.normal THEN
      nap$display_message (status);
    IFEND;
    delete_connection (^connection);
  PROCEND close_file;
?? TITLE := 'write_file', EJECT ??

  PROCEDURE write_file
    (VAR input_pdu: ^SEQ ( * );
     VAR connection: connection_information);

    VAR
      output_data: array [1 .. 1] of nat$data_fragment,
      status: ost$status,
      write_block: ^SEQ ( * ),
      write_block_size: 0 .. max_data_block,
      write_data: ^SEQ ( * ),
      write_length: 0 .. max_data_block,
      write_pdu: ^write_request_pdu,
      write_response: write_response_pdu;

    NEXT write_pdu IN input_pdu;
    IF write_pdu <> NIL THEN
      connection.write_error := FALSE;
      IF connection.access_style = as$random THEN
        IF write_pdu^.file_position <> connection.current_position THEN
          connection.current_position := write_pdu^.file_position;
          RESET connection.file_data;
          NEXT write_data: [[REP write_pdu^.file_position OF cell]] IN connection.file_data;
        IFEND;
      IFEND;
      write_length := #SIZE (input_pdu^) - #SIZE (write_pdu^);
      NEXT write_data: [[REP write_length OF cell]] IN input_pdu;
      perform_write (write_data, connection.file_data, status);
      IF NOT status.normal THEN
        connection.write_error := TRUE;
        nap$display_message (status);
      ELSE
        connection.current_position := connection.current_position + write_length;
        IF connection.current_position > connection.file_size THEN
          connection.file_size := connection.current_position;
        IFEND;
      IFEND;
      IF connection.event.data.end_of_message THEN
        output_data [1].address := ^write_response;
        output_data [1].length := #SIZE (write_response);
        write_response.header.response_id := write_response_id;
        IF connection.write_error THEN
          write_response.header.normal := FALSE;
          write_response.header.response_code := insufficient_space;
        ELSE
          write_response.header.normal := TRUE;
          write_response.header.response_code := normal_response;
        IFEND;
        write_response.file_position := connection.current_position;
        nap$gt_send_data (connection.connection_id, output_data, TRUE, osc$wait, connection.activity_status,
              status);
        IF NOT status.normal THEN
          nap$display_message (status);
        IFEND;
        temp_data_frag [1].address := connection.data_area [1].address;
        temp_data_frag [1].length := connection.data_area [1].length;
        nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait,
              connection.event, connection.activity_status, status);
        IF NOT status.normal THEN
          nap$display_message (status);
          delete_connection (^connection);
        IFEND;
      ELSE
        connection.state := write_incomplete;
        IF max_dump_size - connection.file_size < max_data_block THEN
          write_block_size := max_dump_size - connection.file_size;
          IF write_block_size = 0 THEN
            connection.write_error := TRUE;
            osp$set_status_condition (nae$write_beyond_file_limit, status);
            nap$display_message (status);
          IFEND;
        ELSE
          write_block_size := max_data_block;
        IFEND;
        IF connection.write_error THEN
          connection.data_area [1].address := ^trash_container;
          connection.data_area [1].length := #SIZE (trash_container);
        ELSE
          NEXT write_block: [[REP write_block_size OF cell]] IN connection.file_data;
          connection.data_area [1].address := write_block;
          connection.data_area [1].length := write_block_size;
        IFEND;
        temp_data_frag [1].address := connection.data_area [1].address;
        temp_data_frag [1].length := connection.data_area [1].length;
        nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait,
              connection.event, connection.activity_status, status);
        IF NOT status.normal THEN
          nap$display_message (status);
          delete_connection (^connection);
        IFEND;
      IFEND;
    ELSE
      output_data [1].address := NIL;
      output_data [1].length := 0;
      nap$gt_disconnect (connection.connection_id, output_data, status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      delete_connection (^connection);
    IFEND;
  PROCEND write_file;
?? TITLE := 'read_file', EJECT ??

  PROCEDURE read_file
    (VAR input_pdu: ^SEQ ( * );
     VAR connection: connection_information);

    VAR
      data_transferred: 0 .. 0ffff(16),
      output_data: array [1 .. 2] of nat$data_fragment,
      read_data: ^SEQ ( * ),
      read_pdu: ^read_request_pdu,
      read_response: read_response_pdu,
      status: ost$status;

    NEXT read_pdu IN input_pdu;
    IF (read_pdu <> NIL) AND connection.event.data.end_of_message THEN
      read_response.header.eoi := FALSE;
      read_response.header.response_id := read_response_id;
      read_data := NIL;
      data_transferred := 0;
      IF read_pdu^.length > 0 THEN
        IF connection.access_style = as$random THEN
          IF read_pdu^.file_position <> connection.current_position THEN
            IF read_pdu^.file_position > connection.file_size THEN
              connection.current_position := connection.file_size;
            ELSE
              connection.current_position := read_pdu^.file_position;
            IFEND;
            RESET connection.file_data;
            NEXT read_data: [[REP connection.current_position OF cell]] IN connection.file_data;
          IFEND;
        IFEND;
        IF connection.current_position + read_pdu^.length >= connection.file_size THEN
          read_response.header.eoi := TRUE;
          data_transferred := connection.file_size - connection.current_position;
        ELSE
          data_transferred := read_pdu^.length;
        IFEND;
        IF data_transferred > 0 THEN
          NEXT read_data: [[REP data_transferred OF cell]] IN connection.file_data;
          connection.current_position := connection.current_position + data_transferred;
        IFEND;
      IFEND;
      output_data [1].address := ^read_response;
      output_data [1].length := #SIZE (read_response);
      output_data [2].address := read_data;
      output_data [2].length := data_transferred;
      read_response.header.normal := TRUE;
      read_response.header.response_code := normal_response;
      read_response.file_position := connection.current_position;
      nap$gt_send_data (connection.connection_id, output_data, TRUE, osc$wait, connection.activity_status,
            status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      temp_data_frag [1].address := connection.data_area [1].address;
      temp_data_frag [1].length := connection.data_area [1].length;
      nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait, connection.event,
            connection.activity_status, status);
      IF NOT status.normal THEN
        nap$display_message (status);
        delete_connection (^connection);
      IFEND;
    ELSE
      output_data [1].address := NIL;
      output_data [1].length := 0;
      output_data [2].address := NIL;
      output_data [2].length := 0;
      nap$gt_disconnect (connection.connection_id, output_data, status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      delete_connection (^connection);
    IFEND;
  PROCEND read_file;

?? TITLE := 'incomplete_write', EJECT ??

  PROCEDURE incomplete_write
    (VAR connection: connection_information);

    VAR
      output_data: array [1 .. 1] of nat$data_fragment,
      status: ost$status,
      write_file: ^SEQ ( * ),
      write_response: write_response_pdu;

    IF NOT connection.write_error THEN
      connection.current_position := connection.current_position + connection.event.data.data_length;
      IF connection.current_position > connection.file_size THEN
        connection.file_size := connection.current_position;
      IFEND;
      RESET connection.file_data;
      NEXT write_file: [[REP connection.file_size OF cell]] IN connection.file_data;
    IFEND;
    IF connection.event.data.end_of_message THEN
      output_data [1].address := ^write_response;
      output_data [1].length := #SIZE (write_response);
      write_response.header.response_id := write_response_id;
      IF connection.write_error THEN
        write_response.header.normal := FALSE;
        write_response.header.response_code := insufficient_space;
      ELSE
        write_response.header.normal := TRUE;
        write_response.header.response_code := 0;
      IFEND;
      write_response.file_position := connection.current_position;
      nap$gt_send_data (connection.connection_id, output_data, TRUE, osc$wait, connection.activity_status,
            status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
      connection.state := file_access;
      connection.data_area [1].address := ^connection.data_buffer;
      connection.data_area [1].length := #SIZE (connection.data_buffer);
    ELSE
      IF NOT connection.write_error THEN
        connection.write_error := TRUE;
        connection.data_area [1].address := ^trash_container;
        connection.data_area [1].length := #SIZE (trash_container);
        osp$set_status_condition (nae$write_beyond_file_limit, status);
        nap$display_message (status);
      IFEND;
    IFEND;
    temp_data_frag [1].address := connection.data_area [1].address;
    temp_data_frag [1].length := connection.data_area [1].length;
    nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait, connection.event,
          connection.activity_status, status);
    IF NOT status.normal THEN
      nap$display_message (status);
      delete_connection (^connection);
    IFEND;

  PROCEND incomplete_write;

?? TITLE := 'check_file_type_availability', EJECT ??

  PROCEDURE check_file_type_availability
    (    file_type: network_file_type;
     VAR file_type_available: boolean);

    VAR
      high_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      local_status: ost$status,
      name: ost$name,
      password: [STATIC, READ] pft$password := ' ',
      path: ^pft$path,
      share: [STATIC, READ] pft$share_selections := [pfc$read],
      usage: [STATIC, READ] pft$usage_selections := [pfc$read];

{ File types 'object_module', 'entry_point', 'boot' and 'dump' are mapped into the
{ same check. This is because of the fact that the non-existance of a
{ specific subcatalog does not imply that the file type is unavailable. So for the
{ above mentioned file types the only check to be made is that the path:
{ $SYSTEM.CDCNET exists.
{ File type 'domain_name_server' checks specifically for the presence of the
{ $SYSTEM.TCP_IP.DNS catalog, but cannot check for the existence
{ of specific zone files, nor is the name of the boot file static (it can be
{ specified when the server is booted).

    pmp$get_unique_name (name, local_status);
    path := title_list [file_type].path;

    CASE file_type OF
    = load_procedure =
      path^ [UPPERBOUND (path^)] := nac$load_procedures;
    = terminal_procedure =
      path^ [UPPERBOUND (path^)] := nac$terminal_procedures;
    = user_procedure =
      path^ [UPPERBOUND (path^)] := nac$user_procedures;
    = boot, dump, entry_point, object_module =
      path := ^min_file_path;
      path^ [UPPERBOUND (path^)] := name;
    = domain_name_server =
      path^ [UPPERBOUND (path^)] := name;
    ELSE
    CASEND;

    pfp$attach (name, path^, high_cycle, password, usage, share, pfc$no_wait, local_status);

    CASE file_type OF
    = configuration, exception, load_procedure, terminal_procedure, user_procedure =
      IF local_status.normal OR (local_status.condition = pfe$cycle_busy) THEN
        file_type_available := TRUE;
        IF local_status.normal THEN
          amp$return (name, local_status);
        IFEND;
      ELSE
        file_type_available := FALSE;
      IFEND;
    = boot, domain_name_server, dump, entry_point, object_module =
      file_type_available := (local_status.condition <> pfe$unknown_last_subcatalog) AND
            (local_status.condition <> pfe$unknown_nth_subcatalog);
    ELSE
    CASEND;
    IF (NOT file_type_available) AND title_list [file_type].title_registered THEN
      nlp$delete_registered_title (title_list [file_type].title.value (1, title_list [file_type].title.size),
            title_list [file_type].password, title_list [file_type].directory_identifier, local_status);
      IF local_status.normal THEN
        title_list [file_type].title_registered := FALSE;
        titles_registered := titles_registered - 1;
        osp$set_status_abnormal (nac$status_id, nae$file_type_unavailable, title_list [file_type].title.
              value (2, * ), local_status);
      IFEND;
      nap$display_message (local_status);
    IFEND;
  PROCEND check_file_type_availability;
?? TITLE := 'delete_connection', EJECT ??

  PROCEDURE delete_connection
    (    connect_info: ^connection_information);

    VAR
      connection: ^connection_information,
      connection_link: ^^connection_information,
      entire_file: ^SEQ ( * ),
      file_name: amt$local_file_name,
      i: 1 .. nac$max_connections,
      local_status: ost$status,
      segment_pointer: amt$segment_pointer;

    connection := connect_info;

  /forloop/
    FOR i := 2 TO UPPERBOUND (wait_list^) DO
      IF (wait_list^ [i].activity = nac$gt_await_receive_event) AND
            (wait_list^ [i].receive_connection_id = connection^.connection_id) THEN
        wait_list^ [i].activity := nac$gt_null_activity;
        EXIT /forloop/;
      IFEND;
    FOREND /forloop/;
    IF i = UPPERBOUND (wait_list^) THEN
      WHILE wait_list^ [i].activity = nac$gt_null_activity DO
        i := i - 1;
      WHILEND;
      RESET wait_list_seq;
      NEXT wait_list: [1 .. i] IN wait_list_seq;
    IFEND;

    IF (connection^.state = file_access) OR (connection^.state = write_incomplete) THEN
      IF (connection^.file_type <> entry_point) AND (connection^.file_type <> object_module) THEN
        IF connection^.access_mode <> am$read THEN
          RESET connection^.file_data;
          NEXT entire_file: [[REP connection^.file_size OF cell]] IN connection^.file_data;
          segment_pointer.kind := amc$sequence_pointer;
          segment_pointer.sequence_pointer := connection^.file_data;
          amp$set_segment_eoi (connection^.file_id, segment_pointer, local_status);
        IFEND;
        IF connection^.file_type <> validation THEN
          file_name := baf$task_file_entry_p (connection^.file_id)^.local_file_name;
          fsp$close_file (connection^.file_id, local_status);
          amp$return (file_name, local_status);
        ELSEIF connection^.file_data <> NIL THEN
          FREE connection^.file_data;
        IFEND;
      ELSE
        pmp$close_object_library (connection^.file_id, local_status);
        amp$return (connection^.lfn, local_status);
      IFEND;
    IFEND;
    connection_link := ^connection_list;
    WHILE (connection_link^ <> NIL) AND (connection_link^ <> connection) DO
      connection_link := ^connection_link^^.next_connection;
    WHILEND;
    IF connection_link^ <> NIL THEN
      connection_link^ := connection^.next_connection;
      FREE connection;
      active_connections := active_connections - 1;

{! Statistics begin

      nap$increment_file_access_stats (-1, active_connection);

{! Statistics end

    IFEND;
  PROCEND delete_connection;

?? TITLE := 'delete_titles', EJECT ??

  PROCEDURE delete_titles;

    VAR
      i: network_file_type,
      j: integer,
      local_status: ost$status;

    FOR i := LOWERBOUND (title_list) TO UPPERBOUND (title_list) DO
      IF i = validation THEN
        IF title_list [i].validation_info <> NIL THEN
          FOR j := LOWERBOUND (title_list [i].validation_info^) TO UPPERBOUND (title_list [i].
                validation_info^) DO
            IF title_list [i].validation_info^ [j].title_registered THEN
              nlp$delete_registered_title (title_list [i].validation_info^ [j].title.value (1,
                    title_list [i].validation_info^ [j].title.size), title_list [i].password,
                    title_list [i].validation_info^ [j].directory_identifier, local_status);
              IF local_status.normal THEN
                title_list [i].validation_info^ [j].title_registered := FALSE;
                titles_registered := titles_registered - 1;
              ELSE
                nap$display_message (local_status);
              IFEND;
            IFEND;
          FOREND;
        IFEND;
      ELSEIF title_list [i].title_registered THEN
        nlp$delete_registered_title (title_list [i].title.value (1, title_list [i].title.size),
              title_list [i].password, title_list [i].directory_identifier, local_status);
        IF local_status.normal THEN
          title_list [i].title_registered := FALSE;
          titles_registered := titles_registered - 1;
        ELSE
          nap$display_message (local_status);
        IFEND;
      IFEND;
    FOREND;
  PROCEND delete_titles;

?? TITLE := 'find_connection', EJECT ??

  PROCEDURE [INLINE] find_connection
    (    connection_id: nat$gt_connection_id;
     VAR connection: ^connection_information);

    connection := connection_list;
    WHILE (connection <> NIL) AND (connection^.connection_id <> connection_id) DO
      connection := connection^.next_connection;
    WHILEND;
  PROCEND find_connection;

?? TITLE := 'get_domain_and_user', EJECT ??

  PROCEDURE get_domain_and_user
    (    network_fn: ^string ( * );
     VAR domain_name: ost$name;
     VAR user_name: ost$name;
     VAR status: ost$status);

    VAR
      i: integer,
      j: integer;

    status.normal := TRUE;
    i := 1;

{ Skip 'VALIDATION#vv_'

    WHILE (i <= STRLENGTH (network_fn^)) AND (network_fn^ (i) <> '_') DO
      i := i + 1;
    WHILEND;

    i := i + 1;

    IF i < STRLENGTH (network_fn^) THEN
      j := i;
      WHILE (j <= STRLENGTH (network_fn^)) AND (network_fn^ (j) <> '@') DO
        j := j + 1;
      WHILEND;
      IF (j < STRLENGTH (network_fn^)) THEN
        user_name := osc$null_name;
        user_name := network_fn^ (i, j - i);
        domain_name := osc$null_name;
        domain_name := network_fn^ (j + 1, STRLENGTH (network_fn^) - j);
      ELSE
        osp$set_status_abnormal (nac$status_id, nae$bad_file_access_file_name, network_fn^, status);
      IFEND;
    ELSE
      osp$set_status_abnormal (nac$status_id, nae$bad_file_access_file_name, network_fn^, status);
    IFEND;

  PROCEND get_domain_and_user;

?? TITLE := 'get_file_info', EJECT ??

  PROCEDURE get_file_info
    (    network_file_name: ^string ( * );
     VAR path: ^pft$path;
     VAR file_type: network_file_type;
     VAR item_name: ost$name;
     VAR status: ost$status);

    CONST
      config_proc_name_prefix = 'SYSTEM_',
      config_proc_name_prefix_size = 7,
      version_catalog_prefix_size = 8,
      version_length = 4;

    VAR
      domain_name: ost$name,
      i: network_file_type,
      user_name: ost$name;

    osp$set_status_abnormal (nac$status_id, nae$invalid_file_access_request, network_file_name^, status);

  /loop1/
    FOR i := LOWERBOUND (title_list) TO UPPERBOUND (title_list) DO
      IF network_file_name^ (1, title_list [i].network_fn_pattern.size) = title_list [i].
            network_fn_pattern.value THEN
        IF (STRLENGTH (network_file_name^) >= title_list [i].min_file_name_size) AND
              (STRLENGTH (network_file_name^) <= title_list [i].max_file_name_size) THEN
          path := title_list [i].path;
          file_type := title_list [i].file_type;
          CASE file_type OF
          = boot, dump =
            item_name := network_file_name^ (title_list [i].network_fn_pattern.size + 1, * );
          = configuration =
            item_name := config_proc_name_prefix;
            item_name (config_proc_name_prefix_size + 1, * ) :=
                  network_file_name^ (title_list [i].network_fn_pattern.size + 1, * );
          = domain_name_server =
            item_name := network_file_name^ (title_list [i].network_fn_pattern.size + 1, * );
            path^ [UPPERBOUND (path^)] := item_name;
          = entry_point, object_module =
            path^ [UPPERBOUND (path^) - 1] (version_catalog_prefix_size + 1,
                  version_length) := network_file_name^ (title_list [i].network_fn_pattern.size + 1,
                  version_length);
            item_name := network_file_name^ (title_list [i].network_fn_pattern.size + 1 + version_length +
                  1, * );
          = load_procedure =
            path^ [UPPERBOUND (path^)] := nac$load_procedures;
            item_name := network_file_name^ (title_list [i].network_fn_pattern.size + 1, * );
          = terminal_procedure =
            path^ [UPPERBOUND (path^)] := nac$terminal_procedures;
            item_name := network_file_name^ (title_list [i].network_fn_pattern.size + 1, * );
          = user_procedure =
            path^ [UPPERBOUND (path^)] := nac$user_procedures;
            item_name := network_file_name^ (title_list [i].network_fn_pattern.size + 1, * );
          = validation =
            get_domain_and_user (network_file_name, domain_name, user_name, status);
            IF status.normal THEN
              path^ [UPPERBOUND (path^) - 1] := domain_name;
              item_name := user_name;
            ELSE
              EXIT /loop1/;
            IFEND;
          ELSE
          CASEND;
          status.normal := TRUE;
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$bad_file_access_file_name, network_file_name^, status);
        IFEND;
        EXIT /loop1/
      IFEND;
    FOREND /loop1/;

  PROCEND get_file_info;


?? TITLE := 'get_validation_titles', EJECT ??

  PROCEDURE get_validation_titles
    (VAR titles: ^array [1 .. * ] of validation_title_info;
     VAR status: ost$status);

    VAR
      catalog_content_info: amt$segment_pointer,
      cycle_array: pft$p_cycle_array,
      end_of_directory: ^integer,
      group: pft$group,
      i: integer,
      index: integer,
      item_record: pft$p_info_record,
      new_title: title_string,
      path: ^pft$path,
      p_catalog_directory: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      p_subcatalog_directory: pft$p_directory_array,
      subcatalog_path: ^pft$path,
      subdirectory_record: pft$p_info_record,
      subindex: integer,
      temp_titles: ^array [1 .. * ] of validation_title_info,
      title_size: integer;


    status.normal := TRUE;
    titles := NIL;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, catalog_content_info, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    group.group_type := pfc$member;
    group.member_description.family := osc$null_name;
    group.member_description.account := osc$null_name;
    group.member_description.project := osc$null_name;
    group.member_description.user := osc$null_name;

    PUSH path: [LOWERBOUND (validation_path) .. UPPERBOUND (validation_path) - 2];
    PUSH subcatalog_path: [LOWERBOUND (validation_path) .. UPPERBOUND (validation_path) - 1];
    FOR i := LOWERBOUND (path^) TO UPPERBOUND (path^) DO
      path^ [i] := validation_path [i];
      subcatalog_path^ [i] := validation_path [i];
    FOREND;

    RESET catalog_content_info.sequence_pointer;
    pfp$get_multi_item_info (path^, group, -$pft$catalog_info_selections [], -$pft$file_info_selections [],
          catalog_content_info.sequence_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT end_of_directory IN catalog_content_info.sequence_pointer;
    RESET catalog_content_info.sequence_pointer;
    pfp$find_next_info_record (catalog_content_info.sequence_pointer, p_info_record, status);
    IF status.normal THEN
      pfp$find_directory_array (p_info_record, p_catalog_directory, status);
      IF (status.normal) AND (p_catalog_directory <> NIL) THEN

      /scan_directory/
        FOR index := LOWERBOUND (p_catalog_directory^) TO UPPERBOUND (p_catalog_directory^) DO
          CASE p_catalog_directory^ [index].name_type OF
          = pfc$catalog_name =
            RESET catalog_content_info.sequence_pointer TO end_of_directory;
            subcatalog_path^ [UPPERBOUND (subcatalog_path^)] := p_catalog_directory^ [index].name;
            pfp$get_multi_item_info (subcatalog_path^, group, -$pft$catalog_info_selections [],
                  -$pft$file_info_selections [], catalog_content_info.sequence_pointer, status);
            IF NOT status.normal THEN
              CYCLE /scan_directory/;
            IFEND;
            RESET catalog_content_info.sequence_pointer TO end_of_directory;
            pfp$find_next_info_record (catalog_content_info.sequence_pointer, subdirectory_record, status);
            IF status.normal THEN
              pfp$find_directory_array (subdirectory_record, p_subcatalog_directory, status);
              IF (status.normal) AND (p_subcatalog_directory <> NIL) THEN
                FOR subindex := LOWERBOUND (p_subcatalog_directory^)
                      TO UPPERBOUND (p_subcatalog_directory^) DO
                  IF (p_subcatalog_directory^ [subindex].name_type = pfc$file_name) AND
                        (p_subcatalog_directory^ [subindex].name = nac$validation_library_name) THEN
                    pfp$find_direct_info_record (^subdirectory_record^.body,
                          p_subcatalog_directory^ [subindex].info_offset, item_record, status);
                    pfp$find_cycle_array (item_record, cycle_array, status);
                    IF status.normal THEN
                      IF (UPPERBOUND (cycle_array^) > 1) OR (cycle_array^ [1].cycle_number > 1) THEN
                        STRINGREP (new_title.value, title_size, '$VALIDATION#', current_version, '@',
                              p_catalog_directory^ [index].name (1, clp$trimmed_string_size (
                              p_catalog_directory^ [index].name)));
                        new_title.size := title_size;
                        IF titles <> NIL THEN
                          ALLOCATE temp_titles: [1 .. UPPERBOUND (titles^) + 1];
                          FOR i := 1 TO UPPERBOUND (titles^) DO
                            temp_titles^ [i] := titles^ [i];
                          FOREND;
                          temp_titles^ [UPPERBOUND (titles^) + 1].title := new_title;
                          temp_titles^ [UPPERBOUND (titles^) + 1].title_registered := FALSE;
                          FREE titles;
                          titles := temp_titles;
                        ELSE
                          ALLOCATE titles: [1 .. 1];
                          titles^ [1].title := new_title;
                          titles^ [1].title_registered := FALSE;
                        IFEND;
                      ELSE

{ Warning message??????

                      IFEND;
                    IFEND;
                    CYCLE /scan_directory/;
                  IFEND;
                FOREND;
              IFEND;
            IFEND;

          = pfc$file_name =
            ; { Do nothing - skip this file entry

          ELSE
          CASEND;
        FOREND /scan_directory/;
      IFEND;
    IFEND;

    mmp$delete_scratch_segment (catalog_content_info, status);

  PROCEND get_validation_titles;

?? TITLE := 'register_titles', EJECT ??

  PROCEDURE register_titles
    (    address: nat$internet_address;
         sap: nat$gt_sap_identifier);

    VAR
      class: nat$title_class,
      distribute: boolean,
      domain: nat$title_domain,
      file_type_available: boolean,
      i: network_file_type,
      j: integer,
      local_status: ost$status,
      osi_address: nat$osi_registration_address,
      priority: nat$directory_priority,
      service: nat$protocol,
      user_identifier: ost$name;


    local_status.normal := TRUE;
    osi_address.kind := nac$osi_transport_address;
    osi_address.transport_selector := sap.osi_sap_identifier;
    service := nac$cdna_transport;
    priority := nac$max_directory_priority;
    domain.kind := nac$catenet_domain;
    distribute := FALSE;
    class := nac$cdna_internal;
    user_identifier := '$FILE_ACCESS_ME';

    FOR i := LOWERBOUND (title_list) TO UPPERBOUND (title_list) DO
      IF title_list [i].register THEN
        IF i = validation THEN
          get_validation_titles (title_list [i].validation_info, local_status);
          IF (local_status.normal) AND (title_list [i].validation_info <> NIL) THEN
            FOR j := LOWERBOUND (title_list [i].validation_info^) TO UPPERBOUND (title_list [i].
                  validation_info^) DO
              nlp$register_title (title_list [i].validation_info^ [j].title.value (1,
                    title_list [i].validation_info^ [j].title.size), osi_address, service, NIL, 0, priority,
                    domain, distribute, class, title_list [i].password, user_identifier,
                    title_list [i].validation_info^ [j].directory_identifier, local_status);
              IF local_status.normal THEN
                title_list [i].validation_info^ [j].title_registered := TRUE;
                titles_registered := titles_registered + 1;
              ELSE
                nap$display_message (local_status);
              IFEND;
            FOREND;
          ELSE
            osp$set_status_abnormal (nac$status_id, nae$file_type_unavailable, 'VALIDATION', local_status);
            nap$display_message (local_status);
          IFEND;
        ELSE
          check_file_type_availability (i, file_type_available);
          IF file_type_available THEN
            nlp$register_title (title_list [i].title.value (1, title_list [i].title.size),
                  osi_address, service, NIL, 0, priority, domain, distribute, class, title_list [i].password,
                  user_identifier, title_list [i].directory_identifier, local_status);
            IF local_status.normal THEN
              title_list [i].title_registered := TRUE;
              titles_registered := titles_registered + 1;
            ELSE
              nap$display_message (local_status);
            IFEND;
          ELSE
            osp$set_status_abnormal (nac$status_id, nae$file_type_unavailable, title_list [i].
                  title.value (2, * ), local_status);
            nap$display_message (local_status);
          IFEND;
        IFEND;
      IFEND;
    FOREND;
  PROCEND register_titles;

?? TITLE := 'open_sequential_file', EJECT ??

  PROCEDURE open_sequential_file
    (    path: pft$path;
     VAR file_id: amt$file_identifier;
     VAR file_data: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      actual_position: ^SEQ ( * ),
      attachment_selections: [STATIC, READ] array [1 .. 3] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read]], * ],
            [fsc$sequential_access, TRUE], [fsc$free_behind, TRUE]],
      attribute_validation: [STATIC, READ] array [1 .. 1] of fst$file_cycle_attribute :=
            [[fsc$file_organization, amc$sequential]],
      byte_address: amt$file_byte_address,
      file_pointer: amt$segment_pointer,
      file_size: 0 .. 0ffffffff(16),
      fs_path: fst$path,
      fs_path_size: fst$path_size,
      highest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      lf_attachment_selections: [STATIC, READ] array [1 .. 3] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes,
            [fsc$read, fsc$shorten, fsc$append]], * ], [fsc$sequential_access, TRUE],
            [fsc$free_behind, TRUE]],
      lf_name: ost$name,
      local_status: ost$status,
      name: ost$name,
      next_byte: ^string (1),
      password: [STATIC, READ] pft$password := ' ',
      position: amt$file_position,
      segment_file: ^SEQ ( * ),
      seq_file_id: amt$file_identifier,
      share_selections: [STATIC, READ] pft$share_selections := [pfc$read],
      transfer_count: amt$transfer_count,
      usage_selections: [STATIC, READ] pft$usage_selections := [pfc$read],
      working_storage_area: ^string (osc$max_string_size),
      working_storage_length: amt$working_storage_length;

    status.normal := TRUE;

    pmp$get_unique_name (name, status);
    pfp$attach (name, path, highest_cycle, password, usage_selections, share_selections, pfc$no_wait, status);
    IF status.normal THEN
      fsp$open_file (name, amc$record, ^attachment_selections, {default_creation_attributes =} NIL,
            {mandated_creation_attributes =} NIL, ^attribute_validation, {attribute_override =} NIL,
            seq_file_id, status);
      IF status.normal THEN
        pmp$get_unique_name (lf_name, status);
        fsp$open_file (lf_name, amc$segment, ^lf_attachment_selections, {default_creation_attributes =} NIL,
              {mandated_creation_attributes =} NIL, {attribute_validation =} NIL, {attribute_override =} NIL,
              file_id, status);
        IF status.normal THEN
          amp$get_segment_pointer (file_id, amc$sequence_pointer, file_pointer, status);
          IF status.normal THEN
            segment_file := file_pointer.sequence_pointer;
            RESET segment_file;
            working_storage_length := osc$max_string_size;
            file_size := 0;
            REPEAT
              NEXT working_storage_area IN segment_file;
              amp$get_next (seq_file_id, working_storage_area, working_storage_length, transfer_count,
                    byte_address, position, status);
              IF status.normal AND (position = amc$eor) THEN
                file_size := file_size + transfer_count;
                RESET segment_file TO working_storage_area;
                IF transfer_count > 0 THEN
                  NEXT actual_position: [[REP transfer_count OF cell]] IN segment_file;
                IFEND;
                NEXT next_byte IN segment_file;
                next_byte^ := unit_separator;
                file_size := file_size + 1;
              IFEND;
            UNTIL (NOT status.normal) OR (position <> amc$eor);
            IF status.normal AND (position <> amc$eoi) THEN
              pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
              osp$set_status_abnormal (nac$status_id, nae$record_size_overflow, fs_path (1, fs_path_size),
                    status);
            IFEND;
            IF status.normal THEN
              RESET segment_file;
              NEXT file_data: [[REP file_size OF cell]] IN segment_file;
            ELSE
              fsp$close_file (file_id, local_status);
              amp$return (lf_name, local_status);
            IFEND;
          ELSE
            fsp$close_file (file_id, local_status);
            amp$return (lf_name, local_status);
          IFEND;
        IFEND;
        fsp$close_file (seq_file_id, local_status);
        amp$return (name, local_status);
      ELSE
        amp$return (name, local_status);
      IFEND;
    IFEND;
  PROCEND open_sequential_file;

?? TITLE := 'open_scl_procedure', EJECT ??

  PROCEDURE open_scl_procedure
    (    path: pft$path;
         procedure_name: ost$name;
     VAR file_id: amt$file_identifier;
     VAR file_data: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      attachment_selections: [STATIC, READ] array [1 .. 1] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes,
            [fsc$read, fsc$shorten, fsc$append]], * ]],
      file_pointer: amt$segment_pointer,
      file_size: 0 .. 0ffffffff(16),
      highest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      line: ^clt$command_line,
      local_file_name: amt$local_file_name,
      local_status: ost$status,
      name: ost$name,
      next_byte: ^string (1),
      password: [STATIC, READ] pft$password := ' ',
      proc_file_id: amt$file_identifier,
      proc_line: ^clt$command_line,
      scl_procedure: ^clt$scl_procedure,
      segment_file: ^SEQ ( * );

    status.normal := TRUE;

    nap$open_procedure (path, procedure_name, proc_file_id, scl_procedure, local_file_name, status);
    IF status.normal THEN
      pmp$get_unique_name (name, status);
      fsp$open_file (name, amc$segment, ^attachment_selections, {default_creation_attributes =} NIL,
            {mandated_creation_attributes =} NIL, {attribute_validation =} NIL, {attribute_override =} NIL,
            file_id, status);
      IF status.normal THEN
        amp$get_segment_pointer (file_id, amc$sequence_pointer, file_pointer, status);
        IF status.normal THEN
          segment_file := file_pointer.sequence_pointer;
          RESET segment_file;
          file_size := 0;
          REPEAT
            clp$get_next_scl_proc_line (scl_procedure, proc_line, status);
            IF proc_line <> NIL THEN
              file_size := file_size + STRLENGTH (proc_line^);
              NEXT line: [STRLENGTH (proc_line^)] IN segment_file;
              line^ := proc_line^;
              NEXT next_byte IN segment_file;
              next_byte^ := unit_separator;
              file_size := file_size + 1;
            IFEND;
          UNTIL proc_line = NIL;
          RESET segment_file;
          NEXT file_data: [[REP file_size OF cell]] IN segment_file;
        ELSE
          fsp$close_file (file_id, local_status);
          amp$return (name, local_status);
        IFEND;
      IFEND;
      pmp$close_object_library (proc_file_id, local_status);
      amp$return (local_file_name, local_status);
    IFEND;
  PROCEND open_scl_procedure;

?? TITLE := 'open_validation_procedure', EJECT ??

  PROCEDURE open_validation_procedure
    (    path: pft$path;
         user: ost$name;
     VAR file_data: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      attachment_selections: [STATIC, READ] array [1 .. 1] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read]],
            [fsc$specific_share_modes, [fsc$read]]]],
      bottom: ost$non_negative_integers,
      database_file_id: ^string (vnc$database_file_id_size),
      database_index: ost$non_negative_integers,
      file_id: amt$file_identifier,
      file_pointer: amt$segment_pointer,
      highest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      local_status: ost$status,
      name: ost$name,
      number_of_users_in_system_nvdb: ^ost$non_negative_integers,
      password: [STATIC, READ] pft$password := ' ',
      password_size: 0 .. 0ffffffff(16),
      segment_file: ^SEQ ( * ),
      separator: ^char,
      share_selections: [STATIC, READ] pft$share_selections := [pfc$read],
      system_nvdb: ^vnt$user_database,
      temp: integer,
      top: ost$non_negative_integers,
      usage_selections: [STATIC, READ] pft$usage_selections := [pfc$read],
      user_found: boolean,
      user_password: ^string (vnc$encrypted_password_size),
      version_number: ^string (current_version_size);


    status.normal := TRUE;
    file_data := NIL;
    user_found := FALSE;

    pmp$get_unique_name (name, status);
    pfp$attach (name, path, highest_cycle, password, usage_selections, share_selections, pfc$no_wait, status);
    IF status.normal THEN
      fsp$open_file (name, amc$segment, ^attachment_selections, {default_creation_attributes =} NIL,
            {mandated_creation_attributes =} NIL, {attribute_validation =} NIL, {attribute_override =} NIL,
            file_id, status);
      IF status.normal THEN
        amp$get_segment_pointer (file_id, amc$sequence_pointer, file_pointer, status);
        IF status.normal THEN
          segment_file := file_pointer.sequence_pointer;
          RESET segment_file;
          NEXT database_file_id IN segment_file;
          IF (database_file_id <> NIL) AND (database_file_id^ = vnc$database_file_id) THEN
            NEXT number_of_users_in_system_nvdb IN segment_file;
            IF (number_of_users_in_system_nvdb <> NIL) AND (number_of_users_in_system_nvdb^ > 0) THEN
              NEXT system_nvdb: [1 .. number_of_users_in_system_nvdb^] IN segment_file;
              IF system_nvdb <> NIL THEN

  { Do a binary search on the database for the requested user.

                bottom := 1;
                top := number_of_users_in_system_nvdb^;

                REPEAT
                  temp := bottom + top;
                  database_index := temp DIV 2;
                  IF user < system_nvdb^ [database_index].username THEN
                    top := database_index - 1;
                  ELSEIF user > system_nvdb^ [database_index].username THEN
                    bottom := database_index + 1;
                  ELSE
                    user_found := TRUE;
                  IFEND;
                UNTIL (user_found) OR (bottom > top);

              IFEND;
            IFEND;
            IF user_found THEN
              ALLOCATE file_data: [[REP current_version_size + vnc$encrypted_password_size + 1 OF cell]];
              IF file_data <> NIL THEN
                RESET file_data;
                NEXT version_number IN file_data;
                version_number^ := current_version;
                NEXT user_password IN file_data;
                user_password^ := system_nvdb^ [database_index].password;
                NEXT separator IN file_data;
                separator^ := unit_separator;
                RESET file_data;
              IFEND;
            ELSE
              osp$set_status_condition (nae$invalid_user_name, status);
            IFEND;
          ELSE
            osp$set_status_condition (nae$invalid_net_val_database, status);
            osp$append_status_file (osc$status_parameter_delimiter, name, status);
          IFEND;
          fsp$close_file (file_id, local_status);
        IFEND;
      IFEND;
      amp$return (name, local_status);
    IFEND;
  PROCEND open_validation_procedure;

?? TITLE := 'perform_write [INLINE] ', EJECT ??

  PROCEDURE [INLINE] perform_write
    (VAR write_data: ^SEQ ( * );
     VAR file_data: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      write_block: ^SEQ ( * );

    status.normal := TRUE;
    NEXT write_block: [[REP #SIZE (write_data^) OF cell]] IN file_data;
    IF write_block = NIL THEN
      osp$set_status_condition (nae$write_beyond_file_limit, status);
    ELSE
      write_block^ := write_data^;
    IFEND;
  PROCEND perform_write;
?? TITLE := 'process_parameters', EJECT ??

  PROCEDURE process_parameters
    (    parameter_list: clt$parameter_list;
     VAR title_list: title_array;
     VAR max_connections: 1 .. nac$max_connections;
     VAR max_dumps: 0 .. nac$max_dumps;
     VAR max_dump_size: 0 .. amc$file_byte_limit;
     VAR status: ost$status);

{ PDT file_access_me_pdt (
{    file_type, ft: list of key exception, boot, domain_name_server, ..
{         dump, library, configuration, load_procedure, ..
{         terminal_procedure, user_procedure, validation, all = all
{    maximum_connections, mc: integer 1..nac$max_connections = 1000
{    maximum_dumps, md: integer 0..nac$max_dumps = 10
{    maximum_dump_size, mds: integer 0..amc$file_byte_limit = 16000000
{    status)

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

  VAR
    file_access_me_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^file_access_me_pdt_names,
  ^file_access_me_pdt_params];

  VAR
    file_access_me_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 9] of
  clt$parameter_name_descriptor := [['FILE_TYPE', 1], ['FT', 1], ['MAXIMUM_CONNECTIONS', 2], ['MC', 2], [
  'MAXIMUM_DUMPS', 3], ['MD', 3], ['MAXIMUM_DUMP_SIZE', 4], ['MDS', 4], ['STATUS', 5]];

  VAR
    file_access_me_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 5] of clt$parameter_descriptor
  := [

{ FILE_TYPE FT }
    [[clc$optional_with_default, ^file_access_me_pdt_dv1], 1, clc$max_value_sets,1, 1,
  clc$value_range_not_allowed, [^file_access_me_pdt_kv1, clc$keyword_value]],

{ MAXIMUM_CONNECTIONS MC }
    [[clc$optional_with_default, ^file_access_me_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, 1, nac$max_connections]],

{ MAXIMUM_DUMPS MD }
    [[clc$optional_with_default, ^file_access_me_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, 0, nac$max_dumps]],

{ MAXIMUM_DUMP_SIZE MDS }
    [[clc$optional_with_default, ^file_access_me_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, 0, amc$file_byte_limit]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
  clc$array_not_allowed, clc$status_value]]];

  VAR
    file_access_me_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 11] of ost$name := [
  'EXCEPTION','BOOT','DOMAIN_NAME_SERVER','DUMP','LIBRARY','CONFIGURATION','LOAD_PROCEDURE',
  'TERMINAL_PROCEDURE','USER_PROCEDURE','VALIDATION','ALL'];

  VAR
    file_access_me_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := 'all';

  VAR
    file_access_me_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := '1000';

  VAR
    file_access_me_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '10';

  VAR
    file_access_me_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (8) := '16000000';

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

    VAR
      i: network_file_type,
      number_of_file_types: 0 .. clc$max_value_sets,
      set_entry: 0 .. clc$max_value_sets,
      value: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, file_access_me_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('FILE_TYPE', number_of_file_types, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR set_entry := 1 TO number_of_file_types DO
      clp$get_value ('FILE_TYPE', set_entry, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE value.name.value (1) OF
      = 'E' =
        title_list [exception].register := TRUE;
      = 'B' =
        title_list [boot].register := TRUE;
      = 'D' =
        IF value.name.value = 'DUMP' THEN
          title_list [dump].register := TRUE;
        ELSEIF value.name.value = 'DOMAIN_NAME_SERVER' THEN
          title_list [domain_name_server].register := TRUE;
        IFEND;
      = 'L' =
        IF value.name.value = 'LIBRARY' THEN
          title_list [entry_point].register := TRUE;
        ELSEIF value.name.value = 'LOAD_PROCEDURE' THEN
          title_list [load_procedure].register := TRUE;
        IFEND;
      = 'C' =
        title_list [configuration].register := TRUE;
      = 'T' =
        title_list [terminal_procedure].register := TRUE;
      = 'U' =
        title_list [user_procedure].register := TRUE;
      = 'V' =
        title_list [validation].register := TRUE;
      = 'A' =
        FOR i := LOWERBOUND (title_list) TO UPPERBOUND (title_list) DO
          title_list [i].register := TRUE;
        FOREND;

{ Since 'object_module' and 'entry_point' file types map into        the same
{title ($LIBRARY), only register the title once.

        title_list [object_module].register := FALSE;
      ELSE
      CASEND;
    FOREND;

    clp$get_value ('MAXIMUM_CONNECTIONS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    max_connections := value.int.value;

    clp$get_value ('MAXIMUM_DUMPS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    max_dumps := value.int.value;

    clp$get_value ('MAXIMUM_DUMP_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    max_dump_size := value.int.value;

  PROCEND process_parameters;

?? TITLE := 'update_wait_list', EJECT ??

  PROCEDURE [INLINE] update_wait_list
    (    connection_id: nat$gt_connection_id);

    VAR
      i: 1 .. nac$max_connections;

    FOR i := 1 TO UPPERBOUND (wait_list^) DO
      IF wait_list^ [i].activity = nac$gt_null_activity THEN
        wait_list^ [i].activity := nac$gt_await_receive_event;
        wait_list^ [i].receive_connection_id := connection_id;
        RETURN;
      IFEND;
    FOREND;

    RESET wait_list_seq;
    NEXT wait_list: [1 .. UPPERBOUND (wait_list^) + 1] IN wait_list_seq;
    wait_list^ [UPPERBOUND (wait_list^)].activity := nac$gt_await_receive_event;
    wait_list^ [UPPERBOUND (wait_list^)].receive_connection_id := connection_id;

  PROCEND update_wait_list;

MODEND nam$file_access_me;
