?? RIGHT := 110 ??
?? NEWTITLE := ' NOS/VE File Server: Client/Server: r3_manage_file_server', EJECT ??
MODULE dfm$r3_manage_file_server;

{
{  This module processes the Manage_File_Server commands.
{

?? NEWTITLE := '    Global Declarations ', EJECT ??
?? PUSH (LISTEXT := ON) ??

*copyc amp$close
*copyc amp$open
*copyc amp$put_next
*copyc amp$return
*copyc amt$file_identifier
*copyc amt$page_width
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$scan_command_file
*copyc dfd$driver_queue_types
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfp$change_family_server_state
*copyc dfp$crack_mainframe_id
*copyc dfp$delete_tables_of_partner
*copyc dfp$discard_client_jobs
*copyc dfp$display_client_mainframes
*copyc dfp$find_mainframe_id
*copyc dfp$format_task_name
*copyc dfp$free_image_file
*copyc dfp$get_client_mf_job_name
*copyc dfp$get_client_mf_file_info
*copyc dfp$get_highest_sf_lifetime
*copyc dfp$locate_esm_definition
*copyc dfp$purge_client_mainframe_file
*copyc dfp$purge_image_file
*copyc dfp$r2_check_job_recovery
*copyc dfp$reset_mainframe_tables
*copyc dfp$return_esm_base_addresses
*copyc dfp$return_esm_definition
*copyc dfp$set_terminated_access_state
*copyc dfp$terminate_server_files
*copyc dfp$timeout_server_files
*copyc dfp$verify_system_administrator
*copyc dft$client_mainframe_file
*copyc dft$cpu_queue
*copyc dft$display_identifier
*copyc dft$family_list
*copyc dft$queue_index
*copyc dft$queue_interface_directory
*copyc dft$served_family_table_index
*copyc dft$served_family_table
*copyc dfv$file_server_debug_enabled
*copyc dfv$server_state_string
*copyc jme$queued_file_conditions
*copyc jmp$job_exists
*copyc osp$activate_system_task
*copyc osp$active_system_task_r1
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal
*copyc ost$caller_identifier
*copyc ost$string
*copyc osp$verify_system_privilege
*copyc pmp$convert_mainframe_to_binary
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pmp$get_date_time_at_timestamp
*copyc pmp$get_unique_name
*copyc pmt$binary_mainframe_id
*copyc pmt$mainframe_id
?? POP ??


  TYPE
    outline_string_type = record
      size: 0 .. 110,
      value: string (110),
    recend;

?? TITLE := '    dfp$activate_client', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$activate_client
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      client_mainframe_job_name: jmt$user_supplied_name,
      job_exists: boolean,
      job_status: ost$status,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_to_client: boolean;

    dfp$verify_system_administrator ('ACTIVATE_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := TRUE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      RETURN;
    IFEND;

    CASE p_cpu_queue^.queue_header.partner_status.server_state OF
    = dfc$terminated, dfc$awaiting_recovery =
      dfp$get_client_mf_job_name (mainframe_name, client_mainframe_job_name);
      jmp$job_exists (client_mainframe_job_name, $jmt$job_state_set [jmc$initiated_job, jmc$queued_job],
            job_exists, job_status);
      job_exists := (job_status.normal AND job_exists) OR
            (NOT job_status.normal AND (job_status.condition = jme$duplicate_name));
      IF job_exists THEN
        IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          { The client is already activating.
          {  If the client job is not active and we are at verify_queue
          { perhaps the job aborted, we allow activation to retry.
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_is_activating, mainframe_name, status);
         ELSE
          { The client is not active, but the old client mainframe job is
          { still around.  It is dangerous to proceed since that job may be
          { looking at the queues that would be reset here.
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_active,
                client_mainframe_job_name, status);
        IFEND;
        RETURN;
      IFEND;

      dfp$reset_mainframe_tables (mainframe_name, server_to_client, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;

{     ---------------------------
{     Start Client Job Right Here
{     ---------------------------

      dfp$submit_client_mainframe_job (mainframe_name, status);
      IF NOT status.normal THEN
        display ('UNABLE TO SUBMIT CLIENT JOB');
        RETURN;
      IFEND;

    = dfc$inactive =
      IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
        { The client is already activating.
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_is_activating, mainframe_name, status);
      ELSE
        { Reset the poller's queue entry - so that if the other side is awaiting_recovery
        { transaction counts will match.
        p_cpu_queue^.queue_entries [dfc$poll_queue_index].transaction_count := 0;
        p_cpu_queue^.queue_entries [dfc$poll_queue_index].retransmission_count := 0;
        p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;
      IFEND;

    = dfc$active =
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_active, mainframe_name, status);

    = dfc$deactivated =
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_deactivated, mainframe_name, status);

    = dfc$recovering =
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_is_activating, mainframe_name, status);

    ELSE
      display (' SYSTEM ERROR - SERVER STATE CODE IN ERROR');
    CASEND;

  PROCEND dfp$activate_client;

?? TITLE := '    dfp$activate_server', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$activate_server
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_to_client: boolean,
      task_name: ost$name;

    dfp$verify_system_administrator ('ACTIVATE_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := FALSE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      RETURN;
    IFEND;

    CASE p_cpu_queue^.queue_header.partner_status.server_state OF
    = dfc$terminated, dfc$awaiting_recovery =
      dfp$format_task_name (mainframe_name, task_name);
      IF osp$active_system_task_r1 (task_name) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$server_active, task_name, status);
        RETURN;
      IFEND;

      dfp$reset_mainframe_tables (mainframe_name, server_to_client, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;

{     ----------------------------------
{     Start Asynchronous Task Right Here
{     ----------------------------------

      osp$activate_system_task (task_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    = dfc$inactive =
      IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$server_active, mainframe_name, status);
       ELSE
        { Reset the poller's queue entry so that if the other side is awaiting_recovery
        { transaction counts will match.
        p_cpu_queue^.queue_entries [dfc$poll_queue_index].transaction_count := 0;
        p_cpu_queue^.queue_entries [dfc$poll_queue_index].retransmission_count := 0;
        p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;
      IFEND;

    = dfc$active, dfc$recovering =
      osp$set_status_abnormal (dfc$file_server_id, dfe$server_active, mainframe_name, status);

    = dfc$deactivated =
      osp$set_status_abnormal (dfc$file_server_id, dfe$server_deactivated, mainframe_name, status);

    ELSE
      display (' SYSTEM ERROR - SERVER STATE CODE IN ERROR');
    CASEND;

  PROCEND dfp$activate_server;
?? TITLE := '  dfp$check_job_recovery  ', EJECT ??
*copyc dfh$check_job_recovery
  PROCEDURE [XDCL, #GATE] dfp$check_job_recovery (VAR recovery_occurred: boolean);

    osp$verify_system_privilege;
    dfp$r2_check_job_recovery (recovery_occurred);

  PROCEND dfp$check_job_recovery;
?? TITLE := '    dfp$deactivate_client', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$deactivate_client
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_to_client: boolean;

    dfp$verify_system_administrator ('DEACTIVATE_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := TRUE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      RETURN;
    IFEND;

    CASE p_cpu_queue^.queue_header.partner_status.server_state OF
    = dfc$active =
      p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := TRUE;
    ELSE
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_active, mainframe_name, status);
    CASEND;

  PROCEND dfp$deactivate_client;

?? TITLE := '    dfp$deactivate_server', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$deactivate_server
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_to_client: boolean;

    dfp$verify_system_administrator ('DEACTIVATE_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := FALSE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      RETURN;
    IFEND;

    CASE p_cpu_queue^.queue_header.partner_status.server_state OF
    = dfc$active =
      p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := TRUE;
    ELSE
      osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_active, mainframe_name, status);
    CASEND;

  PROCEND dfp$deactivate_server;

?? TITLE := '    dfp$delete_client', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$delete_client
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      client_mainframe_job_name: jmt$user_supplied_name,
      job_exists: boolean,
      job_status: ost$status,
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_birthdate: integer,
      server_lifetime: dft$lifetime,
      server_state: dft$server_state,
      server_to_client: boolean;

    dfp$verify_system_administrator ('DELETE_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := TRUE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN
      IF (p_cpu_queue^.queue_header.partner_status.server_state IN $dft$server_states
            [dfc$terminated, dfc$awaiting_recovery]) AND
            NOT p_cpu_queue^.queue_header.partner_status.verify_queue THEN
        dfp$get_client_mf_job_name (mainframe_name, client_mainframe_job_name);
        jmp$job_exists (client_mainframe_job_name, $jmt$job_state_set [jmc$initiated_job, jmc$queued_job],
              job_exists, job_status);
        job_exists := (job_status.normal AND job_exists) OR
              (NOT job_status.normal AND (job_status.condition = jme$duplicate_name));
        IF job_exists THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_deleteable,
                client_mainframe_job_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, ' Client job still running ', status);
        ELSE
          dfp$delete_tables_of_partner (mainframe_name, server_to_client, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_deleteable, mainframe_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              ' The client must be in the awaiting_recovery or terminated state.', status);
      IFEND;
    ELSE { No queue exists }
      pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
      dfp$get_client_mf_file_info (mainframe_id, mainframe_found, server_state, server_lifetime,
            server_birthdate);
      IF mainframe_found THEN
        IF (server_state = dfc$terminated) OR (server_state = dfc$deleted) THEN
          dfp$purge_client_mainframe_file (mainframe_name, status);
        ELSE
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_deleteable, mainframe_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
              ' The client must be in the terminated state.', status);
        IFEND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      IFEND;
    IFEND;

  PROCEND dfp$delete_client;

?? TITLE := '    dfp$delete_server', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$delete_server
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      queue_index: dft$queue_index,
      server_birthdate: integer,
      server_lifetime: dft$lifetime,
      server_state: dft$server_state,
      server_to_client: boolean,
      task_name: ost$name;

    dfp$verify_system_administrator ('DELETE_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := FALSE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN
      IF (p_cpu_queue^.queue_header.partner_status.server_state IN $dft$server_states
            [dfc$terminated, dfc$awaiting_recovery]) AND
            NOT p_cpu_queue^.queue_header.partner_status.verify_queue THEN
        dfp$format_task_name (mainframe_name, task_name);
        IF osp$active_system_task_r1 (task_name) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_deleteable, task_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
              ' The file server system task is still running.', status);
        ELSE
          dfp$delete_tables_of_partner (mainframe_name, server_to_client, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_deleteable, mainframe_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
            ' The server must be in the terminated or awaiting_recovery state.', status);
      IFEND;
    ELSE
      pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
      dfp$get_highest_sf_lifetime (mainframe_id, mainframe_found, server_state, server_lifetime,
            server_birthdate);
      IF mainframe_found AND (server_state <> dfc$deleted) THEN
        IF server_state = dfc$terminated THEN
          dfp$change_family_server_state (dfc$deleted, mainframe_id);
          dfp$purge_image_file (mainframe_id, local_status);
        ELSE
          osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_deleteable, mainframe_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
            ' The server must be terminated.', status);
        IFEND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      IFEND;
    IFEND;

  PROCEND dfp$delete_server;

?? TITLE := '    dfp$display_client', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$display_client
    (    mainframe_name: pmt$mainframe_id;
         output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
     VAR status: ost$status);

    VAR
      display_client: boolean,
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      server_birthdate: integer,
      server_lifetime: dft$lifetime,
      server_state: dft$server_state;

    dfp$verify_system_administrator ('DISPLAY_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    display_client := TRUE;
    display_client_or_server (mainframe_name, display_client, output_file_fid, page_width, status);
    IF NOT status.normal AND (status.condition = dfe$mainframe_not_client) THEN
      pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
      dfp$get_client_mf_file_info (mainframe_id, mainframe_found, server_state, server_lifetime,
            server_birthdate);
      IF mainframe_found THEN
        display_short_client_or_server (mainframe_name, display_client, server_state, server_lifetime,
              server_birthdate, output_file_fid, page_width, status);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      IFEND;
    IFEND;
  PROCEND dfp$display_client;

?? TITLE := '    dfp$client_mainframes_display', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$client_mainframes_display
    (    file_name: amt$local_file_name;
     VAR status: ost$status);

?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   This procedure provides clean-up processing when a task abort occurs.

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      #SPOIL (output_open);
      IF output_open THEN
        #SPOIL (display_identifier.display_control);
        clp$close_display (display_identifier.display_control, ignore_status);
        status.normal := TRUE;
        output_open := FALSE;
      IFEND;

    PROCEND abort_handler;

*copyc clp$new_page_procedure

?? OLDTITLE ??
?? NEWTITLE := '    print_subtitle', EJECT ??

    PROCEDURE print_subtitle
      (    header: string (50);
       VAR status: ost$status);

      clp$put_partial_display (display_identifier.display_control, header, clc$trim, amc$continue, status);

    PROCEND print_subtitle;

?? OLDTITLE ??
?? NEWTITLE := '    put_subtitle', EJECT ??

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

      print_subtitle (header, status);

    PROCEND put_subtitle;

?? OLDTITLE, EJECT ??

*copyc clv$display_variables

    CONST
      command_name = 'DISPLAY_CLIENT_MAINFRAMES';

    VAR
      caller_id: ost$caller_identifier,
      default_ring_attributes: amt$ring_attributes,
      display_identifier: dft$display_identifier,
      display_line: string (80),
      header: string (50),
      ignore_status: ost$status,
      message_written: boolean,
      nothing_to_display: [READ, oss$job_paged_literal] string (56) :=
            '                        *** No File Server Defined. ***',
      output_open: boolean;


    status.normal := TRUE;
    header := 'CLIENT MAINFRAME(S)';
    output_open := FALSE;
    #SPOIL (output_open);
    message_written := FALSE;

    osp$establish_condition_handler (^abort_handler, TRUE);

    display_identifier.display_type := dfc$listing_display;
    #CALLER_ID (caller_id);
    default_ring_attributes.r1 := caller_id.ring;
    default_ring_attributes.r2 := caller_id.ring;
    default_ring_attributes.r3 := caller_id.ring;

    clp$open_display_reference (file_name, ^clp$new_page_procedure, fsc$list, default_ring_attributes,
          display_identifier.display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    #SPOIL (output_open);
    output_open := TRUE;
    #SPOIL (output_open);

    clv$titles_built := FALSE;
    clv$command_name := command_name;

    dfp$display_client_mainframes (display_identifier, message_written, ignore_status);

    IF NOT message_written THEN
      clp$put_display (display_identifier.display_control, nothing_to_display, clc$trim, ignore_status);
    IFEND;

    clp$close_display (display_identifier.display_control, ignore_status);
    output_open := FALSE;
    #SPOIL (output_open);
    osp$disestablish_cond_handler;

  PROCEND dfp$client_mainframes_display;

?? TITLE := '    dfp$display_server', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$display_server
    (    mainframe_name: pmt$mainframe_id;
         output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
     VAR status: ost$status);

    VAR
      mainframe_id: pmt$binary_mainframe_id,
      server_found: boolean,
      server_state: dft$server_state,
      server_birthdate: integer,
      server_lifetime: dft$lifetime;

    dfp$verify_system_administrator ('DISPLAY_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    display_client_or_server (mainframe_name, FALSE, output_file_fid, page_width, status);
    IF NOT status.normal AND (status.condition = dfe$mainframe_not_server) THEN
      pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
      dfp$get_highest_sf_lifetime (mainframe_id, server_found, server_state, server_lifetime,
            server_birthdate);
      IF server_found THEN
        display_short_client_or_server (mainframe_name, {display_client = } FALSE, server_state,
              server_lifetime, server_birthdate, output_file_fid, page_width, status);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      IFEND;
    IFEND;

  PROCEND dfp$display_server;

?? TITLE := '  dfp$display_stornet_connection ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$display_stornet_connection
    (    element_name: cmt$element_name;
         output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
     VAR status: ost$status);

    VAR
      esm_base_addresses: dft$esm_base_addresses,
      esm_definition: cmt$esm_definition,
      low_speed_port_present: boolean,
      outline: outline_string_type,
      p_esm_def_table_entry: ^dft$esm_definition_table_entry,
      port_index: integer,
      side_door_port_present: boolean,
      stornet_element: cmt$element_descriptor;

    dfp$verify_system_administrator ('DISPLAY_STORNET_CONNECTION', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    stornet_element.element_type := cmc$communications_element;
    stornet_element.peripheral_descriptor.use_logical_identification := TRUE;
    stornet_element.peripheral_descriptor.element_name := element_name;

    dfp$return_esm_definition (stornet_element, esm_definition, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    dfp$return_esm_base_addresses (element_name, esm_base_addresses, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    dfp$locate_esm_definition (element_name, p_esm_def_table_entry);

    start_line ('   STORNET_element:....', outline);
    add_to_line (output_file_fid, page_width, esm_definition.element_name, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Product_ID:.......................', outline);
    add_to_line (output_file_fid, page_width, esm_definition.product_id.product_number, outline);
    add_to_line (output_file_fid, page_width, esm_definition.product_id.underscore, outline);
    add_to_line (output_file_fid, page_width, esm_definition.product_id.model_number, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Serial_Number.....................', outline);
    add_to_line (output_file_fid, page_width, esm_definition.serial_number, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Driver_Name.......................', outline);
    add_to_line (output_file_fid, page_width, esm_definition.peripheral_driver_name, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Memory_size.......................', outline);
    add_integer_to_line (output_file_fid, page_width, esm_definition.memory_size, outline);
    add_to_line (output_file_fid, page_width, ' =', outline);
    add_hex_to_line (output_file_fid, page_width, esm_definition.memory_size, TRUE, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Number of Mainframes..............', outline);
    add_integer_to_line (output_file_fid, page_width, esm_base_addresses.number_of_mainframes, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Divisions per Mainframe...........', outline);
    add_integer_to_line (output_file_fid, page_width, esm_base_addresses.divisions_per_mainframe, outline);
    flush_line (output_file_fid, outline);
    start_line ('           Division Size.................', outline);
    add_hex_to_line (output_file_fid, page_width, esm_base_addresses.esm_division_size *
          dfc$esm_memory_base_shift, TRUE, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Data Transfer Size................', outline);
    add_integer_to_line (output_file_fid, page_width, p_esm_def_table_entry^.maximum_data_bytes, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Flag Base.........................', outline);
    add_integer_to_line (output_file_fid, page_width, esm_base_addresses.esm_flag_base, outline);
    add_to_line (output_file_fid, page_width, ' =', outline);
    add_hex_to_line (output_file_fid, page_width, esm_base_addresses.esm_flag_base, TRUE, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Memory Base.......................', outline);
    add_integer_to_line (output_file_fid, page_width, esm_base_addresses.esm_memory_base *
          dfc$esm_memory_base_shift, outline);
    add_to_line (output_file_fid, page_width, ' =', outline);
    add_hex_to_line (output_file_fid, page_width, esm_base_addresses.esm_memory_base *
          dfc$esm_memory_base_shift, TRUE, outline);
    flush_line (output_file_fid, outline);

    low_speed_port_present := FALSE;
    start_line ('       Low_speed_ports:', outline);
    flush_line (output_file_fid, outline);
    FOR port_index := 1 TO cmc$max_low_speed_port_number DO
      IF esm_definition.low_speed_port [port_index].configured THEN
        low_speed_port_present := TRUE;
        start_line ('         Entry ', outline);
        add_integer_to_line (output_file_fid, page_width, port_index, outline);
        flush_line (output_file_fid, outline);
        start_line ('           Channel.........', outline);
        add_to_line (output_file_fid, page_width, esm_definition.low_speed_port [port_index].element_name,
              outline);
        flush_line (output_file_fid, outline);
        start_line ('           Mainframe.......', outline);
        add_to_line (output_file_fid, page_width, esm_definition.low_speed_port [port_index].
              mainframe_ownership, outline);
        flush_line (output_file_fid, outline);
        start_line ('           IOU.............', outline);
        add_to_line (output_file_fid, page_width, esm_definition.low_speed_port [port_index].iou, outline);
        flush_line (output_file_fid, outline);
      IFEND;
    FOREND;
    IF NOT low_speed_port_present THEN
      start_line ('         NO LOW SPEED PORTS PRESENT!', outline);
      flush_line (output_file_fid, outline);
    IFEND;

    side_door_port_present := FALSE;
    start_line ('       Side_door_ports:', outline);
    flush_line (output_file_fid, outline);
    FOR port_index := 1 TO cmc$max_side_door_port_number DO
      IF esm_definition.side_door_port [port_index].configured THEN
        side_door_port_present := TRUE;
        start_line ('         Entry ', outline);
        add_integer_to_line (output_file_fid, page_width, port_index, outline);
        flush_line (output_file_fid, outline);
        start_line ('           Channel.........', outline);
        add_to_line (output_file_fid, page_width, esm_definition.side_door_port [port_index].element_name,
              outline);
        flush_line (output_file_fid, outline);
        start_line ('           Mainframe.......', outline);
        add_to_line (output_file_fid, page_width, esm_definition.side_door_port [port_index].
              mainframe_ownership, outline);
        flush_line (output_file_fid, outline);
        start_line ('           IOU.............', outline);
        add_to_line (output_file_fid, page_width, esm_definition.side_door_port [port_index].iou, outline);
        flush_line (output_file_fid, outline);
      IFEND;
    FOREND;
    IF NOT side_door_port_present THEN
      start_line ('         NO SIDE DOOR PORTS PRESENT!', outline);
      flush_line (output_file_fid, outline);
    IFEND;

    start_line ('       Maintenance', outline);
    flush_line (output_file_fid, outline);
    start_line ('         Buffer_Location...', outline);
    add_integer_to_line (output_file_fid, page_width, esm_definition.maintenance_buffer_location.
          first_word_address, outline);
    flush_line (output_file_fid, outline);
    start_line ('         Buffer_Size.......', outline);
    add_integer_to_line (output_file_fid, page_width, esm_definition.maintenance_buffer_location.length,
          outline);
    flush_line (output_file_fid, outline);

  PROCEND dfp$display_stornet_connection;

?? TITLE := '    [XDCL] dfp$submit_client_mainframe_job', EJECT ??

  PROCEDURE [XDCL] dfp$submit_client_mainframe_job
    (    client_mainframe: pmt$mainframe_id;
     VAR status: ost$status);

    PROCEDURE put
      (    line: string ( * <= 128));

      VAR
        byte_address: amt$file_byte_address,
        local_status: ost$status;

      amp$put_next (submit_file_id, ^line, STRLENGTH (line), byte_address, status);
      IF NOT status.normal THEN
        amp$close (submit_file_id, local_status);
        amp$return (submit_file, local_status);
        EXIT dfp$submit_client_mainframe_job;
        RETURN;
      IFEND;
    PROCEND put;

    VAR
      client_mainframe_job_name: jmt$user_supplied_name,
      line_length: integer,
      local_status: ost$status,
      output_line: string (128),
      submit_file: amt$local_file_name,
      submit_file_id: amt$file_identifier;

    dfp$get_client_mf_job_name (client_mainframe, client_mainframe_job_name);
    pmp$get_unique_name (submit_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (submit_file, amc$record, NIL, submit_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Build command file containing JOB/JOBEND

    STRINGREP (output_line, line_length, 'JOB JOB_CLASS=SYSTEM USER_JOB_NAME=', client_mainframe_job_name,
          ' ..');
    put (output_line (1, line_length));
    put ('    JOB_ABORT_DISPOSITION=TERMINATE   JOB_RECOVERY_DISPOSITION=TERMINATE');
    put (' ');

    put (' VAR');
    put ('   ignore_status: status');
    put ('   log_file: file = :$system.$system.$df_job_logs//$job(user_job_name)//$job(system_job_name)');
    put ('   task_status: status');
    put (' VAREND');
    put (' ');

    put (' create_catalog $up($up(log_file)) status=ignore_status');
    put (' create_catalog $up(log_file) status=ignore_status');
    put (' ');

    put (' display_message ..');
    put ('       '' *** Permanent File_Server Client_Job JOB_LOG will be written to ''//..');
    put ('$string(log_file)//'' ***'' to=job');
    IF dfv$file_server_debug_enabled THEN
      put (' send_operator_message ..');
      put ('       '' *** Permanent File_Server Client_Job JOB_LOG will be written to ''//..');
      put ('$string(log_file)//'' ***''');
    IFEND;
    put (' terminate_output name=output ');
    put (' ');

    put (' WHEN ANY_FAULT DO ');
    put ('   when_status = $previous_status ');
    put ('   display_value when_status output=:$local.$job_log ');
    put ('   display_value when_status output=:$local.$response ');
    put ('   send_operator_message ..');
    put ('   '' CLIENT JOB ABORTING - SEE JOB LOG ''//$condition_name(when_status.condition) ');
    put ('   display_log display_option=all output=log_file.$next');
    put ('  WHENEND');
    put (' ');

    put (' system_operator_utility capability=system_operation ');
    put ('   change_priority job_name=$job(system_job_name) dispatching_priority=p9 ');
    put (' quit ');
    put (' ');

    STRINGREP (output_line, line_length, ' EXECUTE_TASK SP=DFP$MANAGE_CLIENT_CONNECTION P=''',
          client_mainframe, ''' status=task_status');
    put (output_line (1, line_length));
    put (' IF NOT task_status.normal THEN');
    put ('   display_value '' WARNING: Abnormal status returned from Manage Client Connection task:'' ..');
    put ('         output=:$local.$job_log');
    put ('   display_value task_status ..');
    put ('         output=:$local.$job_log');
    put (' IFEND');
    put (' ');

    put (' " ************************************************************ " ');
    STRINGREP (output_line, line_length, ' " *** ', client_mainframe_job_name,
          ' job terminating.     *** " ');
    put (output_line (1, line_length));
    put (' " *** Final commands will be as follows:                   *** " ');
    put (' " *** DISPLAY_LOG display_option=all output=log_file.$next *** " ');
    put (' " *** LOGOUT                                               *** " ');
    put (' " ************************************************************ " ');
    put (' ');

    put (' DISPLAY_LOG display_option=all output=log_file.$next');
    put (' ');

    put ('JOBEND');

    amp$close (submit_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_command_file (submit_file, osc$null_name, '', status);

    amp$return (submit_file, local_status);
  PROCEND dfp$submit_client_mainframe_job;

?? TITLE := '    dfp$terminate_client', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$terminate_client
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_birthdate: integer,
      server_lifetime: dft$lifetime,
      server_state: dft$server_state,
      server_to_client: boolean;

    dfp$verify_system_administrator ('TERMINATE_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := TRUE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN
      { This code should verify that the client job exists, if it does not
      { then the work should be done right here.

      CASE p_cpu_queue^.queue_header.partner_status.server_state OF
      = dfc$terminated =
        IF NOT p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_already_terminated, mainframe_name, status);
          RETURN;
        IFEND;
        p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;

      = dfc$inactive =
        p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;

      = dfc$recovering, dfc$deactivated, dfc$active =
        p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;

      = dfc$awaiting_recovery =
        IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN

{ The client mainframe job exists let it do the work.

          p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
          p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        ELSE
          p_cpu_queue^.queue_header.partner_status.server_state := dfc$terminated;
          p_cpu_queue^.queue_header.partner_status.terminate_partner := FALSE;
          p_cpu_queue^.queue_header.partner_status.deactivate_complete := FALSE;

{ Store state into client mainframe file

          dfp$discard_client_jobs (mainframe_name, dfc$terminated, status);
        IFEND;
      ELSE
      CASEND;
    ELSE { No queue exists
      pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
      dfp$get_client_mf_file_info (mainframe_id, mainframe_found, server_state, server_lifetime,
            server_birthdate);
      IF mainframe_found THEN

{ Store state into client mainframe file

        IF server_state = dfc$terminated THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_already_terminated, mainframe_name, status);
        ELSE
          dfp$discard_client_jobs (mainframe_name, dfc$terminated, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      IFEND;
    IFEND;

  PROCEND dfp$terminate_client;

?? TITLE := '    dfp$terminate_server', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$terminate_server
    (    mainframe_name: pmt$mainframe_id;
         users_wait_on_term_specified: boolean;
         users_wait_on_terminated: boolean;
     VAR status: ost$status);

    VAR
      highest_server_lifetime: dft$server_lifetime,
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      server_to_client: boolean,
      server_birthdate: integer,
      server_lifetime: dft$lifetime,
      server_state: dft$server_state;

    dfp$verify_system_administrator ('TERMINATE_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := FALSE;
    pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN

{ Queues exists

      IF users_wait_on_term_specified THEN
        p_cpu_queue^.queue_header.partner_status.users_wait_on_terminated_server := users_wait_on_terminated;
      IFEND;
      CASE p_cpu_queue^.queue_header.partner_status.server_state OF
      = dfc$terminated =
        IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN

{ A poll task exists, let it do the termination.

          p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
          p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
        ELSE

{ There is nothing to terminate. Allow the command anyway to allow
{ changing the users_wait_on_terminated parameter.

        IFEND;
      = dfc$inactive =
        p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
      = dfc$active, dfc$recovering, dfc$deactivated =

{ A poll task exists, let it do the termination

        p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
      = dfc$awaiting_recovery =
        IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN

{ A poll task exists, let it do the termination.

          p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
          p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        ELSE

{ There is no poll task or it has not responded to a previous termination
{  but still termination is required.
{ The PP should already be unloaded and all requests should have been
{ terminated from the queues.

          p_cpu_queue^.queue_header.partner_status.terminate_partner := FALSE;
          p_cpu_queue^.queue_header.partner_status.deactivate_complete := FALSE;
          p_cpu_queue^.queue_header.partner_status.server_state := dfc$terminated;
          dfp$change_family_server_state (dfc$terminated, mainframe_id);
          dfp$free_image_file (mainframe_id, status);
          dfp$set_terminated_access_state (mainframe_id);
          dfp$terminate_server_files (mainframe_id, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      CASEND;
    ELSE

{ Check served family table

      dfp$get_highest_sf_lifetime (mainframe_id, mainframe_found, server_state, server_lifetime,
            server_birthdate);
      IF mainframe_found AND (server_state <> dfc$deleted) THEN
        dfp$free_image_file (mainframe_id, status);
        dfp$change_family_server_state (dfc$terminated, mainframe_id);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      IFEND;
    IFEND;

  PROCEND dfp$terminate_server;
?? TITLE := '    dfp$timeout_client', EJECT ??
{
{   This procedure is provided for testing.
{ This forces a timeout of the server-to-client connection.
{ This is done by setting the timeout_partner boolean in the cpu queue header.
{

  PROCEDURE [XDCL, #GATE] dfp$timeout_client
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index;

    dfp$verify_system_administrator ('TIMEOUT_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$find_mainframe_id (mainframe_name, { server_to_client } TRUE, mainframe_found,
          p_queue_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN

      CASE p_cpu_queue^.queue_header.partner_status.server_state OF
      = dfc$awaiting_recovery, dfc$terminated =
        IF NOT p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_active, mainframe_name, status);
          RETURN;
        IFEND;
        p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
     = dfc$inactive =
        p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;

      = dfc$recovering, dfc$deactivated, dfc$active =
        p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;

      ELSE
      CASEND;
    ELSE { No queue exists
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
    IFEND;

  PROCEND dfp$timeout_client;
?? TITLE := '    dfp$timeout_server', EJECT ??
{
{   This procedure is provided for testing.
{ This forces a timeout of the client-to-server connection.
{ This is done by setting the timeout_partner boolean in the cpu queue header.
{ If the server is awaiting recovery but not all pages have been saved then
{ another attempt is made to save the pages.
{

  PROCEDURE [XDCL, #GATE] dfp$timeout_server
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index;

    dfp$verify_system_administrator ('TIMEOUT_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$find_mainframe_id (mainframe_name, { server_to_client } FALSE, mainframe_found,
          p_queue_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN

      CASE p_cpu_queue^.queue_header.partner_status.server_state OF
      = dfc$terminated, dfc$inactive, dfc$awaiting_recovery =
        IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
          p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
        ELSEIF (p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery) AND
           (NOT p_cpu_queue^.queue_header.partner_status.server_pages_saved) THEN
           pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
           display (' Timeout server files');
           dfp$timeout_server_files (mainframe_id, status);
           p_cpu_queue^.queue_header.partner_status.server_pages_saved := status.normal;
        ELSEIF (p_cpu_queue^.queue_header.partner_status.server_state = dfc$inactive) THEN
          p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
        ELSE
          osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_active, mainframe_name, status);
          RETURN;
        IFEND;

      = dfc$recovering, dfc$deactivated, dfc$active =
        p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;

      ELSE
      CASEND;
    ELSE { No queue exists
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
    IFEND;

  PROCEND dfp$timeout_server;

?? TITLE := '  display_client_or_server', EJECT ??

  PROCEDURE display_client_or_server
    (    mainframe_name: pmt$mainframe_id;
         display_client: boolean;
         output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
     VAR status: ost$status);

    CONST
      client = 'CLIENT',
      server = 'SERVER';

    VAR
      activation_date_time: ost$date_time,
      activation_date: ost$date,
      activation_time: ost$time,
      display_object: string (6),
      display_timeout_interval: integer,
      mainframe_found: boolean,
      outline: outline_string_type,
      p_cpu_queue: ^dft$cpu_queue,
      p_driver_queue_header: ^dft$driver_queue_header,
      p_esm_base_addresses: ^dft$esm_base_addresses,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      queue_index: dft$queue_index,
      server_to_client: boolean;

    IF display_client THEN
      server_to_client := TRUE;
      dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
            p_cpu_queue, queue_index, p_q_interface_directory_entry);
      IF NOT mainframe_found THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
        RETURN;
      IFEND;
      display_object := client;

    ELSE
      server_to_client := FALSE;
      dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
            p_cpu_queue, queue_index, p_q_interface_directory_entry);
      IF NOT mainframe_found THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
        RETURN;
      IFEND;
      display_object := server;
    IFEND;

    p_esm_base_addresses := ^p_queue_interface_table^.esm_base_addresses;
    p_driver_queue_header := ^p_queue_interface_table^.queue_directory.
          driver_queue_pva_directory [queue_index].p_driver_queue^.queue_header;
    start_line (' --FILE SERVER Mainframe ', outline);
    add_to_line (output_file_fid, page_width, mainframe_name, outline);
    add_to_line (output_file_fid, page_width, ' Configuration Display--', outline);
    flush_line (output_file_fid, outline);

    start_line ('       Mainframe is.....................', outline);
    add_to_line (output_file_fid, page_width, display_object, outline);
    flush_line (output_file_fid, outline);

    IF NOT display_client THEN
      start_line ('       Leveler Status...................', outline);
      CASE p_cpu_queue^.queue_header.leveler_status.leveler_state OF
      = jmc$jl_leveler_enabled =
        add_to_line (output_file_fid, page_width, 'ENABLED', outline);
      = jmc$jl_leveler_disabled =
        add_to_line (output_file_fid, page_width, 'DISABLED', outline);
      = jmc$jl_server_profile_mismatch =
        add_to_line (output_file_fid, page_width, 'PROFILE MISMATCH', outline);
      ELSE
        add_to_line (output_file_fid, page_width, 'UNKNOWN', outline);
      CASEND;
      flush_line (output_file_fid, outline);
    IFEND;

    start_line ('       Server State.....................', outline);
    add_to_line (output_file_fid, page_width, dfv$server_state_string
        [p_cpu_queue^.queue_header.partner_status.server_state], outline);
    CASE p_cpu_queue^.queue_header.partner_status.server_state OF
    = dfc$awaiting_recovery, dfc$inactive, dfc$terminated =
      IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
        add_to_line (output_file_fid, page_width, ' ACTIVATING ', outline);
      IFEND;
      IF (display_object = server) AND
          (p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery)
          AND (NOT p_cpu_queue^.queue_header.partner_status.server_pages_saved) THEN
        add_to_line (output_file_fid, page_width, ' Pages NOT saved ', outline);
      IFEND;
      IF (p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) AND
         (display_object = server) THEN
        IF p_cpu_queue^.queue_header.partner_status.users_wait_on_terminated_server THEN
          add_to_line (output_file_fid, page_width, '    Users wait on terminated ', outline);
        ELSE
          add_to_line (output_file_fid, page_width, '    Users DO NOT wait on terminated ', outline);
        IFEND;
      IFEND;
    ELSE
    CASEND;
    flush_line (output_file_fid, outline);

    start_line ('       Server Lifetime..................', outline);
    add_integer_to_line (output_file_fid, page_width, p_cpu_queue^.queue_header.server_lifetime, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Server Birthdate.................', outline);
    add_integer_to_line (output_file_fid, page_width, p_cpu_queue^.queue_header.server_birthdate, outline);
    IF (display_object = server) AND
       (p_cpu_queue^.queue_header.server_birthdate <> 0) THEN
       add_to_line (output_file_fid, page_width, '  ', outline);
       pmp$get_date_time_at_timestamp (p_cpu_queue^.queue_header.server_birthdate,
            pmc$use_system_local_time, activation_date_time,  status);
       pmp$format_compact_date (activation_date_time, osc$month_date,
           activation_date, status);
       add_to_line (output_file_fid, page_width, activation_date.month, outline);
       pmp$format_compact_time (activation_date_time, osc$ampm_time, activation_time, status);
       add_to_line (output_file_fid, page_width, activation_time.ampm, outline);
    IFEND;
    flush_line (output_file_fid, outline);

    IF dfv$file_server_debug_enabled THEN
      start_line ('       Own Queue Index..................', outline);
      add_integer_to_line (output_file_fid, page_width, queue_index, outline);
      flush_line (output_file_fid, outline);
      start_line ('       ', outline);
      add_to_line (output_file_fid, page_width, display_object, outline);
      add_to_line (output_file_fid, page_width, ' Queue Index...............', outline);
      add_integer_to_line (output_file_fid, page_width, p_driver_queue_header^.connection_descriptor.
            destination.queue_index, outline);
      flush_line (output_file_fid, outline);
    IFEND;

    start_line ('       Number of Monitor Queue Entries..', outline);
    add_integer_to_line (output_file_fid, page_width, p_cpu_queue^.queue_header.
          number_of_monitor_queue_entries, outline);
    flush_line (output_file_fid, outline);
    start_line ('       Number of Task Queue Entries.....', outline);
    add_integer_to_line (output_file_fid, page_width, p_cpu_queue^.queue_header.number_of_task_queue_entries,
          outline);
    flush_line (output_file_fid, outline);

    start_line ('       Connection Type..................', outline);
    CASE p_cpu_queue^.queue_header.connection_type OF
    = dfc$cdcnet_connection =
      add_to_line (output_file_fid, page_width, 'CDCNET', outline);
      flush_line (output_file_fid, outline);
    = dfc$mock_connection =
      add_to_line (output_file_fid, page_width, 'MOCK', outline);
      flush_line (output_file_fid, outline);
    = dfc$esm_connection =
      add_to_line (output_file_fid, page_width, 'STORNET', outline);
      flush_line (output_file_fid, outline);

      start_line ('       Own Send Element Name............', outline);
      add_to_line (output_file_fid, page_width, p_q_interface_directory_entry^.element_name, outline);
      flush_line (output_file_fid, outline);
      start_line ('       Own ID/', outline);
      add_to_line (output_file_fid, page_width, display_object, outline);
      add_to_line (output_file_fid, page_width, ' ID Number..........', outline);
      add_integer_to_line (output_file_fid, page_width, p_driver_queue_header^.connection_descriptor.source.
            id_number, outline);
      add_to_line (output_file_fid, page_width, '/', outline);
      add_integer_to_line (output_file_fid, page_width, p_driver_queue_header^.connection_descriptor.
            destination.id_number, outline);
      flush_line (output_file_fid, outline);
      start_line ('       Send_Channel Name................', outline);
      add_to_line (output_file_fid, page_width, p_q_interface_directory_entry^.send_channel.channel_name,
            outline);
      flush_line (output_file_fid, outline);
      start_line ('       Send_Channel IOU.................', outline);
      add_to_line (output_file_fid, page_width, p_q_interface_directory_entry^.send_channel.iou_name,
            outline);
      flush_line (output_file_fid, outline);
      start_line ('       Receive_Channel Name.............', outline);
      add_to_line (output_file_fid, page_width, p_q_interface_directory_entry^.receive_channel.channel_name,
            outline);
      flush_line (output_file_fid, outline);
      start_line ('       Receive_Channel IOU..............', outline);
      add_to_line (output_file_fid, page_width, p_q_interface_directory_entry^.receive_channel.iou_name,
            outline);
      flush_line (output_file_fid, outline);
      start_line ('       DMA On Send/Receive Channel......', outline);
      add_boolean_to_line (output_file_fid, page_width, p_queue_interface_table^.queue_directory.dma_adapter.
            use_on_send_channel, {input/output} outline);
      add_to_line (output_file_fid, page_width, '/', outline);
      add_boolean_to_line (output_file_fid, page_width, p_queue_interface_table^.queue_directory.dma_adapter.
            use_on_recv_channel, {input/output} outline);
      flush_line (output_file_fid, outline);

    ELSE
      ;
    CASEND;
    display_timeout_interval := (p_cpu_queue^.queue_header.timeout_interval DIV 1000000);
    start_line ('       Timeout Interval.................', outline);
    add_integer_to_line (output_file_fid, page_width, display_timeout_interval, outline);
    add_to_line (output_file_fid, page_width, ' seconds', outline);
    flush_line (output_file_fid, outline);
    start_line ('       Maximum Request Timeout Count....', outline);
    add_integer_to_line (output_file_fid, page_width, p_cpu_queue^.queue_header.maximum_request_timeout_count,
          outline);
    flush_line (output_file_fid, outline);
    start_line ('       Maximum Retransmission Count.....', outline);
    add_integer_to_line (output_file_fid, page_width, p_cpu_queue^.queue_header.maximum_retransmission_count,
          outline);
    flush_line (output_file_fid, outline);

  PROCEND display_client_or_server;
?? TITLE := '  display_short_client_or_server', EJECT ??

  PROCEDURE display_short_client_or_server
    (    mainframe_name: pmt$mainframe_id;
         display_client: boolean;
         server_state: dft$server_state;
         server_lifetime: dft$lifetime;
         server_birthdate: integer;
         output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
     VAR status: ost$status);

    CONST
      client = 'CLIENT',
      server = 'SERVER';

    VAR
      display_object: string (6),
      display_timeout_interval: integer,
      outline: outline_string_type;

    IF display_client THEN
      display_object := client;

    ELSE
      display_object := server;
    IFEND;

    start_line (' --FILE SERVER Mainframe ', outline);
    add_to_line (output_file_fid, page_width, mainframe_name, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Mainframe is.....................', outline);
    add_to_line (output_file_fid, page_width, display_object, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Server State.....................', outline);
    add_to_line (output_file_fid, page_width, dfv$server_state_string [server_state],
         outline);
    flush_line (output_file_fid, outline);

    start_line ('       Server Lifetime..................', outline);
    add_integer_to_line (output_file_fid, page_width, server_lifetime, outline);
    flush_line (output_file_fid, outline);

    start_line ('       Server Birthdate ................', outline);
    add_integer_to_line (output_file_fid, page_width, server_birthdate, outline);
    flush_line (output_file_fid, outline);

    start_line ('       AWAITING QUEUE DEFINITION .......', outline);
    flush_line (output_file_fid, outline);

  PROCEND display_short_client_or_server;

?? TITLE := '  add_boolean_to_line', EJECT ??

  PROCEDURE [INLINE] add_boolean_to_line
    (    output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
         bool: boolean;
     VAR {input/output} outline: outline_string_type);

    IF bool THEN
      add_to_line (output_file_fid, page_width, 'TRUE', outline);
    ELSE
      add_to_line (output_file_fid, page_width, 'FALSE', outline);
    IFEND;
  PROCEND add_boolean_to_line;

?? SKIP := 4 ??
?? TITLE := '  add_hex_to_line' ??

  PROCEDURE [INLINE] add_hex_to_line
    (    output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
         int: integer;
         add_radix: boolean;
     VAR outline: outline_string_type);

    VAR
      ignore_status: ost$status,
      int_string: ost$string;

    clp$convert_integer_to_string (int, 16, FALSE, int_string, ignore_status);
    add_to_line (output_file_fid, page_width, int_string.value (1, int_string.size), outline);
    IF add_radix THEN
      add_to_line (output_file_fid, page_width, '(16)', outline);
    IFEND;
  PROCEND add_hex_to_line;

?? SKIP := 4 ??
?? TITLE := '  add_integer_to_line' ??

  PROCEDURE [INLINE] add_integer_to_line
    (    output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
         int: integer;
     VAR outline: outline_string_type);

    VAR
      ignore_status: ost$status,
      int_string: ost$string;

    clp$convert_integer_to_string (int, 10, FALSE, int_string, ignore_status);
    add_to_line (output_file_fid, page_width, int_string.value (1, int_string.size), outline);
  PROCEND add_integer_to_line;

?? TITLE := '  add_to_line', EJECT ??

  PROCEDURE add_to_line
    (    output_file_fid: amt$file_identifier;
         page_width: amt$page_width;
         str: string ( * );
     VAR outline: outline_string_type);

    VAR
      size: 0 .. osc$max_string_size + 1;

    size := STRLENGTH (str);
    IF (outline.size + size) <= page_width THEN
      outline.value (outline.size + 1, size) := str;
      outline.size := outline.size + size;
      RETURN;
    IFEND;

    flush_line (output_file_fid, outline);
    start_line ('      ', outline);
    outline.value (outline.size + 1, size) := str;
    outline.size := outline.size + size;

  PROCEND add_to_line;

?? TITLE := '  flush_line ', EJECT ??

  PROCEDURE [INLINE] flush_line
    (    output_file_fid: amt$file_identifier;
     VAR outline: outline_string_type);

    IF outline.size > 0 THEN
      put_line (output_file_fid, outline);
    IFEND;

  PROCEND flush_line;

?? SKIP := 4 ??
?? TITLE := '  put_line' ??

  PROCEDURE put_line
    (    output_file_fid: amt$file_identifier;
     VAR outline: outline_string_type);

    VAR
      status: ost$status,
      ignore_byte_address: amt$file_byte_address;

    amp$put_next (output_file_fid, ^outline.value, outline.size, ignore_byte_address, status);
    IF NOT status.normal THEN

{???????????????????

    IFEND;
    outline.size := 0;
    outline.value := '';

  PROCEND put_line;

?? SKIP := 4 ??
?? TITLE := '  start_line' ??

  PROCEDURE [INLINE] start_line
    (    str: string ( * );
     VAR outline: outline_string_type);

    outline.value := str;
    outline.size := STRLENGTH (str);

  PROCEND start_line;

MODEND dfm$r3_manage_file_server;
