?? RIGHT := 110 ??
?? NEWTITLE := ' NOS/VE File Server : Client: Call Remote Procedure' ??
MODULE dfm$call_remote_procedure;

{ PURPOSE:
{   This module contains the procedure to allow the application (client)
{   user to request execution of a procedure on a remote (server) mainframe.
{
{ DESIGN:
{   The user request is transferred to the Remote Procedure Call (RPC)
{   mechanism and the output of the remote procedure (as returned by RPC) is
{   returned to the caller.
{

?? NEWTITLE := ' Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfi$log_display
*copyc dft$cpu_queue
*copyc dft$procedure_address_ordinal
*copyc dft$rpc_parameters
*copyc ost$caller_identifier
*copyc ost$name
*copyc ost$user_identification
*copyc pme$insufficient_privilege
*copyc pmt$program_name
?? POP ??
*copyc dfp$convert_queue_entry_loc
*copyc dfp$find_extended_rpc_ordinal
*copyc dfp$find_mainframe_id
*copyc dfp$locate_served_family
*copyc dfp$send_application_rpc
*copyc i#current_sequence_position
*copyc mmp$verify_access
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$zero_out_table

*copyc dfv$file_server_debug_enabled
*copyc dfv$p_queue_interface_directory

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] dfp$call_remote_procedure', EJECT ??
*copy dfh$call_remote_procedure

  PROCEDURE [XDCL, #GATE] dfp$call_remote_procedure
    (    server_location: dft$server_location;
         application_name: ost$name;
         procedure_name: pmt$program_name;
         send_parameters: ^SEQ ( * ); {max size = dfc$maximum_user_buffer_area
         send_data: ^SEQ ( * ); {max size = dfc$maximum_user_data_area
     VAR receive_parameters_size: 0 .. dfc$maximum_user_buffer_area;
     VAR receive_parameters: ^SEQ ( * );
     VAR receive_data_size: 0 .. dfc$maximum_user_data_area;
     VAR receive_data: ^SEQ ( * ); {max_size = dfc$maximum_user_data_area
     VAR status: ost$status);

?? NEWTITLE := 'dfp$remote_procedure_call_ch', EJECT ??

{ PURPOSE:
{   This procedure is a condition handler established to call a routine to clear the assignment of a task
{   services queue_entry if a task aborts with a queue_entry assigned to it.  The queue_entry must be clear
{   before the task can safely exit.

    PROCEDURE dfp$remote_procedure_call_ch
      (    condition: pmt$condition;
           cond_desc: ^pmt$condition_information;
           save: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      dfp$ch_cleanup;
      osp$set_status_from_condition (dfc$file_server_id, condition, save, status, handler_status);
      EXIT dfp$call_remote_procedure;

    PROCEND dfp$remote_procedure_call_ch;
*block
*copyc dfp$begin_ch_remote_proc_call
*copyc dfp$end_ch_remote_proc_call
*blockend
?? OLDTITLE, EJECT ??
    VAR
      caller_id: ost$caller_identifier,
      callers_receive_data_size: 0 .. dfc$maximum_user_data_area,
      callers_receive_parameters_size: 0 .. dfc$maximum_user_buffer_area,
      family_found: boolean,
      line: string (200),
      line_size: integer,
      local_status: ost$status,
      mainframe_found: boolean,
      name: ost$name,
      p_cpu_queue: ^dft$cpu_queue,
      p_generic_seq: ^SEQ ( * ),
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_receive_buffer: dft$p_receive_parameters,
      p_receive_data: dft$p_receive_data,
      p_send_buffer: dft$p_send_parameters,
      p_send_data: dft$p_send_data,
      procedure_ordinal: dft$procedure_address_ordinal,
      queue_entry_loc_int: dft$rpc_queue_entry_loc_int,
      queue_entry_location: dft$rpc_queue_entry_location,
      queue_index: dft$queue_index,
      send_buffer_size: dft$send_parameter_size,
      send_data_size: dft$send_data_size,
      served_family_table_index: dft$served_family_table_index,
      server_binary_mainframe_id: pmt$binary_mainframe_id,
      server_state: dft$server_state,
      server_to_client: boolean;

    status.normal := TRUE;
    local_status.normal := TRUE;
    name := 'DFP$CALL_REMOTE_PROCEDURE';
    #CALLER_ID (caller_id);

    IF server_location.server_location_selector = dfc$served_family_table_index THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_server_locator, '', status);
      RETURN;
    IFEND;

    IF send_parameters <> NIL THEN
      IF NOT mmp$verify_access (#LOC (send_parameters), mmc$va_read) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_parameter_pva, 'SEND_PARAMETERS', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'DFP$CALL_REMOTE_PROCEDURE', status);
        RETURN;
      IFEND;
      IF #SIZE (send_parameters^) > dfc$maximum_user_buffer_area THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$callers_variable_too_large, name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'SEND_PARAMETERS', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'dfc$maximum_user_buffer_area', status);
        RETURN;
      IFEND;
    IFEND;

    IF send_data <> NIL THEN
      IF NOT mmp$verify_access (#LOC (send_data), mmc$va_read) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_parameter_pva, 'SEND_DATA', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'DFP$CALL_REMOTE_PROCEDURE', status);
        RETURN;
      IFEND;
      IF #SIZE (send_data^) > dfc$maximum_user_data_area THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$callers_variable_too_large, name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'SEND_DATA', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'dfc$maximum_user_data_area', status);
        RETURN;
      IFEND;
    IFEND;

    IF receive_parameters <> NIL THEN
      IF NOT mmp$verify_access (#LOC (receive_parameters), mmc$va_read_write) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_parameter_pva, 'RECEIVE_PARAMETERS', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'DFP$CALL_REMOTE_PROCEDURE', status);
        RETURN;
      IFEND;
      IF #SIZE (receive_parameters^) > dfc$maximum_user_buffer_area THEN
        callers_receive_parameters_size := dfc$maximum_user_buffer_area;
      IFEND;
      callers_receive_parameters_size := #SIZE (receive_parameters^);
    ELSE
      callers_receive_parameters_size := 0;
    IFEND;

    IF receive_data <> NIL THEN
      IF NOT mmp$verify_access (#LOC (receive_data), mmc$va_read_write) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_parameter_pva, 'RECEIVE_DATA', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'DFP$CALL_REMOTE_PROCEDURE', status);
        RETURN;
      IFEND;
      IF #SIZE (receive_data^) > dfc$maximum_user_data_area THEN
        callers_receive_data_size := dfc$maximum_user_data_area;
      IFEND;
      callers_receive_data_size := #SIZE (receive_data^);
    ELSE
      callers_receive_data_size := 0;
    IFEND;

    dfp$begin_ch_remote_proc_call (server_location, {allowed_when_server_deactivated} FALSE,
          queue_entry_location, p_send_buffer, p_send_data, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /after_begin_call/
    BEGIN

      dfp$convert_qel_ext_to_int (queue_entry_location, queue_entry_loc_int);
      p_cpu_queue := dfv$p_queue_interface_directory^ [queue_entry_loc_int.queue_directory_index].
            p_queue_interface_table^.queue_directory.cpu_queue_pva_directory
            [queue_entry_loc_int.queue_index].p_cpu_queue;

{ Check that callers ring <= application rpc specification

      dfp$find_extended_rpc_ordinal (application_name, procedure_name, p_cpu_queue, procedure_ordinal,
            status);
      IF NOT status.normal THEN
        EXIT /after_begin_call/;
      IFEND;

      IF p_cpu_queue^.queue_header.p_application_rpc_list <> NIL THEN
        IF caller_id.ring > p_cpu_queue^.queue_header.p_application_rpc_list^
              [$INTEGER (procedure_ordinal) - $INTEGER (dfc$last_system_procedure)].application_ring THEN
          osp$set_status_abnormal ('PM', pme$insufficient_privilege, '', status);
          EXIT /after_begin_call/;
        IFEND;
      ELSE {Some sort of problem since dfp$find_extended_rpc_ordinal did not complain
        osp$set_status_abnormal (dfc$file_server_id, dfe$procedure_not_known, procedure_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, application_name, status);
        EXIT /after_begin_call/;
      IFEND;

      IF send_parameters <> NIL THEN
        NEXT p_generic_seq: [[REP #SIZE (send_parameters^) OF cell]] IN p_send_buffer;
        p_generic_seq^ := send_parameters^;
        send_buffer_size := i#current_sequence_position (p_send_buffer);
      ELSE
        send_buffer_size := 0;
      IFEND;

      IF send_data <> NIL THEN
        NEXT p_generic_seq: [[REP #SIZE (send_data^) OF cell]] IN p_send_data;
        p_generic_seq^ := send_data^;
        send_data_size := i#current_sequence_position (p_send_data);
      ELSE
        send_data_size := 0;
      IFEND;

      IF dfv$file_server_debug_enabled THEN
        STRINGREP (line, line_size, ' Sending RPC request. APPL=', application_name, ' PROC=',
              procedure_name);
        log_display ($pmt$ascii_logset [pmc$job_log, pmc$system_log], line (1, line_size));
      IFEND;

      dfp$send_application_rpc (queue_entry_location, application_name, procedure_name, send_buffer_size,
            send_data_size, p_receive_buffer, p_receive_data, status);

      IF NOT status.normal THEN
        IF dfv$file_server_debug_enabled THEN
          display (' ABNORMAL STATUS FROM dfpsend_application_rpc');
          display_status (status);
        IFEND;
        EXIT /after_begin_call/;
      IFEND;

{ Process receive buffer
      IF p_receive_buffer <> NIL THEN
        receive_parameters_size := #SIZE (p_receive_buffer^);
        IF receive_parameters_size <= callers_receive_parameters_size THEN
          RESET receive_parameters;
          NEXT p_generic_seq: [[REP receive_parameters_size OF cell]] IN receive_parameters;
          p_generic_seq^ := p_receive_buffer^;
          RESET receive_parameters;
        ELSE
          osp$set_status_abnormal (dfc$file_server_id, dfe$callers_variable_too_small, name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'RECEIVE_PARAMETERS', status);
          osp$append_status_integer (osc$status_parameter_delimiter, receive_parameters_size, 10, FALSE,
                status);
          EXIT /after_begin_call/;
        IFEND;
      ELSE
        receive_parameters_size := 0;
      IFEND;

      IF p_receive_data <> NIL THEN
        receive_data_size := #SIZE (p_receive_data^);
        IF receive_data_size <= callers_receive_data_size THEN
          RESET receive_data;
          NEXT p_generic_seq: [[REP receive_data_size OF cell]] IN receive_data;
          p_generic_seq^ := p_receive_data^;
          RESET receive_data;
        ELSE
          osp$set_status_abnormal (dfc$file_server_id, dfe$callers_variable_too_small, name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'RECEIVE_DATA', status);
          osp$append_status_integer (osc$status_parameter_delimiter, receive_data_size, 10, FALSE, status);
          EXIT /after_begin_call/;
        IFEND;
      ELSE
        receive_data_size := 0;
        ;
      IFEND;
    END /after_begin_call/;

    dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

  PROCEND dfp$call_remote_procedure;
?? OLDTITLE ??
MODEND dfm$call_remote_procedure;
