?? LEFT := 1, RIGHT := 110 ??
?? FMT (FORMAT := ON, INDENT := 2) ??
?? SET (LIST := ON, LISTCTS := OFF) ??
MODULE nfm$ptf_server;

{     PURPOSE:
{            This module contains procedures to perform the function of the
{            Permanent file Transfer Facility (PTF) server.  The PTF server
{            executes in respose to a connection request made by a PTF client.
{            The PTF server is composed of a number of tasks.  First, a task
{            called the boot receives incoming PTF client connections.
{            Each connection received causes a task to be executed which
{            tries to build a job on the behalf of the client user.
{            If the user job runs successfully, file transfer occurs from
{            that job.
{
{     DESCRIPTION:
{            The function of PTFS is performed by three entities.  First,
{            a system task (eventually a privileged job) receives all incoming
{            connections.  The task (called the boot) then executes another
{            task which reads protocol and builds a user PTFS job.  The user
{            PTFS job is submitted to the system.  If the user job fails, the
{            job generation task completes protocol.  Otherwise, the connection
{            is switched to the user PTFS job for the remainder of the session.
{
*copyc amp$return
*copyc amp$put_next
*copyc amp$close
*copyc amp$get_file_attributes
*copyc amp$get_next
*copyc clp$convert_integer_to_string
*copyc clp$convert_str_to_path_handle
*copyc clp$convert_string_to_integer
*copyc clp$create_file_connection
*copyc clp$delete_file_connection
*copyc clp$evaluate_parameters
*copyc clp$get_line_from_command_file
*copyc clp$get_variable_value
*copyc clp$pop_input
*copyc clp$pop_utility
*copyc clp$push_input
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc fsp$close_file
*copyc fsp$open_file
*copyc fst$attachment_options
*copyc fst$evaluated_file_reference
*copyc jme$queued_file_conditions
*copyc jmp$change_job_attributes
*copyc jmp$get_job_attributes
*copyc jmp$job_exists
*copyc jmp$submit_job
*copyc jmp$system_job
*copyc jmp$terminate_job
*copyc nap$accept_connection
*copyc nap$accept_switch_offer
*copyc nap$acquire_connection
*copyc nap$attach_server_application
*copyc nap$cancel_switch_offer
*copyc nap$detach_server_application
*copyc nap$offer_connection_switch
*copyc nap$store_attributes
*copyc nfp$count_directives_text
*copyc nfp$crack_command
*copyc nfp$crack_number_of_parameters
*copyc nfp$crack_parameter
*copyc nfp$crack_pdu
*copyc nfp$dequeue_directives_on_list
*copyc nfp$deallocate_dirs_from_head
*copyc nfp$enqueue_status_directive
*copyc nfp$enqueue_task
*copyc nfp$format_message_to_job_log
*copyc nfp$generate_ptf_statistic
*copyc nfp$get_and_crack_command
*copyc nfp$get_server_asynch_event
*copyc nfp$initialize_control_block
*copyc nfp$receive_command
*copyc nfp$receive_parameter_00
*copyc nfp$receive_parameter_20
*copyc nfp$receive_parameter_22
*copyc nfp$send_command
*copyc nfp$set_abnormal_if_normal
*copyc nfp$string_length
*copyc nfp$terminate_path
*copyc nfp$transfer_file
*copyc osp$append_status_parameter
*copyc osp$generate_log_message
*copyc osp$get_status_condition_string
*copyc osp$i_await_activity_completion
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$execute
*copyc pmp$get_unique_name
*copyc pmp$get_compact_date_time
*copyc pmp$get_job_names
*copyc pmp$get_program_description
*copyc pmp$get_program_size
*copyc pmp$get_user_identification
*copyc pmp$log
*copyc rfp$accept_connect_request
*copyc rfp$accept_switch_offer
*copyc rfp$acquire_connect_request
*copyc rfp$application_sign_off
*copyc rfp$application_sign_on
*copyc rfp$cancel_switch_offer
*copyc rfp$get_local_host_physical_id
*copyc rfp$offer_connection_switch
*copyc rfp$store
*copyc rmp$get_device_class
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_attributes
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc clt$parameter_list
*copyc fse$copy_validation_errors
*copyc jmt$system_job_parameters
*copyc nae$application_interfaces
*copyc nfc$library_definitions
*copyc nfc$command_definitions
*copyc nfc$parameter_definitions
*copyc nfc$parameter_04_definitions
*copyc nfc$parameter_20_definitions
*copyc nfe$batch_transfer_services
*copyc nfe$ptf_condition_codes
*copyc nft$application_values
*copyc nft$buffer_control_block
*copyc nft$control_block
*copyc nft$lcn_application_names
*copyc nft$nam_application_names
*copyc nft$parameter_04_values
*copyc nft$parameter_set
*copyc nft$ptfs_job_submit_block
*copyc nft$task_list
*copyc nft$task_queue
*copyc nfv$lcn_application_names
*copyc nfv$nam_application_names
*copyc nfv$ptf_parameter_rules
*copyc nfv$ptf_required_params
*copyc nft$parameter_03_netvalues
*copyc nfv$ptf_send_p03_values
*copyc nfv$p04_values
*copyc oss$job_paged_literal
*copyc ost$caller_identifier
*copyc rfe$condition_codes
?? POP ??
{}

  CONST
    nfc$ptfs_network_flag_nam = 'N',
    nfc$ptfs_network_flag_lcn = 'L';

{}

  TYPE
    buffer_list_element = record
      buffer: string (nfc$command_buffer_size),
      length: 1 .. nfc$command_buffer_size,
      forward_pointer: ^buffer_list_element,
    recend;

{}

  TYPE
    nft$ptfs_messages = (status_msg, text_msg);

{}

  TYPE
    nft$ptfs_job_switch_params = record
      source_job_name: jmt$system_supplied_name,
      path_info: nft$network_connection,
      network_file: ost$unique_name,
    recend;

{}

  TYPE
    nft$ptfs_message = record
      case msgtype: nft$ptfs_messages of
      = status_msg =
        log_status: ost$status,
      = text_msg =
        log_text: string (nfc$trace_commands_width),
      casend,
    recend;

{}

  TYPE
    nft$ptfs_switch_states = (nfc$switch_complete, nfc$switch_failed_cancelled, nfc$switch_failed_lost,
          nfc$no_switch_attempted);

  TYPE
    caller_identifier = (user_ptfs_job_call, user_ptfs_job_logout, ptfs_job_generation_task,
                          ptfs_scan_scl_handler_id);

{}
?? NEWTITLE := 'Global variables', EJECT ??
    VAR
      nfv$rft_parameter_set: [STATIC, XDCL] nft$parameter_set;
?? OLDTITLE ??
?? NEWTITLE := '[#GATE,XDCL] nfp$file_transfer_boot', EJECT ??

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

{
{ Procedure  nfp$file_transfer_boot
{
{ Purpose    This is the starting procedure for the dreaded PTFS "BOOT".
{            The boot is a task which receives all incoming PTFS connections
{            for processing.  This processing is done by boot initiated tasks
{            whose function is to build a user PTFS batch job.
{
{      ----------      --------------      -----------------
{     |          |    |              |    |                 |
{     | Connect  |--->| Spin off job |--->| Submit off PTFS |
{     | Received |--->| builder task |--->| user job        |
{     |          |    |              |    |                 |
{      ----------      --------------      -----------------
{
{     nfp$file_         nfp$ptfs_job_        nfp$user_ptfs_job
{       transfer_boot   generation_task
{
{
{ Description
{            This routine is the starting procedure for the PTFS boot
{            task.  This task is responsible for receiving incoming PTFS
{            connections and executing a service task per connection.
{            If for any reason the service task cannot be executed, the
{            connection will be terminate.
{
{ Input parameters
{            None
{
{ Output parameters
{            None
{
{ Algorithm
{            Sign on as server to access methods
{            Do forever
{              Receive connect
{              If error, abort
{              Execute service task
{            Doend
{
?? EJECT ??

    VAR
      conditions: pmt$condition,
      nfv$control_block: nft$control_block,
      establish_descriptor: pmt$established_handler,
      ignore_status: ost$status,
      lcn_boot: boolean,
      max_lcn_ptfs_connections: rft$application_connections,
      max_nam_ptfs_connections: nat$number_of_connections,
      nam_boot: boolean,
      number_of_libraries: pmt$number_of_libraries,
      number_of_modules: pmt$number_of_modules,
      number_of_objects: pmt$number_of_object_files,
      parameter_block: SEQ (REP 1 of nft$ptfs_job_switch_params),
      parameter_pointer: ^nft$ptfs_job_switch_params,
      parameter_set: nft$ptfs_job_switch_params,
      program_attributes: ^pmt$program_attributes,
      program_description: ^pmt$program_description,
      program_parameters: ^pmt$program_parameters,
      ptfs_task_queue: nft$task_queue,
      task_id: pmt$task_id,
      task_status: pmt$task_status;

?? NEWTITLE := '  ptfs_boot_handler', EJECT ??

    PROCEDURE ptfs_boot_handler
      (    condition: pmt$condition;
           condition_desc: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR trap_status: ost$status);

      VAR
        condition_handler_status: ost$status,
        local_status: ost$status;


      pmp$log ('PTFS boot task terminating', condition_handler_status);
      nfp$terminate_path (nfv$control_block.application, FALSE, nfv$control_block.path,
            condition_handler_status);
      rfp$application_sign_off (nfv$lcn_application_names [nfv$control_block.application],
            condition_handler_status);
      nap$detach_server_application (nfv$nam_application_names [nfv$control_block.application],
            condition_handler_status);
      IF condition.reason <> $pmt$block_exit_reason [pmc$program_termination] THEN
        osp$set_status_from_condition (nfc$status_id, condition, save_area, local_status,
              condition_handler_status);
        IF condition_handler_status.normal THEN
          nfp$format_message_to_job_log (local_status);
        IFEND;
      IFEND;

    PROCEND ptfs_boot_handler;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    ptfs_task_queue.head := NIL;
    ptfs_task_queue.tail := NIL;
    ptfs_task_queue.number_of_tasks := 0;
    nam_boot := FALSE;
    lcn_boot := FALSE;
    nfv$control_block.path.application_sequence_number := 1;
    nfv$control_block.application := nfc$application_ptfs;
    nfv$control_block.path.path_connected := FALSE;
    nfv$control_block.network_buffer_list.head := NIL;
    nfv$control_block.network_buffer_list.tail := NIL;
    ALLOCATE nfv$control_block.path.network_file: [osc$max_name_size];
    IF nfv$control_block.path.network_file = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'nfp$ptfs_boot - no VM', status);
      RETURN;
    IFEND;

    conditions.selector := pmc$condition_combination;
    conditions.combination := $pmt$condition_combination [pmc$block_exit_processing];
    pmp$establish_condition_handler (conditions, ^ptfs_boot_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      pmp$log ('PTFS boot error **1', ignore_status);
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;

{   Get description for connection servicing task

    pmp$get_program_size (number_of_objects, number_of_modules, number_of_libraries, status);
    IF NOT status.normal THEN
      pmp$log ('PTFS boot error **2', ignore_status);
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;
    PUSH program_description: [[REP (#SIZE (pmt$program_attributes) +
          (number_of_objects * #SIZE (amt$local_file_name)) + (number_of_modules *
          #SIZE (pmt$program_name)) + (number_of_libraries * #SIZE (amt$local_file_name))) OF cell]];
    pmp$get_program_description (program_description^, status);
    IF NOT status.normal THEN
      pmp$log ('PTFS boot error **3', ignore_status);
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;
    RESET program_description;
    NEXT program_attributes IN program_description;
    program_attributes^.contents := program_attributes^.contents +
          $pmt$prog_description_contents [pmc$starting_proc_specified, pmc$term_error_level_specified,
          pmc$debug_mode_specified, pmc$debug_input_specified, pmc$debug_output_specified];
    program_attributes^.starting_procedure := 'NFP$PTFS_JOB_GENERATION_TASK';
    program_attributes^.termination_error_level := pmc$fatal_load_errors;
    program_attributes^.debug_mode := FALSE;
    program_attributes^.debug_input := 'COMMAND';
    program_attributes^.debug_output := '$OUTPUT';

{   MAIN loop

    WHILE TRUE DO

{     Get network path name

      pmp$get_unique_name (nfv$control_block.path.network_file^, status);
      IF NOT status.normal THEN
        pmp$log ('PTFS boot error **4', ignore_status);
        nfp$format_message_to_job_log (status);
        RETURN;
      IFEND;
      nfv$control_block.parameter_rules := ^nfv$ptf_parameter_rules;
      nfv$control_block.path.application_sequence_number :=
            nfv$control_block.path.application_sequence_number + 1;

{     Get network connection }

      nfp$get_server_asynch_event (nfv$control_block.application, nfv$control_block.path, lcn_boot, nam_boot,
            ptfs_task_queue, status);
      IF NOT status.normal THEN
        pmp$log ('PTFS boot error **5', ignore_status);
        nfp$format_message_to_job_log (status);
        RETURN;
      IFEND;

{     Now we have a connection, execute the service task

      parameter_set.path_info := nfv$control_block.path;
      parameter_set.network_file.value := nfv$control_block.path.network_file^;
      program_parameters := ^parameter_block;
      RESET program_parameters;
      NEXT parameter_pointer IN program_parameters;
      parameter_pointer^ := parameter_set;
      RESET program_parameters;

      pmp$execute (program_description^, program_parameters^, osc$nowait, task_id, task_status, status);
      IF status.normal THEN
        nfp$enqueue_task (task_id, nfv$control_block.path, ptfs_task_queue);
        nfv$control_block.path.path_connected := FALSE;
      ELSE
        {** Disconnect path **}
        nfp$format_message_to_job_log (status);
        nfp$terminate_path (nfv$control_block.application, FALSE, nfv$control_block.path, ignore_status);
      IFEND;
    WHILEND;

  PROCEND nfp$file_transfer_boot;
?? OLDTITLE ??
?? NEWTITLE := '[#GATE,XDCL] nfp$ptfs_job_generation_task', EJECT ??

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

{
{ Procedure  nfp$ptfs_job_generation_task
{
{ Purpose    This is the entry procedure for the PTFS job generation task.
{            This task is executed by the "BOOT" to build the user PTFS job.
{            The job is then submitted for batch execution.  If the user
{            job fails, this task completes the protocol.
{
{ Description
{            Under normal conditions, this procedure has four steps.  First,
{            the connection is opened.  Second, the RFT(s) are read (network)
{            and the user job is written to a file.  Third, the user job
{            is submitted as a batch job.  Fourth, and finally, the connection
{            is switched to the user job.  Note: if either step three or
{            four fail, it is the resposibility of this task to complete
{            the A-A protocol sequence, beginning with RNEG.
{            The format of the user job includes, a LOGIN card, a command
{            to execute PTFS for the job, the login card (again) to be used
{            as recovery text (protocol parameter 05), the RFT(s) protocol
{            used to start the job, and the SCL commands to execute.
{            The user PTFS job must crack its protocol prior to sending
{            RPOS or RNEG.
{
{ Input parameters
{            parameter_list       : via PMP$EXECUTE, contains information
{                                   necessary to establish connection.
{
{ Output parameters
{            status               : final status
{
{ Algorithm
{            Get connection info
{            Establish connect
{            If success then
{              build user job
{              submit user job
{              if success then
{                switch connection
{                if success then
{                  return
{                else
{                  complete protocol (RNEG)
{                ifend
{              else
{                complete protocol (RNEG)
{              ifend
{            ifend
{
?? EJECT ??

    VAR
      conditions: pmt$condition,
      nfv$control_block: nft$control_block,
      establish_descriptor: pmt$established_handler,
      file_attributes: ^fst$attachment_options,
      job_file_id: amt$file_identifier,
      ignore_connection_time: ost$date_time,
      ignore_status: ost$status,
      initiated_job_system_name: jmt$system_supplied_name,
      nam_attributes: ^nat$change_attributes,
      rhfam_attributes: ^rft$change_attributes,
      start_up_message: nft$ptfs_message,
      switch_state: nft$ptfs_switch_states,
      trace_status: ost$status;

    VAR
      nfv$p04_values: [XREF] nft$parameter_04_values;

?? NEWTITLE := '  ptfs_job_generation_task_hand', EJECT ??

    PROCEDURE ptfs_job_generation_task_hand
      (    condition: pmt$condition;
           condition_desc: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR trap_status: ost$status);

      VAR
        condition_handler_status: ost$status,
        local_status: ost$status;


      nfp$terminate_path (nfv$control_block.application, FALSE, nfv$control_block.path,
            condition_handler_status);
      fsp$close_file (job_file_id, condition_handler_status);
      amp$return (nfv$control_block.file_name, condition_handler_status);
      IF condition.reason <> $pmt$block_exit_reason [pmc$program_termination] THEN
        pmp$log ('PTFS job generation task terminating abnormally', local_status);
        osp$set_status_from_condition (nfc$status_id, condition, save_area, status, condition_handler_status);
        IF condition_handler_status.normal THEN
          nfp$format_message_to_job_log (status);
        IFEND;
      IFEND;

    PROCEND ptfs_job_generation_task_hand;
?? OLDTITLE, EJECT ??
    IF nfc$trace_commands THEN
      pmp$log ('PTFS begin job generation task', ignore_status);
    IFEND;
    status.normal := TRUE;
    conditions.selector := pmc$condition_combination;
    conditions.combination := $pmt$condition_combination [pmc$block_exit_processing];
    pmp$establish_condition_handler (conditions, ^ptfs_job_generation_task_hand,
           ^establish_descriptor, status);
    IF NOT status.normal THEN
      pmp$log ('PTFS job generation task - cannot establish handler', ignore_status);
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;

{ The P03 values are for requested parameter values, required parameter values, and allowed parameter
{ values.  The LCN P03 value is C and the NAM/VE P03 value is CS.

    nfp$initialize_control_block (nfc$application_ptfs, nfc$p31_unspecified,
          nfv$ptf_send_p03_values [nfc$network_lcn], nfv$ptf_send_p03_values [nfc$network_lcn],
          nfv$ptf_send_p03_values [nfc$network_nam], nfc$p00_a102, nfc$null, ^nfv$ptf_parameter_rules,
          nfv$control_block);

    PUSH nfv$control_block.path.network_file: [osc$max_name_size];
    get_ptfs_connection_info (parameter_list, nfv$control_block.path);
    fsp$open_file (nfv$control_block.path.network_file^, amc$record, NIL, NIL, NIL, NIL, NIL,
          nfv$control_block.path.network_file_id, status);
    IF NOT status.normal THEN
      IF nfc$trace_commands THEN
        pmp$log ('PTFS job generation task - cannot open connection file', ignore_status);
        nfp$format_message_to_job_log (status);
      IFEND;
      RETURN;
    ELSE
      nfv$control_block.path.path_connected := TRUE;
      CASE nfv$control_block.path.network_type OF
      = nfc$network_nam =
        PUSH nam_attributes: [1 .. 1];
        nam_attributes^ [1].kind := nac$data_transfer_timeout;
        nam_attributes^ [1].data_transfer_timeout := nfv$control_block.time_out * nfc$milliseconds;
        nap$store_attributes (nfv$control_block.path.network_file_id, nam_attributes^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      = nfc$network_lcn =
        PUSH rhfam_attributes: [1 .. 1];
        rhfam_attributes^ [1].key := rfc$data_transfer_timeout;
        rhfam_attributes^ [1].data_transfer_timeout := nfv$control_block.time_out * nfc$milliseconds;
        rfp$store (nfv$control_block.path.network_file_id, rhfam_attributes^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
              'nfp$ptfs_job_generation_task bad network type', status);
        nfp$format_message_to_job_log (status);
        RETURN;
      CASEND;
    IFEND;
    IF nfc$trace_commands THEN
      pmp$log ('PTFS connection opened o.k.', ignore_status);
    IFEND;

    start_up_message.msgtype := text_msg;
    start_up_message.log_text := 'TASK STARTED';

{   Get name for user ptfs job file

    pmp$get_unique_name (nfv$control_block.file_name, status);
    IF NOT status.normal THEN
      IF nfc$trace_commands THEN
        pmp$log ('PTFS job generation task - cannot get unique name', ignore_status);
        nfp$format_message_to_job_log (status);
      IFEND;
      RETURN;
    IFEND;
    PUSH file_attributes: [1 .. 1];
    file_attributes^ [1].selector := fsc$open_position;
    file_attributes^ [1].open_position := amc$open_at_boi;
    fsp$open_file (nfv$control_block.file_name, amc$record, file_attributes, NIL, { default creation attr }
    NIL, { mandated creation attr }
    NIL, { attribute validation }
    NIL, { attribute override }
    job_file_id, status);
    IF NOT status.normal THEN
      IF nfc$trace_commands THEN
        pmp$log ('PTFS job generation task - cannot open job file', ignore_status);
        nfp$format_message_to_job_log (status);
      IFEND;
      RETURN;
    IFEND;

{     Build job file from RFT

    IF nfc$trace_commands THEN
      pmp$log ('PTFS start build user job', ignore_status);
    IFEND;
    build_ptfs_job (job_file_id, nfv$rft_parameter_set, nfv$control_block, status);
    fsp$close_file (job_file_id, ignore_status);

{   If job was built o.k., try to submit job

    IF status.normal THEN
      IF nfc$trace_commands THEN
        pmp$log ('PTFS job write success, attempt submit', ignore_status);
      IFEND;
      ptfs_submit_user_job (nfv$control_block.path, nfv$control_block.system_job_name,
            nfv$control_block.file_name, nfv$control_block.application, nfv$control_block.remote_ring,
            initiated_job_system_name, status);
    ELSE
      IF nfc$trace_commands THEN
        pmp$log ('PTFS job write failed', ignore_status);
      IFEND;
    IFEND;

{   Clean up batch job file

    amp$return (nfv$control_block.file_name, ignore_status);

{   If batch job/build job unsuccessfull, set up status

    IF NOT status.normal THEN
      IF NOT (status.condition = jme$maximum_jobs) THEN
        osp$set_status_abnormal (nfc$status_id, nfv$p04_values [nfc$p04_invalid_account_pw].condition, '',
              nfv$control_block.state_of_transfer);
      ELSE
        osp$set_status_abnormal (nfc$status_id, nfv$p04_values [nfc$p04_receiver_problem_retry].condition, '',
              nfv$control_block.state_of_transfer);
      IFEND;
      nfv$control_block.local_status := status;
      switch_state := nfc$no_switch_attempted;
    ELSE

{     If the job was successfully started, try to switch the connection. }

      fsp$close_file (nfv$control_block.path.network_file_id, status);
      IF NOT status.normal THEN
        switch_state := nfc$switch_failed_lost;
      ELSE
        ptfs_switch_connection (initiated_job_system_name, nfv$control_block, switch_state, status);
        nfp$set_abnormal_if_normal (status, nfv$control_block.local_status);
      IFEND;
    IFEND;

{   Handle switch/no switch situations }

    IF nfc$trace_commands THEN
      pmp$log ('PTFS handle switch states', ignore_status);
    IFEND;
    CASE switch_state OF
    = nfc$switch_complete =
      amp$return (nfv$control_block.path.network_file^, ignore_status);
      nfv$control_block.path.path_connected := FALSE;
    = nfc$switch_failed_cancelled =
      IF nfc$trace_commands THEN
        pmp$log ('PTFS JOB gen task, connect switch failed', trace_status);
      IFEND;
      fsp$open_file (nfv$control_block.path.network_file^, amc$record, NIL, { File attachment opts }
      NIL, { Default creation opts }
      NIL, { Mandated creation opts }
      NIL, { Attribute validation }
      NIL, { Attribute override }
      nfv$control_block.path.network_file_id, status);
      IF NOT status.normal THEN
        IF nfc$trace_commands THEN
          pmp$log ('PTFS job generation task - cannot reopen connection', ignore_status);
          nfp$format_message_to_job_log (status);
        IFEND;
        amp$return (nfv$control_block.path.network_file^, ignore_status);
        pmp$disestablish_cond_handler (conditions, ignore_status);
        RETURN;
      ELSE
        CASE nfv$control_block.path.network_type OF
        = nfc$network_nam =
          PUSH nam_attributes: [1 .. 1];
          nam_attributes^ [1].kind := nac$data_transfer_timeout;
          nam_attributes^ [1].data_transfer_timeout := nfv$control_block.time_out * nfc$milliseconds;
          nap$store_attributes (nfv$control_block.path.network_file_id, nam_attributes^, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = nfc$network_lcn =
          PUSH rhfam_attributes: [1 .. 1];
          rhfam_attributes^ [1].key := rfc$data_transfer_timeout;
          rhfam_attributes^ [1].data_transfer_timeout := nfv$control_block.time_out * nfc$milliseconds;
          rfp$store (nfv$control_block.path.network_file_id, rhfam_attributes^, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
                'nfp$ptfs_job_generation_task bad network type', status);
          RETURN;
        CASEND;

      IFEND;
      IF nfv$control_block.state_of_transfer.normal THEN
        osp$set_status_abnormal (nfc$status_id, nfe$application_time_out, '',
              nfv$control_block.state_of_transfer);
      IFEND;
      ptfs_process_protocol (FALSE, ptfs_job_generation_task,
        nfv$control_block, ignore_connection_time, status);
      IF NOT status.normal THEN
        IF nfc$trace_commands THEN
          pmp$log ('PTFS job generation task - cannot complete protocol', ignore_status);
          nfp$format_message_to_job_log (status);
        IFEND;
        RETURN;
      IFEND;
      nfp$terminate_path (nfv$control_block.application, FALSE, nfv$control_block.path, status);
    = nfc$no_switch_attempted =
      ptfs_process_protocol (FALSE, ptfs_job_generation_task,
        nfv$control_block, ignore_connection_time, status);
      IF NOT status.normal THEN
        IF nfc$trace_commands THEN
          pmp$log ('PTFS job generation task - cannot complete protocol', ignore_status);
          nfp$format_message_to_job_log (status);
        IFEND;
        RETURN;
      IFEND;
      nfp$terminate_path (nfv$control_block.application, FALSE, nfv$control_block.path, status);
    = nfc$switch_failed_lost =
      IF nfc$trace_commands THEN
        pmp$log (' PTFS JOB gen task, connect switch failed', trace_status);
        nfp$format_message_to_job_log (status);
      IFEND;
      nfp$terminate_path (nfv$control_block.application, FALSE, nfv$control_block.path, status);
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
            'nfp$ptfs_job_generation_task, case error', status);
      RETURN;
    CASEND;
    IF nfc$trace_commands THEN
      pmp$log ('PTFS normal exit', ignore_status);
    IFEND;
    pmp$disestablish_cond_handler (conditions, ignore_status);

  PROCEND nfp$ptfs_job_generation_task;
?? OLDTITLE ??
?? NEWTITLE := '[#GATE,XDCL] nfp$user_ptfs_job', EJECT ??

{ PURPOSE:
{   This task is called from inside the PTFS user job.  It is the first task
{   executed after user prolog (if allowed by site).  Essentially, it readies
{   the job as a PTFS job and starts execution of user SCL statements.
{
{ DESCRIPTION:
{   This task accepts the connection switch offer and reads information out of
{   the job which was placed there by the job builder task.  This information
{   consists of recovery text (LOGIN information) which is passed back to the
{   initiating host, and protocol information.  The protocol information is the
{   RFT(s) which were used to create this job.  Once the RFT(s) have been
{   digested, assuming no errors were found, this task executes the
{   provided user SCL statements.  Here things get a bit tricky.  Before
{   executing the SCL, two new commands are given to SCL.  They are SEND_FILE
{   and RECEIVE_FILE.  Now if a SEND_FILE or RECEIVE_FILE is called it will
{   attempt file transfer.  So PTFS has called an SCL routine who has called a
{   routine back in this module.  Status and protocol information is kept
{   in the STATIC control block so SEND_FILE and RECEIVE_FILE may access it.
{   When SCL processing is complete, this routine checks to see if a file
{   transfer has been attempted.  If so, the RPOS was sent by the file
{   transfer processor.  If not, we send the RPOS or RNEG (if we got
{   back a bad status from SCL) and continue in the protocol.
{
{ NOTE:
{   Information is sent from the PTF Server task to the user job by
{   using the job attribute: JOB_INPUT_DEVICE.  This information
{   contains the system job name of the PTF Server, the connection
{   file name, and the type of connection (NAM or LCN).

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

    VAR
      begin_connection_time: ost$date_time,
      caller_id: ost$caller_identifier,
      caller_in_current_task: boolean,
      conditions: pmt$condition,
      error_message_string: string (osc$max_string_size),
      file_attachment_options: ^fst$attachment_options,
      ignore_file_id: amt$file_identifier,
      ignore_reporting_option: boolean,
      ignore_status: ost$status,
      establish_descriptor: pmt$established_handler,
      input_block_handle: clt$block_handle,
      input_executable: boolean,
      input_file_id: amt$file_identifier,
      job_attribute_changes_p: ^jmt$job_attribute_changes,
      lcn_number_server_connects: rft$application_connections,
      local_status: ost$status,
      nam_attributes: ^nat$change_attributes,
      nam_switch_attributes: ^nat$change_attributes,
      network_file_name: ost$name,
      physical_id: rft$physical_identifier,
      ready_index: integer,
      retrieve_archived_file: boolean,
      rhfam_attributes: ^rft$change_attributes,
      source_job_name: jmt$system_supplied_name,
      submit_option: ^jmt$job_attribute_results,
      submit_option_ptr: 1 .. jmc$job_input_device_size + 1,
      trace_status: ost$status,
      user_id: ost$user_identification,
      wait_list: ^ost$i_wait_list;

    VAR
      nfv$control_block: [STATIC, XDCL] nft$control_block;

?? NEWTITLE := 'ptfs_user_job_handler', EJECT ??

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

      VAR
        condition_handler_status: ost$status,
        local_status: ost$status;

      IF condition.reason <> $pmt$block_exit_reason [pmc$program_termination] THEN
        pmp$log ('USER PTFS job terminating abnormally', local_status);
        osp$set_status_from_condition (nfc$status_id, condition, save_area, local_status,
              condition_handler_status);
        IF condition_handler_status.normal THEN
          nfp$format_message_to_job_log (local_status);
        IFEND;
      IFEND;
      nfp$terminate_path (nfv$control_block.application, TRUE, nfv$control_block.path, local_status);

    PROCEND ptfs_user_job_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    nfv$control_block.application := nfc$application_ptfs;
    conditions.selector := pmc$condition_combination;
    conditions.combination := $pmt$condition_combination [pmc$block_exit_processing];
    pmp$establish_condition_handler (conditions, ^ptfs_user_job_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;
    PUSH job_attribute_changes_p: [1 .. 1];
    job_attribute_changes_p^ [1].key := jmc$output_disposition;
    job_attribute_changes_p^ [1].output_disposition.key := jmc$discard_standard_output;
    jmp$change_job_attributes (job_attribute_changes_p, status);
    IF NOT status.normal THEN
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;

{ Get connection information from the job attribute job_input_device.

    PUSH submit_option: [1 .. 2];
    submit_option^ [1].key := jmc$job_input_device;
    PUSH submit_option^[1].job_input_device;
    submit_option^ [2].key := jmc$origin_application_name;
    jmp$get_job_attributes (submit_option, status);
    IF NOT status.normal THEN
      nfp$format_message_to_job_log (status);
      RETURN;
    ELSE
      IF nfc$trace_commands THEN
        pmp$log(' UPTFS user job information',trace_status);
        pmp$log(submit_option^[1].job_input_device^ .text,trace_status);
        pmp$log(' UPTFS initiating application',trace_status);
        pmp$log(submit_option^[2].origin_application_name,trace_status);
      IFEND;
    IFEND;
    IF submit_option^ [2].origin_application_name <> nfv$nam_application_names
          [nfv$control_block.application] THEN
      error_message_string (1, 30) := 'Invalid initiating application';
      error_message_string (31, * ) := submit_option^ [2].origin_application_name;
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, error_message_string, status);
      RETURN;
    IFEND;

{ Crack user information for job

    submit_option_ptr := 1;
    source_job_name (submit_option_ptr, #SIZE (source_job_name)) := submit_option^ [1].
          job_input_device^ .text (1, #SIZE (source_job_name));
    submit_option_ptr := submit_option_ptr + #SIZE (source_job_name);
    network_file_name := submit_option^ [1].job_input_device^ .text
          (submit_option_ptr, #SIZE (network_file_name));
    submit_option_ptr := submit_option_ptr + #SIZE (network_file_name);

    IF submit_option^ [1].job_input_device^ .text (submit_option_ptr, 1) = nfc$ptfs_network_flag_nam THEN
      nfv$control_block.path.network_type := nfc$network_nam;
    ELSEIF submit_option^ [1].job_input_device^ .text (submit_option_ptr, 1) = nfc$ptfs_network_flag_lcn THEN
      nfv$control_block.path.network_type := nfc$network_lcn;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'nfp$user_ptfs_job bad network type',
            status);
      RETURN;
    IFEND;

{ The P03 values are for requested parameter values, required parameter values, and allowed parameter
{ values.  The LCN P03 value is C and the NAM/VE P03 value is CS.

    nfp$initialize_control_block (nfc$application_ptfs, nfc$p31_unspecified,
          nfv$ptf_send_p03_values [nfc$network_lcn], nfv$ptf_send_p03_values [nfc$network_lcn],
          nfv$ptf_send_p03_values [nfc$network_nam], nfc$p00_a102, nfc$null, ^nfv$ptf_parameter_rules,
          nfv$control_block);

{ Set the Control Block's LAST_COMMAND_RECEIVED to RFT because the RFT was received by the PTFS system task.

    nfv$control_block.last_command_received := nfc$rft;

    PUSH nfv$control_block.path.network_file: [#SIZE (network_file_name)];
    nfv$control_block.path.network_file^ := network_file_name;
    nfv$control_block.path.path_connected := TRUE;
    nfv$control_block.path.application_sequence_number := 0;

{ Accept the switch offer, if it is around

    CASE nfv$control_block.path.network_type OF
    = nfc$network_nam =
      PUSH wait_list: [1 .. 2];
      wait_list^ [1].activity := nac$i_await_switch_offer;
      wait_list^ [1].source := source_job_name;
      wait_list^ [2].activity := osc$i_await_time;
      wait_list^ [2].milliseconds := nfv$control_block.time_out * nfc$milliseconds;
      osp$i_await_activity_completion (wait_list^, ready_index, status);
      IF NOT status.normal THEN
        nfp$format_message_to_job_log (status);
        RETURN;
      IFEND;

      IF ready_index <> 1 THEN
        osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'No connect switch offer available',
              status);
        nfp$format_message_to_job_log (status);
        RETURN;
      IFEND;

      nam_switch_attributes := NIL;
      nap$accept_switch_offer (nfv$control_block.path.network_file^, source_job_name, nam_switch_attributes,
            nfv$control_block.time_out * nfc$milliseconds, status);
    = nfc$network_lcn =
      IF nfc$trace_commands THEN
        pmp$log (' UPTFS Attempt sign on', trace_status);
      IFEND;
      lcn_number_server_connects := 1;
      rfp$application_sign_on (nfv$lcn_application_names [nfv$control_block.application], rfc$partner,
            lcn_number_server_connects, status);
      IF NOT status.normal THEN
        nfp$format_message_to_job_log (status);
        RETURN;
      IFEND;

      IF nfc$trace_commands THEN
        pmp$log (' UPTFS attempt accept switch offer', trace_status);
      IFEND;
      rfp$accept_switch_offer (nfv$lcn_application_names [nfv$control_block.application],
            nfv$control_block.path.network_file^, NIL, nfv$control_block.time_out * nfc$milliseconds,
            source_job_name, status);
      nfv$control_block.send_facilities := nfv$ptf_send_p03_values [nfc$network_lcn];
      nfv$control_block.required_facilities := nfv$ptf_send_p03_values [nfc$network_lcn];
      nfv$control_block.allowed_facilities := nfv$ptf_send_p03_values [nfc$network_lcn];
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'nfp$user_ptfs_job, case error',
            status);
      nfp$format_message_to_job_log (status);
      RETURN;
    CASEND;
    IF NOT status.normal THEN
      nfp$format_message_to_job_log (status);
      RETURN;
    ELSE
      IF nfc$trace_commands THEN
        pmp$log (' UPTFS connection switch success', trace_status);
      IFEND;
      fsp$open_file (nfv$control_block.path.network_file^, amc$record, NIL, NIL, NIL, NIL, NIL,
            nfv$control_block.path.network_file_id, status);
      IF NOT status.normal THEN
        amp$return (nfv$control_block.path.network_file^, local_status);
        nfp$format_message_to_job_log (status);
        RETURN;
      ELSE
        nfv$control_block.path.path_connected := TRUE;
        CASE nfv$control_block.path.network_type OF
        = nfc$network_nam =
          PUSH nam_attributes: [1 .. 1];
          nam_attributes^ [1].kind := nac$data_transfer_timeout;
          nam_attributes^ [1].data_transfer_timeout := nfv$control_block.time_out * nfc$milliseconds;
          nap$store_attributes (nfv$control_block.path.network_file_id, nam_attributes^, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          pmp$get_user_identification (user_id, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          nfv$control_block.transfer_pid_length := nfp$string_length (user_id.family);
          nfv$control_block.transfer_pid := user_id.family (1, nfv$control_block.transfer_pid_length);
        = nfc$network_lcn =
          PUSH rhfam_attributes: [1 .. 1];
          rhfam_attributes^ [1].key := rfc$data_transfer_timeout;
          rhfam_attributes^ [1].data_transfer_timeout := nfv$control_block.time_out * nfc$milliseconds;
          rfp$store (nfv$control_block.path.network_file_id, rhfam_attributes^, status);
          IF NOT status.normal THEN
            RETURN
          IFEND;
          rfp$get_local_host_physical_id(physical_id,status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          nfv$control_block.transfer_pid_length := #SIZE(physical_id);
          nfv$control_block.transfer_pid := physical_id;
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
                'nfp$ptfs_job_generation_task bad network type', status);
          RETURN;
        CASEND;
      IFEND;
    IFEND;

    pmp$get_compact_date_time( begin_connection_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    #CALLER_ID (caller_id);
    nfv$control_block.remote_ring.value := caller_id.ring;

{ Set up for reading text from the command file }

    clp$push_input (clc$current_command_input, osc$null_name, '', FALSE, TRUE, input_block_handle,
          input_file_id, input_executable, status);
    IF NOT status.normal THEN
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;

{ Get the recovery text for this job

    IF nfc$trace_commands THEN
      pmp$log (' UPTFS get recovery text', trace_status);
    IFEND;
    get_recovery_text (nfv$control_block.send_directives, status);
    IF NOT status.normal THEN
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;

{ Crack the RFT block(s) contained in the job

    IF nfc$trace_commands THEN
      pmp$log (' UPTFS begin cracking RFTs', trace_status);
    IFEND;
    crack_embedded_rfts (nfv$control_block, status);

      clp$pop_input (TRUE, input_block_handle, input_file_id, input_executable, NIL, ignore_status);

{ Build accounting stuff associated with directives

    nfv$control_block.transfer_directives_length := nfp$count_directives_text(nfv$control_block.
          received_directives.head);
    IF (nfv$control_block.received_directives.head^.link <> NIL) THEN
      build_05_directives_text( nfv$control_block.received_directives.head^.link, nfv$control_block.
           ptf_scl_directive);
    ELSE
      nfv$control_block.ptf_scl_directive.size := 0;
    IFEND;

    nfp$deallocate_dirs_from_head (nfv$control_block.received_directives, ignore_status);
    IF status.normal THEN

{ Pass the rest of the job stream to SCL for processing

      ptfs_scan_scl_command_file (clc$current_command_input, FALSE, begin_connection_time, nfv$control_block,
            status);
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly, '', nfv$control_block.state_of_transfer);
      nfp$set_abnormal_if_normal (status, nfv$control_block.local_status);
    IFEND;

{ The SCL processing has completed, finish protocol

    IF nfv$control_block.state_of_transfer.condition = nfv$p04_values
        [nfc$p04_file_unavailable].condition THEN
      ptfs_process_protocol (FALSE, user_ptfs_job_call, nfv$control_block, begin_connection_time,
           ignore_status);
      consult_archive_response_var (ignore_reporting_option, retrieve_archived_file);
      IF retrieve_archived_file THEN
        PUSH file_attachment_options: [1..1];
        file_attachment_options^[1].selector := fsc$create_file;
        file_attachment_options^[1].create_file := FALSE;
        fsp$open_file (nfv$control_block.file_name, amc$record, file_attachment_options, NIL, NIL,
           NIL, NIL, ignore_file_id, status);
      IFEND;
    ELSE
      ptfs_process_protocol (TRUE, user_ptfs_job_call, nfv$control_block, begin_connection_time,
           ignore_status);
    IFEND;

    nfp$terminate_path (nfv$control_block.application, TRUE, nfv$control_block.path, ignore_status);
    pmp$disestablish_cond_handler (conditions, ignore_status);

  PROCEND nfp$user_ptfs_job;
?? OLDTITLE ??
?? NEWTITLE := 'build_ptfs_job', EJECT ??

  PROCEDURE build_ptfs_job
    (    job_file_id: amt$file_identifier;
     VAR received_parameters: nft$parameter_set;
     VAR nfv$control_block: nft$control_block;
     VAR status: ost$status);

{
{ Procedure  build_ptfs_job
{
{ Purpose    This procedure writes a file which is submitted as a job
{            to initialize PTFS.  The job consists of login, a call to
{            the PTFS application, recovery text (login), and all
{            command buffers associated with the RFT.  The command
{            buffers are followed by the SCL to be executed.
{
{ Description
{            Some comments,
{            1. If the first received command buffer does not contain
{               an user text (p05) it, and all command buffers received
{               until user text is received must be saved.  The saved
{               buffers must then be written into the job in the correct
{               order.
{            2. The job looks rather like this...
{                   Login,...            User supplied login
{                   PTFS                 Call to ptfs
{                   Login,...            Again, for recovery text
{                    Command buffer 1
{                   *EOB
{                    Command buffer 2
{                   *EOB
{                    Command buffer n
{                   *EOB
{                   *EOC
{                   All SCL commands
{
{ Input parameters
{            Job_file_id          : File ID of job being written
{
{ Input/output parameters
{            Control_block        : Transfer control block
{
{ Output parameters
{            Status               : Return status
{
{ Algorithm
{            Crack command and number of parameters
{            For 1 to # of parameters Do
{              Case parameter Of
{              =protocol_id= nfp$receive_parameter_00
{              =user_text= If first occurence then
{                            Write in file (Login)
{                            Write in PTFS execute task
{                            Write in file (Login again) for recovery text
{                          Ifend
{                          Enqueue directive on list
{              =time_out= nfp$receive_parameter_20
{              =host_type= nfp$receive_parameter_22
{              Else Ignore parameter, not serviced in this task
{              Casend
{              Write command buffers into job
{              Write Enqueued directives into job
{
?? EJECT ??
{}

    VAR
      abort_xfer: boolean,
      action: nft$crack_parameter_action,
      buffer_list: ^buffer_list_element,
      buffer_position: integer,
      byte_address: amt$file_byte_address,
      command_in_process: nft$protocol_commands,
      current_element: ^buffer_list_element,
      eoc_string: string (nfc$ptfs_job_end_clen),
      expected_command: nft$command_set,
      ignored_params: nft$parameter_set,
      index: integer,
      input_buffer: string (nfc$command_buffer_size),
      input_length: nft$command_pdu_size,
      last_block_received: boolean,
      negotiate_down: boolean,
      number_of_parameters: nft$number_pdu_param_range,
      parameter_identifier: nft$protocol_parameters,
      parameter_length: nft$parameter_size,
      parameter_qualifier: nft$parameter_qualifiers,
      parameter_value: string (nfc$max_param_size),
      ptfs_command: string (nfc$ptfs_command_length),
      received_command: nft$protocol_commands,
      ring_record: clt$integer,
      special_options_found: boolean,
      user_text_received: boolean;

{}
    status.normal := TRUE;
    buffer_list := NIL;
    command_in_process := nfc$unknown_command;
    current_element := NIL;
    eoc_string := nfc$ptfs_job_end_command;
    expected_command := $nft$command_set [nfc$rft];
    last_block_received := FALSE;
    ignored_params := $nft$parameter_set [];
    ptfs_command := nfc$ptfs_command_name;
    received_parameters := $nft$parameter_set [];
    special_options_found := FALSE;
    user_text_received := FALSE;
{}
{******************************************************************************}
    WHILE NOT last_block_received DO
      last_block_received := TRUE;
      nfp$get_and_crack_command (expected_command, ^input_buffer, nfv$control_block, input_length,
            number_of_parameters, received_command, command_in_process, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{}
      buffer_position := nfc$begin_params_pos;
      FOR index := 1 TO number_of_parameters DO
        IF buffer_position > STRLENGTH (input_buffer) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly, '', status);
          RETURN;
        IFEND;
        nfp$crack_parameter (received_command, nfv$control_block.protocol_in_use,
              input_buffer (buffer_position, * ), nfv$control_block.parameter_rules^,
              nfv$control_block.network_buffer_list, parameter_length, parameter_value, parameter_identifier,
              parameter_qualifier, action, ignored_params, abort_xfer, status);
        IF status.normal THEN
          received_parameters := received_parameters +
               $nft$parameter_set [parameter_identifier];
        ELSE
          RETURN;
        IFEND;
        IF action = nfc$process THEN
          CASE parameter_identifier OF
          = nfc$protocol_id =
            nfp$receive_parameter_00 (received_command, parameter_value (1, parameter_length),
                  parameter_qualifier, nfv$control_block.protocol_in_use, nfv$control_block.protocol_in_use,
                  negotiate_down, { Server doesn't
                  status);
          = nfc$user_text_directive =
            IF NOT user_text_received THEN
              user_text_received := TRUE;
{}
{     ***Write job login }
{}
              amp$put_next (job_file_id, ^parameter_value (1, parameter_length), parameter_length,
                    byte_address, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
{}
{     *** Write PTFS command }
{}
              amp$put_next (job_file_id, ^ptfs_command, STRLENGTH (ptfs_command), byte_address, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
{}
{     *** Write login again for recovery text }
{}
              amp$put_next (job_file_id, ^parameter_value (1, parameter_length), parameter_length,
                    byte_address, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              flush_job_command_buffers (job_file_id, buffer_list, status);
            ELSE
{}
{     *** Enqueue command for end of job }
{}
              ptfs_enqueue_directive (parameter_value (1, parameter_length),
                    nfv$control_block.received_directives, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;

          = nfc$special_options =
            special_options_found := TRUE;
            nfv$control_block.receive_special_options.size := parameter_length;
            IF parameter_length > 0 THEN
              nfv$control_block.receive_special_options.value := parameter_value (1, parameter_length);
            IFEND;
          = nfc$minimum_timeout_interval =
            nfp$receive_parameter_20 (parameter_value (1, parameter_length), parameter_qualifier,
                  nfv$control_block.path, nfv$control_block.time_out, status);
          = nfc$host_type =
            nfp$receive_parameter_22 (parameter_value (1, parameter_length), parameter_qualifier,
                  nfv$control_block.remote_host_type, status);
          = nfc$attribute_continued =
            last_block_received := FALSE;
          ELSE
            {    Ignore }
          CASEND;
        ELSE
        IFEND;
        buffer_position := buffer_position + parameter_length + nfc$param_header_size;
      FOREND;
      IF NOT user_text_received THEN
        IF buffer_list = NIL THEN
          PUSH buffer_list;
          current_element := buffer_list;
          current_element^.buffer := input_buffer;
          current_element^.length := input_length;
        ELSE
          PUSH current_element^.forward_pointer;
          current_element := current_element^.forward_pointer;
          current_element^.buffer := input_buffer;
          current_element^.length := input_length;
        IFEND;
      ELSE
        write_job_command_buffer (job_file_id, input_buffer (1, input_length), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    WHILEND;
{******************************************************************************}


    amp$put_next (job_file_id, ^eoc_string, STRLENGTH (eoc_string), byte_address, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    ptfs_write_user_text (job_file_id, nfv$control_block.received_directives, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF (special_options_found AND (nfv$control_block.remote_host_type = nfc$p22_nos_ve)) THEN
      clp$convert_string_to_integer (nfv$control_block.receive_special_options.
            value (1, nfv$control_block.receive_special_options.size), ring_record, status);
      IF status.normal THEN
        nfv$control_block.remote_ring.specified := TRUE;
        nfv$control_block.remote_ring.value := ring_record.value;
      IFEND;
    IFEND;
{}
  PROCEND build_ptfs_job;
?? OLDTITLE ??
?? NEWTITLE := 'consult_archive_response_var', EJECT ??
PROCEDURE consult_archive_response_var
  ( VAR report_file_archived: boolean;
    VAR retrieve_archived_file: boolean );

  CONST
    ptf_archive_response_variable = 'OSV$PTF_ARCHIVE_RESPONSE';

  VAR
    archive_response: ^clt$data_value,
    ignore_status: ost$status,
    status: ost$status;

    report_file_archived   := FALSE;
    retrieve_archived_file := TRUE;

    clp$get_variable_value (ptf_archive_response_variable, archive_response, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE archive_response^.kind OF
    = clc$keyword =
      IF archive_response^.keyword_value = 'REPORT_ERROR' THEN
        report_file_archived := TRUE;
        retrieve_archived_file := FALSE;
      ELSEIF archive_response^.keyword_value = 'REPORT_ERROR_AND_RETRIEVE' THEN
        report_file_archived := TRUE;
        retrieve_archived_file := TRUE;
      IFEND;
    = clc$name =
      IF archive_response^.name_value = 'REPORT_ERROR' THEN
        report_file_archived := TRUE;
        retrieve_archived_file := FALSE;
      ELSEIF archive_response^.name_value = 'REPORT_ERROR_AND_RETRIEVE' THEN
        report_file_archived := TRUE;
        retrieve_archived_file := TRUE;
      IFEND;
    ELSE
       pmp$log('***PTFS- the archive response variable was of an unknown type.', ignore_status);
    CASEND; { archive_repsonse^.kind

PROCEND consult_archive_response_var;
?? OLDTITLE ??
{}
?? NEWTITLE := 'flush_job_command_buffers', EJECT ??

  PROCEDURE flush_job_command_buffers
    (    job_file_id: amt$file_identifier;
     VAR buffer_pointer: ^buffer_list_element;
     VAR status: ost$status);

{
{ Procedure  flush_job_command_buffers
{
{ Purpose    This routine is called to pass each of the protocol command
{            buffers on the buffer list to write_job_command_buffer
{            for writing into the job file.
{
{ Description
{            This routine simply goes down the list of buffers until
{            the next buffer pointer is NIL.
{
{ Input parameters
{            Job_file_id          : ID of the job file being written
{            Buffer_pointer       : Pointer to list of PDU buffers
{
{ Output parameters
{            Status               : Value returned by
{                                        write_job_command_buffer
{
{ Algorithm
{            While pointer not NIL do
{              Nfp$write_job_command_buffer
{              If bad status, return with error
{            Whilend
{
?? EJECT ??

    VAR
      pointer: ^buffer_list_element;

{}
    status.normal := TRUE;
    pointer := buffer_pointer;
    WHILE pointer <> NIL DO
      write_job_command_buffer (job_file_id, pointer^.buffer (1, pointer^.length), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      pointer := pointer^.forward_pointer;
    WHILEND;
    buffer_pointer := NIL;
{}
  PROCEND flush_job_command_buffers;
?? OLDTITLE ??
{}
?? NEWTITLE := 'write_job_command_buffer', EJECT ??

  PROCEDURE write_job_command_buffer
    (    job_file_id: amt$file_identifier;
         input_buffer: string ( * <= nfc$command_buffer_size);
     VAR status: ost$status);

{
{ Procedure  write_job_command_buffer
{
{ Purpose    This routine takes a command buffer and writes it into the
{            open file specified by Job_file_id.
{
{ Description
{            The command buffer input to this procedure is broken into
{            lines of maximum length satisfactory to job management.  At
{            present the maximum record length is rumored to be 256
{            characters.  However, here we use a size that is easily editable.
{            After the buffer has been broken up into line(s), a trailing
{            string is written into the job stream.  Note also, the PDU
{            info is shifted one character (preceded by a space) such that
{            it is easily differentiated from the trailing string.
{
{ Input parameters
{
{            job_file_id   : File id to write directive
{            input_buffer  : Directive to write
{
{ Output parameters
{
{            status        : Return status
{
{ Algorithm
{
{            While more data to write
{              Write data at maximum width
{              Update data pointer
{            Whilend
{
?? EJECT ??
{}

    VAR
      buffer_length: integer,
      buffer_pointer: integer,
      byte_address: amt$file_byte_address,
      eob_string: string (nfc$ptfs_job_end_blen),
      line: string (nfc$ptfs_job_line_width + nfc$ptfs_job_line_head_len + nfc$ptfs_job_line_tail_len),
      line_length: integer;

{}
    status.normal := TRUE;
    buffer_length := STRLENGTH (input_buffer);
    buffer_pointer := 1;
    eob_string := nfc$ptfs_job_end_buffer;
    REPEAT
      IF buffer_length - buffer_pointer >= nfc$ptfs_job_line_width THEN
        line_length := nfc$ptfs_job_line_width;
      ELSE
        line_length := buffer_length - buffer_pointer + 1;
      IFEND;
      line (1, nfc$ptfs_job_line_head_len) := nfc$ptfs_job_line_header;
      line (nfc$ptfs_job_line_head_len + 1, * ) := input_buffer (buffer_pointer, line_length);
      line (nfc$ptfs_job_line_head_len + line_length + nfc$ptfs_job_line_tail_len,
            1) := nfc$ptfs_job_line_tailer;
      amp$put_next (job_file_id, ^line, line_length + nfc$ptfs_job_line_head_len + nfc$ptfs_job_line_tail_len,
            byte_address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      buffer_pointer := buffer_pointer + line_length;
    UNTIL (buffer_pointer > buffer_length); amp$put_next (job_file_id, ^eob_string, STRLENGTH (eob_string),
          byte_address, status);
{}
  PROCEND write_job_command_buffer;
?? OLDTITLE ??
?? NEWTITLE := 'get_ptfs_connection_info', EJECT ??

  PROCEDURE get_ptfs_connection_info
    (    parameter_list: clt$parameter_list;
     VAR path: nft$network_connection);

{
{ Procedure  get_ptfs_connection_info
{
{ Purpose    This routine is called by the PTFS job generation task to
{            get parameters passed to it by the Ptfs boot via the
{            PMP$EXECUTE command.
{
{ Description
{            The information is passed via sequence and mapped into
{            the type nft$ptfs_job_switch_params.
{
{ Input parameters
{            Parameter_list       : Input parameter list
{
{ Output parameters
{            Control_block        : Returned info goes here
{            Status               : Return status (not used at present)
{
{ Algorithm
{            Set up pointers to sequence
{            Get first in sequence
{            Place first into nfv$control_block
{

    VAR
      parameter_sequence: ^clt$parameter_list,
      parameter_set: nft$ptfs_job_switch_params,
      parameter_value: ^nft$ptfs_job_switch_params,
      save_pointer: ^fst$file_reference;

{}
    save_pointer := path.network_file;
    parameter_sequence := ^parameter_list;
    RESET parameter_sequence;
    NEXT parameter_value IN parameter_sequence;
    parameter_set := parameter_value^;
    RESET parameter_sequence;
    path := parameter_set.path_info;
    path.network_file := save_pointer;
    path.network_file^ := parameter_set.network_file.value;
{}
  PROCEND get_ptfs_connection_info;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_submit_user_job', EJECT ??

{ PURPOSE:
{   This purpose of this procedure is to submit a user PTFS job with the correct
{   attributes.  It also has a KLUDGE mode such that it can be run outside of
{   the system task (note slighly different job attributes).
{
{ NOTE:
{   The job_submission_option "JOB_INPUT_DEVICE" is used to pass information
{   from the PTF SERVER task to the user job.  The information that is passed
{   is the system job name of the PTF SERVER task, the connection file name,
{   and the type of connection file (NAM or LCN).

  PROCEDURE ptfs_submit_user_job
    (    path: nft$network_connection;
         system_job_name: jmt$system_supplied_name;
         file_name: amt$local_file_name;
         application: nft$application_values;
         remote_ring: nft$network_ring_information;
     VAR initiated_job_system_name: jmt$system_supplied_name;
     VAR status: ost$status);

    VAR
      application_number_string: ost$string,
      caller_id: ost$caller_identifier,
      job_submit_options: ^jmt$job_submission_options,
      trace_status: ost$status,
      user_job_info_index: 1 .. jmc$job_input_device_size + 1,
      user_job_information: jmt$job_input_device;

    status.normal := TRUE;
    clp$convert_integer_to_string (path.application_sequence_number, 10, FALSE, application_number_string,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{     Build file connection information for user job

    user_job_info_index := 1;
    user_job_information.text (user_job_info_index, #SIZE (system_job_name)) := system_job_name;
    user_job_info_index := user_job_info_index + #SIZE (system_job_name);
    user_job_information.text (user_job_info_index, #SIZE (path.network_file^)) := path.network_file^;
    user_job_info_index := user_job_info_index + #SIZE (path.network_file^);
    CASE path.network_type OF
    = nfc$network_nam =
      user_job_information.text (user_job_info_index, 1) := nfc$ptfs_network_flag_nam;
      user_job_info_index := user_job_info_index + 1;
    = nfc$network_lcn =
      user_job_information.text (user_job_info_index, 1) := nfc$ptfs_network_flag_lcn;
      user_job_info_index := user_job_info_index + 1;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
            'ptfs_submit_user_job bad network type', status);
      RETURN;
    CASEND;
    user_job_information.text (user_job_info_index, * ) := ' ';
    user_job_information.size := user_job_info_index - 1;

    #CALLER_ID (caller_id);
    IF ((caller_id.ring = osc$tsrv_ring) OR (jmp$system_job ())) THEN
      PUSH job_submit_options: [1 .. 8];
      job_submit_options^ [1].key := jmc$origin_application_name;
      job_submit_options^ [1].origin_application_name := nfv$nam_application_names [application];
      job_submit_options^ [2].key := jmc$immediate_init_candidate;
      job_submit_options^ [2].immediate_init_candidate := TRUE;
      job_submit_options^ [3].key := jmc$omit_class_validation;
      job_submit_options^ [3].omit_class_validation := FALSE;
      job_submit_options^ [4].key := jmc$user_job_name;
      job_submit_options^ [4].user_job_name (1, 5) := 'PTFS_';
      job_submit_options^ [4].user_job_name (6, * ) :=
            application_number_string.value (1, application_number_string.size);
      job_submit_options^ [5].key := jmc$job_class;
      job_submit_options^ [5].job_class := 'FILE_TRANSFER';
      IF remote_ring.specified THEN
        job_submit_options^ [6].key := jmc$job_execution_ring;
        job_submit_options^ [6].job_execution_ring := remote_ring.value;
      ELSE
        job_submit_options^ [6].key := jmc$null_attribute;
      IFEND;
      job_submit_options^ [7].key := jmc$job_input_device;
      job_submit_options^ [7].job_input_device := ^user_job_information;
      job_submit_options^ [8].key := jmc$job_destination_usage;
      job_submit_options^ [8].job_destination_usage := jmc$ve_local_usage;
    ELSE {** KLUDGE for debugging, can run without system priviledge **}
      PUSH job_submit_options: [1 .. 3];
      job_submit_options^ [1].key := jmc$user_job_name;
      job_submit_options^ [1].user_job_name (1, 5) := 'PTFS_';
      job_submit_options^ [1].user_job_name (6, * ) :=
            application_number_string.value (1, application_number_string.size);
      job_submit_options^ [2].key := jmc$job_input_device;
      job_submit_options^ [2].job_input_device := ^user_job_information;
      job_submit_options^ [3].key := jmc$job_destination_usage;
      job_submit_options^ [3].job_destination_usage := jmc$ve_local_usage;
    IFEND;
    jmp$submit_job (file_name, job_submit_options, initiated_job_system_name, status);
    IF nfc$trace_commands THEN
      pmp$log ('PTF JOB gen task, submit status = ', trace_status);
      nfp$format_message_to_job_log (status);
    IFEND;

  PROCEND ptfs_submit_user_job;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_write_user_text', EJECT ??

  PROCEDURE ptfs_write_user_text
    (    job_file_id: amt$file_identifier;
         directive_list: nft$directive_entry_list_head;
     VAR status: ost$status);

{
{ Procedure  ptfs_write_user_text
{
{ Purpose    This routine writes all of the user text directives specified
{            on a list to the specified job file.
{
{ Description
{            Each directive is written into the file until the list
{            is exhausted.  Any file write error causes the procedure
{            to return.
{
{ Input parameters
{            Job_file_id          : Id of file to write directives to
{            Directive_list       : List head for directives
{
{ Output parameters
{            Status               : Return status, any from:
{                                        amp$put_next
{
{ Algorithm
{            While directives do
{              Write directive
{              If error, return
{              Next directive
{            Whilend
{
?? EJECT ??

    VAR
      byte_address: amt$file_byte_address,
      current_pointer: ^nft$directive_entry;


    status.normal := TRUE;
    current_pointer := directive_list.head;
    WHILE current_pointer <> NIL DO
      amp$put_next (job_file_id, ^current_pointer^.line, STRLENGTH (current_pointer^.line), byte_address,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      current_pointer := current_pointer^.link;
    WHILEND;

  PROCEND ptfs_write_user_text;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_enqueue_directive', EJECT ??

  PROCEDURE ptfs_enqueue_directive
    (    parameter: string ( * <= nfc$max_param_size);
     VAR directive_list: nft$directive_entry_list_head;
     VAR status: ost$status);

{
{ Procedure ptfs_enqueue_directive
{
{ Purpose    This routine enqueues a directive entry onto a linked list.
{
{ Description
{            The routine that cracks the embedded PDU(s) for
{            nfp$ptfs_job_generation_task calls this procedure to put
{            each directive on a linked list.  When PDU processing is
{            complete, this list will be written into the user job.
{
{ Input parameters
{            Parameter            : Directive to be queued
{
{ Output parameters
{            Directive_list       : List head for directives
{            Status               : Return status
{
{ Algorithm
{            Allocate directive
{            Enqueue directive
{
?? EJECT ??

    VAR
      current_entry: ^nft$directive_entry;

{}
    status.normal := TRUE;
    ALLOCATE current_entry: [#SIZE (nft$directive_entry: [#SIZE (parameter)])];
    IF current_entry = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'ptfs_enqueue_directive no - vm',
            status);
      RETURN;
    IFEND;
    current_entry^.link := NIL;
    current_entry^.line := parameter;
    IF directive_list.head = NIL THEN
      directive_list.head := current_entry;
    ELSE
      directive_list.tail^.link := current_entry
    IFEND;
    directive_list.tail := current_entry;
{}
  PROCEND ptfs_enqueue_directive;
?? OLDTITLE ??
?? NEWTITLE := 'get_recovery_text', EJECT ??

  PROCEDURE get_recovery_text
    (VAR directives: ^nft$directive_entry;
     VAR status: ost$status);

{
{ Procedure  get_recovery_text
{
{ Purpose    To read the recovery text record out of the job stream.
{
{ Description
{            The job stream file must have been prepared above with
{            clp$push_input.  The first available record is
{            read, and queued onto a directive list.
{
{ Input parameters
{            None
{
{ Output parameters
{            Directives           : a directive list which the recovery
{                                   text is placed on
{            Status               : return status
{
{ Algorithm
{            clp$get_line_from_command_file
{            if success then
{              allocate      directive_entry
{              enqueue directive_entry on list
{            ifend
{
?? EJECT ??

    VAR
      current_entry: ^nft$directive_entry,
      element: ^nft$directive_entry,
      line: ^clt$command_line;

{}
    status.normal := TRUE;
    clp$get_line_from_command_file ('', line, status);
    IF status.normal THEN
      ALLOCATE current_entry: [#SIZE (nft$directive_entry: [#SIZE (line^)])];
      current_entry^.line := line^;
      current_entry^.link := NIL;
      IF directives = NIL THEN
        directives := current_entry;
      ELSE
        element := directives;
        WHILE element^.link <> NIL DO
          element := element^.link;
        WHILEND;
        element^.link := current_entry;
      IFEND;
    IFEND;
{}
  PROCEND get_recovery_text;
?? OLDTITLE ??
?? NEWTITLE := 'crack_embedded_rfts', EJECT ??

  PROCEDURE crack_embedded_rfts
    (VAR nfv$control_block: nft$control_block;
     VAR status: ost$status);

{
{ Procedure  crack_embedded_rfts
{
{ Purpose    To read text written into the job stream which represents the
{            contents of the RFT(s) which started this job.  The information
{            represented by the RFT(s) is placed into the control block.
{
{ Description
{            The job stream file must have been prepared above with
{            clp$push_input.  The first available record is
{            the begining of the first RFT.  The RFT(s) are broken into
{            lines (because job files may contain records no longer than
{            256 characters).  RFT lines begin with the character ', and
{            delimiter lines (indicating end of RFT or end of RFT(s)) begin
{            with *.  As an RFT is read, it is built into a text string
{            which is processed when the RFT is complete.
{
{ Input parameters
{            None
{
{ Input/output parameters
{            Control_block        : Transfer control block
{
{ Output parameters
{            Status               : Return status any of
{                                   returned by
{                                        nfp$crack_command
{                                        nfp$crack_number_of_parameters
{                                        nfp$crack_pdu
{
{ Algorithm
{            Loop until end of commands
{              Read line
{              if line is not delimiter then
{                add line to present command
{              else
{                if line is buffer  delimiter then
{                  crack command
{                else if line is command delimiter then
{                  end of commands = true
{                else error
{              ifend
{            loopend
{
?? EJECT ??

    VAR
      buffer_length: integer,
      done: boolean,
      ignored_params: nft$parameter_set,
      input_buffer: string (nfc$command_buffer_size),
      input_pointer: integer,
      line: ^clt$command_line,
      line_length: integer,
      modified_params: nft$parameter_set,
      more_command_blocks: boolean,
      number_of_parameters: nft$number_pdu_param_range,
      pdu_done: boolean,
      pdu_parameters: nft$parameter_set,
      received_command: nft$protocol_commands,
      trace_length: integer,
      trace_line_width: integer,
      trace_pointer: integer,
      trace_status: ost$status,
      trace_string: string (24);

   VAR
      nfv$rft_parameter_set: [XREF] nft$parameter_set;
{}
    status.normal := TRUE;
    done := FALSE;
    nfv$rft_parameter_set := $nft$parameter_set [];
    REPEAT
      input_pointer := 1;
      pdu_done := FALSE;
      REPEAT
        clp$get_line_from_command_file ('', line, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        line_length := STRLENGTH (line^);
        IF line^ (1) <> nfc$ptfs_job_delimiter THEN
          IF (line_length > nfc$command_buffer_size) OR (line_length <
                nfc$ptfs_job_line_head_len + nfc$ptfs_job_line_tail_len) THEN
            osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
                  'crack_embedded_rfts line size', status);
            RETURN;
          IFEND;
          line_length := (line_length - nfc$ptfs_job_line_head_len) - nfc$ptfs_job_line_tail_len;
          input_buffer (input_pointer, line_length) := line^ (2, line_length);
          input_pointer := input_pointer + line_length;
        ELSE
          IF line^ = nfc$ptfs_job_end_buffer THEN
            pdu_done := TRUE;
            buffer_length := input_pointer - 1;
            IF buffer_length < (nfc$pdu_nparams_pos + nfc$pdu_nparams_len - 1) THEN
              osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'NFP$CRACK_EMBEDDED_RFTS',
                    status);
              RETURN;
            IFEND;
            IF nfc$trace_commands THEN
              pmp$log ('------------------------', trace_status);
              pmp$log ('|    Receive command   |', trace_status);
              STRINGREP (trace_string, trace_length, '|    Length ', buffer_length: 5, '      |');
              pmp$log (trace_string, trace_status);
              pmp$log ('------------------------', trace_status);
              IF buffer_length > 0 THEN
                trace_pointer := 1;
                WHILE trace_pointer <= buffer_length DO
                  IF ((buffer_length - trace_pointer) >= nfc$trace_commands_width) THEN
                    trace_line_width := nfc$trace_commands_width;
                  ELSE
                    trace_line_width := buffer_length - trace_pointer + 1;
                  IFEND;
                  pmp$log (input_buffer (trace_pointer, trace_line_width), trace_status);
                  trace_pointer := trace_pointer + nfc$trace_commands_width;
                WHILEND;
              IFEND;
              pmp$log ('--------------------', trace_status);
            IFEND;
            nfp$crack_command (input_buffer (1, nfc$pdu_command_len), received_command, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            nfp$crack_number_of_parameters (input_buffer (nfc$pdu_nparams_pos, nfc$pdu_nparams_len),
                  number_of_parameters, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            nfp$crack_pdu (nfc$rft, input_buffer, number_of_parameters, more_command_blocks, pdu_parameters,
                  ignored_params, modified_params, nfv$control_block, status);
            IF NOT status.normal THEN
              RETURN;
            ELSE
              nfv$rft_parameter_set := nfv$rft_parameter_set + pdu_parameters;
            IFEND;
          ELSE {** should be end of pdu information in job **}
            IF line^ <> '*EOC' THEN
              osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
                    'crack_embedded_rfts invalid eoc', status);
              RETURN;
            ELSE
              done := TRUE;
              pdu_done := TRUE;
            IFEND;
          IFEND;
        IFEND;
      UNTIL pdu_done;
    UNTIL done;
    IF NOT (nfv$ptf_required_params [nfc$rft] <= nfv$rft_parameter_set) THEN
      osp$set_status_abnormal (nfc$status_id, nfe$required_parameter_missing, '', status);
      nfp$set_abnormal_if_normal (status, nfv$control_block.local_status);
    ELSE
      IF NOT (nfc$max_block_size IN nfv$rft_parameter_set) THEN
        CASE nfv$control_block.data_declaration OF
        = nfc$p31_host_dependent_uh =
          { No change, defaults set in init cb o.k. }
        = nfc$p31_ascii_c6, nfc$p31_ascii_c8, nfc$p31_unspecified =
          nfv$control_block.data_block_size := nfc$p12_nos_ascii_size;
        = nfc$p31_undef_unstructured_uu, nfc$p31_undefined_structured_us =
          nfv$control_block.data_block_size := nfc$p12_nos_binary_size;
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
                'crack_embedded_rfts P31 case error', status);
        CASEND;
      IFEND;
    IFEND;

  PROCEND crack_embedded_rfts;
?? OLDTITLE ??
?? NEWTITLE := 'global variables', EJECT ??

{ PURPOSE:
{   This module contains procedures for the server application (PTFS)
{   in a remote permanent file access/transfer.  The server application
{   performs the functions on the remote system.

{ PROCEDURE ptfs_pdt (
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 17, 11, 2, 57, 744],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

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

    CONST
      p$status = 1;

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

{ table ptfs_commands
{ command (send_file, senf) send_file_command
{ command (receive_file, recf) receive_file_command

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

{ PURPOSE:
{   This procedure will read the job log of the server job (this job).  The job log is
{   sent back to the initiator with the STOPR message.

  PROCEDURE get_job_log
    (VAR log_entry_ptr: ^nft$directive_entry;
     VAR status: ost$status);

    VAR
      byte_address: amt$file_byte_address,
      directive_line: ost$string,
      file_position: amt$file_position,
      ignore_status: ost$status,
      log_attach_options: ^fst$attachment_options,
      log_file_id: amt$file_identifier,
      transfer_count: amt$transfer_count,
      user_log_ptr: ^nft$directive_entry;

    status.normal := TRUE;
    log_entry_ptr := NIL;
    user_log_ptr := NIL;

    PUSH log_attach_options: [1 .. 3];
    log_attach_options^ [1].selector := fsc$open_position;
    log_attach_options^ [1].open_position := amc$open_at_boi;
    log_attach_options^ [2].selector := fsc$access_and_share_modes;
    log_attach_options^ [2].access_modes.selector := fsc$specific_access_modes;
    log_attach_options^ [2].access_modes.value := $fst$file_access_options [fsc$read];
    log_attach_options^ [2].share_modes.selector := fsc$specific_share_modes;
    log_attach_options^ [2].share_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$modify, fsc$execute];
    log_attach_options^ [3].selector := fsc$open_share_modes;
    log_attach_options^ [3].open_share_modes := $fst$file_access_options
          [fsc$read, fsc$append, fsc$modify, fsc$execute];

    fsp$open_file (clc$job_log, amc$record, log_attach_options, NIL, NIL, NIL, NIL, log_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /dump_job_log/
    WHILE status.normal DO
      amp$get_next (log_file_id, ^directive_line.value, osc$max_string_size, transfer_count, byte_address,
            file_position, status);
      IF (NOT status.normal) OR (file_position = amc$eoi) THEN
        EXIT /dump_job_log/;
      IFEND;

{ Link a string onto a link list of user log lines.

      directive_line.size := transfer_count;
      IF log_entry_ptr = NIL THEN
        ALLOCATE log_entry_ptr: [directive_line.size];
        IF log_entry_ptr = NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'link_log_entry get_job_log',
                status);
        ELSE
          user_log_ptr := log_entry_ptr;
        IFEND;
      ELSE
        ALLOCATE log_entry_ptr^.link: [directive_line.size];
        IF log_entry_ptr^.link = NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'link_log_entry get_job_log',
                status);
        ELSE
          log_entry_ptr := log_entry_ptr^.link;
        IFEND;
      IFEND;
      IF status.normal THEN
        log_entry_ptr^.link := NIL;
        log_entry_ptr^.line := directive_line.value (1, directive_line.size);
      IFEND;

    WHILEND /dump_job_log/;

    amp$close (log_file_id, ignore_status);
    log_entry_ptr := user_log_ptr;

  PROCEND get_job_log;
?? OLDTITLE ??
?? NEWTITLE := 'receive_file_command', EJECT ??

{ PURPOSE:
{   This procedure is responsible for setting up a data transfer
{   involving PTFS receiving a file from PTF.  By ensuring the
{   file is destined for a correct device, responding in protocol
{   (RPOS) or (RNEG).  If the device is correct, and RPOS is sent,
{   a GO must be received.

  PROCEDURE receive_file_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE receive_file_pdt (
{   file, f: file = $REQUIRED
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 17, 11, 2, 32, 227],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      nfv$control_block: [XREF] nft$control_block;

    VAR
      nfv$p04_values: [XREF] nft$parameter_04_values;

    VAR
      device_assigned: boolean,
      device_class: rmt$device_class,
      file_reference: fst$evaluated_file_reference,
      ignore_status: ost$status,
      ignored_params: nft$parameter_set,
      modified_params: nft$parameter_set,
      path_handle: fst$path_handle_name,
      received_params: nft$parameter_set,
      rpos_parameters: nft$parameter_set,
      trace_string: string (80),
      trace_string_length: integer,
      trace_status: ost$status;

    status.normal := TRUE;
    IF nfc$trace_commands THEN
      pmp$log ('Enter ptfs - receive_file_command', ignore_status);
    IFEND;
    IF nfv$control_block.data_xfer_complete THEN
      osp$set_status_abnormal (nfc$status_id, nfe$multiple_file_transfers, '', status);
      RETURN;
    IFEND;

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

    rmp$get_device_class (pvt [p$file].value^.file_value^, device_assigned, device_class, status);
    IF device_assigned AND (device_class <> rmc$mass_storage_device) AND
          (device_class <> rmc$null_device) THEN
      osp$set_status_abnormal (nfc$status_id, nfv$p04_values [nfc$p04_no_file_access].condition, '',
            nfv$control_block.state_of_transfer);
      osp$set_status_abnormal (nfc$status_id, nfe$remote_file_not_ms, pvt [p$file].value^.file_value^,
            status);
      RETURN;
    IFEND;

    clp$convert_str_to_path_handle(pvt [p$file].value^.file_value^, FALSE, TRUE, TRUE,
     path_handle, file_reference, status);

    IF (NOT device_assigned) AND ((file_reference.cycle_reference.specification = fsc$high_cycle) OR
          (file_reference.cycle_reference.specification = fsc$low_cycle)) THEN

{ The file to be received does not exist and a cycle reference of "$HIGH" or "$LOW" was specified on
{ the call to the RECEIVE_FILE command. Cause the command to abort with the same status as the COPY_FILE
{ command would given the same parameters.

      osp$set_status_abnormal(amc$access_method_id, ame$file_not_known, pvt [p$file].value^.file_value^,
            status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'FSP$OPEN_FILE', status);

    ELSE

      nfv$control_block.file_name :=path_handle;
      nfv$control_block.mode_of_access := nfc$take;
      ptfs_parameters_for_rpos (rpos_parameters, nfv$control_block, status);
      IF status.normal THEN
        rpos_parameters := rpos_parameters - nfv$control_block.last_auto_modify_ignore;
        send_rpos ( rpos_parameters, nfv$rft_parameter_set, nfv$control_block,
          status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        nfp$receive_command ($nft$command_set [nfc$go, nfc$stop], nfv$ptf_required_params, nfv$control_block,
              received_params, ignored_params, modified_params, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF nfv$control_block.last_command_received = nfc$go THEN
          nfp$transfer_file (nfv$control_block, status);

  { Try to catch ANY transfer error returning bad status up so SCL command stream will terminate

          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF NOT nfv$control_block.state_of_transfer.normal THEN
            nfp$set_abnormal_if_normal (nfv$control_block.state_of_transfer, status);
            RETURN;
          IFEND;
          IF NOT nfv$control_block.local_status.normal THEN
            nfp$set_abnormal_if_normal (nfv$control_block.local_status, status);
            RETURN;
          IFEND;
        IFEND;
        nfv$control_block.data_xfer_complete := TRUE;
      IFEND;
    IFEND;
    IF nfc$trace_commands THEN
      pmp$log ('Exit ptfs - receive_file_command', ignore_status);
    IFEND;

  PROCEND receive_file_command;
?? OLDTITLE ??
?? NEWTITLE := 'send_file_command', EJECT ??

{ PURPOSE:
{   This procedure is responsible for setting up a data transfer involving PTFS
{   by sending the specified file to PTF.  The file must exist and have a
{   non-zero length.  Checking is done to ensure that the file exists and is
{   accessable.
{
{ NOTE:
{   This procedure does not send an RNEG ever, rather it sets a bad status
{   which SCL will pick up.

  PROCEDURE send_file_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE send_file_pdt (
{   file, f: file = $REQUIRED
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 17, 11, 2, 48, 164],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      attributes: array [1 .. 1] of amt$get_item,
      nfv$control_block: [XREF] nft$control_block,
      device_assigned: boolean,
      device_class: rmt$device_class,
      file_attachment_options: ^fst$attachment_options,
      file_exists: boolean,
      file_id: amt$file_identifier,
      ignore_connection_time: ost$date_time,
      ignore_file_is_local: boolean,
      ignore_file_contains_data: boolean,
      ignore_file_ref: fst$evaluated_file_reference,
      ignore_status: ost$status,
      ignored_params: nft$parameter_set,
      ignore_retrieve_option: boolean,
      modified_params: nft$parameter_set,
      path_handle: fst$path_handle_name,
      received_params: nft$parameter_set,
      report_file_archived: boolean,
      rpos_parameters: nft$parameter_set;


    status.normal := TRUE;
    IF nfc$trace_commands THEN
      pmp$log ('Enter ptfs - send_file_command', ignore_status);
    IFEND;
    IF nfv$control_block.data_xfer_complete THEN
      osp$set_status_abnormal (nfc$status_id, nfe$multiple_file_transfers, '', status);
      RETURN;
    IFEND;

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

    rmp$get_device_class (pvt [p$file].value^.file_value^, device_assigned, device_class, status);
    IF device_assigned AND (device_class <> rmc$mass_storage_device) AND
          (device_class <> rmc$null_device) THEN
      osp$set_status_abnormal (nfc$status_id, nfe$remote_file_not_ms, pvt [p$file].value^.file_value^,
            status);
      RETURN;
    IFEND;

    attributes [1].key := amc$file_length;
    amp$get_file_attributes (pvt [p$file].value^.file_value^, attributes, ignore_file_is_local, file_exists,
          ignore_file_contains_data, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF file_exists THEN

{ Convert the string into a path handle and place the value in the control block so
{ that the value is known outside of send_file. NFP$PTFS_USER_JOB will use this
{ value to retrieve the file if PTFS is to report the file is archived and retrieve.

      clp$convert_str_to_path_handle(pvt [p$file].value^.file_value^, FALSE, TRUE, TRUE,
         path_handle, ignore_file_ref, status);
      IF NOT status.normal THEN
        pmp$log('***PTFS could not convert the file name to a path handle.', ignore_status);
        RETURN;
      IFEND;
      nfv$control_block.file_name := path_handle;

      IF attributes [1].file_length <> 0 THEN
        nfv$control_block.file_size := attributes [1].file_length;

{ Check if the file is archived by calling fsp$open_file with no allowed exception conditions.

        PUSH file_attachment_options: [1..3];

        file_attachment_options^[1].selector := fsc$create_file;
        file_attachment_options^[1].create_file := FALSE;

        file_attachment_options^[2].selector := fsc$allowed_exceptions;
        file_attachment_options^[2].allowed_exceptions.access_conditions := $fst$file_access_conditions [ ];
        file_attachment_options^[2].allowed_exceptions.damage_symptoms := $fst$cycle_damage_symptoms [ ];

        file_attachment_options^ [3].selector := fsc$access_and_share_modes;
        file_attachment_options^ [3].access_modes.selector := fsc$specific_access_modes;
        file_attachment_options^ [3].access_modes.value := $fst$file_access_options [fsc$read];
        file_attachment_options^ [3].share_modes.selector := fsc$determine_from_access_modes;

        fsp$open_file (path_handle, amc$record, file_attachment_options, NIL, NIL,
              NIL, NIL, file_id, status);

        IF NOT status.normal THEN
          consult_archive_response_var (report_file_archived, ignore_retrieve_option);
          IF (status.condition = pfe$cycle_data_resides_offline) AND (report_file_archived) THEN

{ Cause the server to RNEG the RFT by setting the state of transfer to REJECTED. Include the status
{ from the FSP$OPEN_FILE call in the job log to further explain the cause of the rejection.

            osp$set_status_abnormal (nfc$status_id, nfv$p04_values [nfc$p04_file_unavailable].condition, '',
                nfv$control_block.state_of_transfer);
            nfp$format_message_to_job_log(status);
            osp$set_status_abnormal (nfc$status_id, nfv$p04_values [nfc$p04_file_unavailable].condition, '',
                nfv$control_block.local_status);
            IF (nfv$control_block.remote_host_type = nfc$p22_nos_ve) AND
               (NOT nfv$control_block.state_of_transfer.normal) THEN
              ptfs_send_status_parameter (nfv$control_block.state_of_transfer,
                nfv$control_block.send_special_options, ignore_status);
            IFEND;
            RETURN;
          IFEND;
        ELSE { fsp$open did not return an abnormal status.
          fsp$close_file(file_id, ignore_status);
        IFEND;

      ELSE
        osp$set_status_abnormal (nfc$status_id, fse$empty_input_file, pvt [p$file].value^.file_value^,
              status);
        RETURN;
      IFEND;
    ELSE { ** no file, find out why ** }
      osp$set_status_abnormal (nfc$status_id, nfv$p04_values [nfc$p04_file_not_found].condition, '',
            nfv$control_block.state_of_transfer);
      PUSH file_attachment_options: [1 .. 1];
      file_attachment_options^ [1].selector := fsc$create_file;
      file_attachment_options^ [1].create_file := FALSE;
      fsp$open_file (pvt [p$file].value^.file_value^, amc$record, file_attachment_options, NIL, NIL, NIL, NIL,
            file_id, status);
      RETURN;
    IFEND;

    nfv$control_block.mode_of_access := nfc$give;
    ptfs_parameters_for_rpos (rpos_parameters, nfv$control_block, status);
    IF status.normal THEN
      rpos_parameters := rpos_parameters - nfv$control_block.last_auto_modify_ignore;
      send_rpos ( rpos_parameters, nfv$rft_parameter_set,
         nfv$control_block, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      nfp$receive_command ($nft$command_set [nfc$go, nfc$stop], nfv$ptf_required_params, nfv$control_block,
            received_params, ignored_params, modified_params, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF nfv$control_block.last_command_received = nfc$go THEN
        nfp$transfer_file (nfv$control_block, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF NOT nfv$control_block.state_of_transfer.normal THEN
          nfp$set_abnormal_if_normal (nfv$control_block.state_of_transfer, status);
        IFEND;
      IFEND;
      nfv$control_block.data_xfer_complete := TRUE;
    IFEND;

    IF nfc$trace_commands THEN
      pmp$log ('Exit ptfs - send_file_command', ignore_status);
    IFEND;

  PROCEND send_file_command;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_process_protocol', EJECT ??

{ PURPOSE:
{   This procedure will be to process the protocol for PTFS.  It must
{   determine where it is in the A-A protocol and continue from that point.
{   If a file transfer has occurred it will begin by receiveing a STOP request.
{   If no transfer has occured and the status is good (SCL was happy with all
{   the user text) the procedure will begin by sending a RPOS request with a NULL
{   mode of access.  Otherwise an error has occurred in user SCL begin by sending
{   a RNEG request.
{
{ NOTE:
{   This is also where we would receive a second (non-continued) RFT on
{   this connection.  This procedure must handle this case by building
{   another command file and execute it.

  PROCEDURE ptfs_process_protocol
    (    accept_rfts: boolean;
         caller_identifier: caller_identifier;
     VAR nfv$control_block: nft$control_block;
     VAR begin_connection_time: ost$date_time;
     VAR status: ost$status);

    VAR
      directive_list: nft$directive_entry_list_head,
      done: boolean,
      end_connection_time: ost$date_time,
      ignore_status: ost$status,
      ignored_params: nft$parameter_set,
      modified_params: nft$parameter_set,
      parameter_set: nft$parameter_set,
      received_params: nft$parameter_set,
      rpos_parameters: nft$parameter_set,
      send_parameters: nft$parameter_set;

   VAR
      nfv$rft_parameter_set: [STATIC,XREF] nft$parameter_set;

    status.normal := TRUE;
    done := FALSE;

    WHILE NOT done DO
      IF nfv$control_block.path.path_connected THEN
        CASE nfv$control_block.last_command_received OF

        = nfc$rft =
          IF accept_rfts AND (nfv$control_block.last_command_sent = nfc$stopr) THEN

{ Go build a new command file

            ptfs_process_another_rft (begin_connection_time, nfv$control_block, status);
            IF NOT status.normal THEN
              nfp$set_abnormal_if_normal (status, nfv$control_block.local_status);
            IFEND;
          ELSEIF nfv$control_block.last_command_sent = nfc$rpos THEN
              nfp$receive_command ($nft$command_set [nfc$go, nfc$stop], nfv$ptf_required_params,
                    nfv$control_block, received_params, ignored_params, modified_params, status);
          ELSEIF nfv$control_block.last_command_sent = nfc$rneg THEN
              nfp$receive_command ($nft$command_set [nfc$stop], nfv$ptf_required_params, nfv$control_block,
                    received_params, ignored_params, modified_params, status);
          ELSE
            IF (NOT nfv$control_block.local_status.normal) OR (NOT nfv$control_block.state_of_transfer.normal)
               OR (NOT accept_rfts) THEN

{ Send RNEG with bad State of Transfer

              send_parameters := $nft$parameter_set [nfc$state_of_transfer];
              IF nfv$control_block.remote_host_type = nfc$p22_nos_ve THEN
                send_parameters := send_parameters + $nft$parameter_set [nfc$host_type];
              IFEND;

              send_rneg (send_parameters, nfv$rft_parameter_set, nfv$control_block, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

              nfp$receive_command ($nft$command_set [nfc$stop], nfv$ptf_required_params, nfv$control_block,
                    received_params, ignored_params, modified_params, status);
            ELSE

{ Send RPOS with good State of Transfer and mode of access=null

              rpos_parameters := $nft$parameter_set [nfc$protocol_id, nfc$mode_of_access, nfc$host_type,
                    nfc$job_name, nfc$physical_id] - nfv$control_block.last_auto_modify_ignore;
              send_rpos (rpos_parameters, nfv$rft_parameter_set, nfv$control_block, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

              nfp$receive_command ($nft$command_set [nfc$go, nfc$stop], nfv$ptf_required_params,
                    nfv$control_block, received_params, ignored_params, modified_params, status);
            IFEND;

            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;

        = nfc$go =
            nfp$receive_command ($nft$command_set [nfc$stop], nfv$ptf_required_params, nfv$control_block,
                  received_params, ignored_params, modified_params, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

        = nfc$stop =
          IF nfv$control_block.last_command_sent <> nfc$stopr THEN

            CASE caller_identifier OF
            = user_ptfs_job_call, user_ptfs_job_logout =

{ Try to send back job log from user ptfs job.

                get_job_log (nfv$control_block.send_user_messages, status);
                IF NOT status.normal THEN
                  directive_list.head := NIL;
                  directive_list.tail := NIL;
                  nfp$enqueue_status_directive (status, directive_list, status);
                  nfv$control_block.send_user_messages := directive_list.head;
                IFEND;

            = ptfs_job_generation_task, ptfs_scan_scl_handler_id =

{ The user ptfs job failed and did not call ptfs_process_protocol, therefore the user ptfs job
{ log is not available. Send the send status back as a string instead.

                IF (nfv$control_block.remote_host_type = nfc$p22_nos_ve) AND
                   (NOT nfv$control_block.local_status.normal) THEN
                  ptfs_send_status_parameter (nfv$control_block.local_status,
                    nfv$control_block.send_special_options, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;
                  send_parameters := send_parameters + $nft$parameter_set [nfc$special_options];
                IFEND;

                directive_list.head := NIL;
                directive_list.tail := NIL;
                nfp$enqueue_status_directive (nfv$control_block.local_status, directive_list, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                nfv$control_block.send_user_messages := directive_list.head;
            CASEND;

            parameter_set := $nft$parameter_set [nfc$state_of_transfer, nfc$user_message];
            IF (NOT nfv$control_block.local_status.normal) AND (nfv$control_block.remote_host_type =
                  nfc$p22_nos_ve) THEN
              ptfs_send_status_parameter (nfv$control_block.local_status, nfv$control_block.
                    send_special_options, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              parameter_set := parameter_set + $nft$parameter_set [nfc$special_options];
            IFEND;

            IF NOT nfv$control_block.recovery_text THEN
              parameter_set := parameter_set + $nft$parameter_set [nfc$user_text_directive];
              nfv$control_block.recovery_text := TRUE;
            IFEND;

            nfp$send_command (nfc$stopr, parameter_set, $nft$parameter_set[ ], $nft$parameter_set[ ],
                   nfv$control_block, status);
            IF status.normal THEN
              nfp$dequeue_directives_on_list (nfv$control_block.send_user_messages, ignore_status);
            ELSE
              RETURN;
            IFEND;

            IF nfv$control_block.state_of_transfer.normal AND nfv$control_block.local_status.normal THEN

{ Account for bytes sent back in job log

              nfv$control_block.transfer_directives_length := nfv$control_block.transfer_directives_length +
                   nfp$count_directives_text (nfv$control_block.send_user_messages);

{ Get connection end time

              pmp$get_compact_date_time (end_connection_time, status);
              IF NOT status.normal THEN
                nfp$format_message_to_job_log(status);
                RETURN;
              ELSE
                nfp$generate_ptf_statistic (begin_connection_time, end_connection_time, nfv$control_block.
                   transfer_file_size, nfv$control_block.transfer_directives_length, nfv$control_block.
                   remote_lid (1,nfv$control_block.remote_lid_length), nfv$control_block.remote_pid
                   (1,nfv$control_block.remote_pid_length), nfv$control_block.application, nfv$control_block.
                   ptf_scl_directive);
              IFEND;
            IFEND;
            nfv$control_block.mode_of_access := nfc$null;
            nfv$control_block.transfer_file_size := 0;
            nfv$control_block.transfer_directives_length := 0;
            nfv$control_block.ptf_scl_directive.size := 0;
          IFEND;

{ Reset begin connection time in the event another RFT is received

          pmp$get_compact_date_time (begin_connection_time, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          nfp$receive_command ($nft$command_set [nfc$etp, nfc$rft], nfv$ptf_required_params,
                nfv$control_block, nfv$rft_parameter_set, ignored_params, modified_params, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        = nfc$etp =
          IF nfv$control_block.last_command_sent <> nfc$etpr THEN
            nfp$send_command (nfc$etpr, $nft$parameter_set [], $nft$parameter_set[ ], $nft$parameter_set[ ],
                 nfv$control_block, ignore_status);
          IFEND;

          nfp$receive_command ($nft$command_set [nfc$fini], nfv$ptf_required_params, nfv$control_block,
                received_params, ignored_params, modified_params, ignore_status);

        = nfc$fini =
          done := TRUE;

{ Server MUST wait for initiator to disconnect, if he doesn't, this times out.

          nfp$receive_command ($nft$command_set [nfc$unknown_command], nfv$ptf_required_params,
                nfv$control_block, received_params, ignored_params, modified_params, ignore_status);

        ELSE

        CASEND;
      ELSE
        done := TRUE;
      IFEND;
    WHILEND;

  PROCEND ptfs_process_protocol;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_process_another_rft', EJECT ??

  PROCEDURE ptfs_process_another_rft
    (VAR begin_connection_time: ost$date_time;
     VAR nfv$control_block: nft$control_block;
     VAR status: ost$status);

{
{ Procedure  ptfs_process_another_rft
{
{ Purpose    This routine is called on the 2,3,4, ... th RFT received.
{            It processes the commands for the RFT and returns to its
{            caller to complete protocol.
{
{ Description
{            This routine opens a new file for SCL directives.  The
{            directives are written into the file by
{            ptfs_write_user_text and that file is executed by
{            clp$scan_command_file.
{
{ Input parameters
{            None
{
{ Input/output parameters
{            Control_block        : Transfer control block
{
{ Output parameters
{            Begin_connection_time: Time received RFT
{            Status               : Return status
{
{ Algorithm
{            Open a new file
{            Write directives into file
{            Establish abort handler
{            clp$scan_command_file
{            Remove abort handler
{            Delete command file
{
?? EJECT ??

    VAR
      command_file_id: amt$file_identifier,
      command_file_name: ost$name,
      file_attributes: ^fst$attachment_options,
      ignore_status: ost$status;


{     **Set up the command file to execute **}

    status.normal := TRUE;
    pmp$get_compact_date_time( begin_connection_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$get_unique_name (command_file_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH file_attributes: [1 .. 1];
    file_attributes^ [1].selector := fsc$open_position;
    file_attributes^ [1].open_position := amc$open_at_boi;
    fsp$open_file (command_file_name, amc$record, file_attributes, NIL, NIL, NIL, NIL, command_file_id,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ptfs_write_user_text (command_file_id, nfv$control_block.received_directives, status);

{   Build accounting stuff associated with directives

    nfv$control_block.transfer_directives_length := nfp$count_directives_text(
           nfv$control_block.received_directives.head);
    IF (nfv$control_block.received_directives.head^.link <> NIL) THEN
      build_05_directives_text( nfv$control_block.received_directives.head^.link,
           nfv$control_block.ptf_scl_directive);
    ELSE
      nfv$control_block.ptf_scl_directive.size := 0;
    IFEND;

    nfp$deallocate_dirs_from_head (nfv$control_block.received_directives, ignore_status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fsp$close_file (command_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   **Execute the command file **}

    nfv$control_block.data_xfer_complete := FALSE;
    ptfs_scan_scl_command_file (command_file_name, TRUE, begin_connection_time, nfv$control_block, status);

    amp$return (command_file_name, ignore_status);

  PROCEND ptfs_process_another_rft;
?? OLDTITLE ??
?? NEWTITLE := '  ptfs_switch_connection', EJECT ??

  PROCEDURE ptfs_switch_connection
    (    initiated_job_name: jmt$system_supplied_name;
     VAR nfv$control_block: nft$control_block;
     VAR switch_state: nft$ptfs_switch_states;
     VAR status: ost$status);

{
{ Procedure  ptfs_switch_connection
{
{ Purpose    To switch a connection from the current to a specified job.
{
{ Description
{            This routine attempts to switch an A-A connection to an
{            initiated user job.  This process takes several steps.
{            First, an offer switch is made with a short (30 second)
{            time out.  If the user job did not complete the switch in that
{            time, this routine checks to see if said job is still around.
{            If the job has terminated (i.e. bad prolog), a status is set
{            indicating switch failed, but the connection is still active.
{            If the job is still around, we offer the switch again, this
{            time with a much longer time out.  If this second offer is
{            not successfull, we attempt to terminate the user job.  This
{            is done to remote it from the job class, where it is wasting
{            space ( a slot ).  Note: the two switch offer method is used
{            to avoid long end user delays when the user job aborts.
{
{ Input parameters
{            Initiated_job_name          : Name of job to switch connection
{                                          to.
{
{ Input/output parameters
{            Control_block        : Transfer control block
{
{ Output parameters
{            Switch_state                : Returned switch/path state
{            Status                      : Returned status
{
{ Algorithm
{            ptfs_switch_it ( short timeout )
{            if success, return
{            else
{              check if job exists
{              if not, return
{              else
{                ptfs_switch_it ( long timeout )
{                if success, return
{                else
{                  terminate job
{                ifend
{              ifend
{            ifend
{
?? EJECT ??

    VAR
      ignore_status: ost$status,
      job_exists: boolean,
      job_name: jmt$name,
      job_termination_options: ^jmt$job_termination_options,
      local_status: ost$status,
      time_out: nft$parameter_20_range;

{}
    status.normal := TRUE;
{}
    time_out := nfc$ptfs_switch_init_time;
    ptfs_switch_it (initiated_job_name, nfv$control_block.path.network_type, time_out,
          nfv$control_block.path.network_file^, status);
    IF NOT status.normal THEN
      IF (status.condition = rfe$switch_offer_not_accepted) OR
            (status.condition = nae$switch_offer_not_accepted) THEN
        {
        { See if job exists
        {
        jmp$job_exists (initiated_job_name, $jmt$job_state_set [jmc$initiated_job, jmc$queued_job],
              job_exists, status);
        IF (NOT status.normal) OR (NOT job_exists) THEN
          ptfs_cancel_offer (nfv$control_block.path.network_file^, nfv$control_block.path.network_type,
                status);
          osp$set_status_abnormal (nfc$status_id, nfe$user_job_term_prematurely, '', status);
          switch_state := nfc$switch_failed_cancelled;
          RETURN; { Job does not exists }
        ELSE
          { Ensure there is time left if switch fails to cancel it and
          { continue with the protocol (safety margin)
          time_out := nfv$control_block.time_out - nfc$ptfs_switch_init_time - nfc$ptfs_switch_term_time;
          ptfs_cancel_offer (nfv$control_block.path.network_file^, nfv$control_block.path.network_type,
                status);
          IF NOT status.normal THEN
            switch_state := nfc$switch_failed_lost;
            RETURN;
          IFEND;
          ptfs_switch_it (initiated_job_name, nfv$control_block.path.network_type, time_out,
                nfv$control_block.path.network_file^, status);
          IF NOT status.normal THEN
            IF (status.condition = rfe$switch_offer_not_accepted) OR
                  (status.condition = nae$switch_offer_not_accepted) THEN
              { Job didn't pick up connect, kill it
              { Because there is lots of overhead to check if job
              { exists, just try to kill it.  This is necessary because
              { if the job is still running, it is taking up a slot
              { in the job class
              job_name.kind := jmc$system_supplied_name;
              job_name.system_supplied_name := initiated_job_name;
              PUSH job_termination_options: [1 .. 2];
              job_termination_options^ [1].key := jmc$job_state_set;
              job_termination_options^ [1].job_state_set := $jmt$job_state_set
                    [jmc$queued_job, jmc$initiated_job];
              job_termination_options^ [2].key := jmc$output_disposition;
              job_termination_options^ [2].output_disposition.key :=
                    jmc$discard_standard_output;
              jmp$terminate_job (job_name, job_termination_options, ignore_status);
              osp$set_status_abnormal (nfc$status_id, nfe$user_job_switch_timeout, '', status);
              ptfs_cancel_offer (nfv$control_block.path.network_file^,
                    nfv$control_block.path.network_type, local_status);
              IF local_status.normal THEN { Cancel success }
                switch_state := nfc$switch_failed_cancelled;
              ELSE { Couldn't cancel, must be lost }
                switch_state := nfc$switch_failed_lost;
              IFEND;
            ELSE { Unknown kind of error, big trouble }
              switch_state := nfc$switch_failed_lost;
              RETURN;
            IFEND;
          ELSE { Success on switch }
            switch_state := nfc$switch_complete;
          IFEND;
        IFEND;
      ELSE { Unknown error, big trouble, terminate path }
        switch_state := nfc$switch_failed_lost;
      IFEND;
    ELSE
      switch_state := nfc$switch_complete;
    IFEND;
{}
  PROCEND ptfs_switch_connection;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_switch_it', EJECT ??

  PROCEDURE ptfs_switch_it
    (    initiated_job_system_name: jmt$system_supplied_name;
         network_type: nft$network_type;
         time_out: nft$parameter_20_range;
         network_file: fst$file_reference;
     VAR status: ost$status);

{
{ Procedure  ptfs_switch_it
{
{ Purpose    To offer a connect switch to another job.
{
{ Description
{            This routine is simply a short hand way of offering a connection
{            switch to another job via RHFAM or NAM.
{
{ Input parameters
{            initiated_job_system_name   : Who you want to switch to
{            network_type                : RHFAM (LCN) or NAM
{            time_out                    : Length of switch offer
{            network_file                : Name of network path
{
{ Output parameters
{            status                      : Return status
{
{ Algorithm
{            Case network type
{            -nam- nap$offer_connection_switch
{            -lcn- rfp$offer_connection_switch
{
?? EJECT ??
{}
    status.normal := TRUE;
    CASE network_type OF
    = nfc$network_nam =
      nap$offer_connection_switch (network_file, initiated_job_system_name, time_out * nfc$milliseconds,
            status);
    = nfc$network_lcn =
      rfp$offer_connection_switch (network_file, initiated_job_system_name, time_out * nfc$milliseconds,
            status);
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'ptfs_switch_it, case error',
            status);
      nfp$format_message_to_job_log (status);
      RETURN;
    CASEND;
  PROCEND ptfs_switch_it;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_cancel_offer', EJECT ??

  PROCEDURE ptfs_cancel_offer
    (    network_file: fst$file_reference;
         network_type: nft$network_type;
     VAR status: ost$status);

{
{ Procedure  ptfs_cancel_offer
{
{ Purpose    This routine is a short hand way of cancelling a connection
{            switch offer to RHFAM or NAM.
{
{ Description
{            The appropriate cancel switch offer routine is called for the
{            network type.
{
{ Input parameters
{            network_file         : Path name of network file
{            network_type         : NAM or RHFAM (LCN)
{
{ Output parameters
{            status               : Return status
{
{ Algorithm
{            Case network type of
{            -nam- nap$cancel_switch_offer
{            -lcn- rfp$cancel_switch_offer
{            Casend
{
?? EJECT ??
{}
    status.normal := TRUE;
    CASE network_type OF
    = nfc$network_lcn =
      rfp$cancel_switch_offer (network_file, status);
    = nfc$network_nam =
      nap$cancel_switch_offer (network_file, status);
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'ptfs_cancel_offer, case error',
            status);
      nfp$format_message_to_job_log (status);
      RETURN;
    CASEND;
{}
  PROCEND ptfs_cancel_offer;
?? OLDTITLE ??
?? TITLE := 'ptfs_parameters_for_rpos', EJECT ??

  PROCEDURE ptfs_parameters_for_rpos
    (VAR rpos_parameters: nft$parameter_set;
     VAR nfv$control_block: nft$control_block;
     VAR status: ost$status);

{
{ Procedure  ptfs_parameters_for_rpos
{
{ Purpose    This routine takes information from the RFT command and sets
{            up additional RPOS parameters for PTFS.
{
{ Description
{            Several checks are made here which are important in NOS/VE to
{            NOS/VE transfers.  First, the data declaration UH can only
{            be used in NOS/VE to NOS/VE transfers.  Attempts made by other
{            host types to use UH should be RNEGed.  Second, NOS/VE to NOS/VE
{            transfers should always use type UH, no matter what was specified
{            on the RFT.
{
{ Input parameters
{            None
{
{
{ Input/output parameters
{            Control_block        : Transfer control block
{
{ Output parameters
{            Rpos_parameters             : Set of parameters to use for RPOS
{                                          command.
{            Status                      : Return status
{
{ Algorithm
{            If DD = UH and host type <> NOS/VE
{            Then
{              Set error
{            Else
{              Return
{            Ifend
{            If DD <> UH and host type = NOS/VE
{            Then
{              Add parameter DD value UH to RPOS command
{            Else
{              Return
{            Ifend
{
?? EJECT ??
    status.normal := TRUE;
    rpos_parameters := $nft$parameter_set [nfc$protocol_id, nfc$mode_of_access, nfc$host_type, nfc$job_name,
          nfc$physical_id];
    IF ((nfv$control_block.data_declaration = nfc$p31_host_dependent_uh) AND
          (nfv$control_block.remote_host_type <> nfc$p22_nos_ve)) THEN
      osp$set_status_abnormal (nfc$status_id, nfe$unknown_data_format, '', status);
      nfp$set_abnormal_if_normal (status, nfv$control_block.local_status);
      RETURN;
    IFEND;

    IF ((nfv$control_block.data_declaration <> nfc$p31_host_dependent_uh) AND
          (nfv$control_block.remote_host_type = nfc$p22_nos_ve)) THEN
      nfv$control_block.data_declaration := nfc$p31_host_dependent_uh;
      rpos_parameters := rpos_parameters + $nft$parameter_set [nfc$data_declaration];
    IFEND;
{}
  PROCEND ptfs_parameters_for_rpos;
?? OLDTITLE ??
?? NEWTITLE := 'ptfs_send_status_parameter', EJECT ??

  PROCEDURE ptfs_send_status_parameter
    (    transfer_status: ost$status;
     VAR special_options: nft$parameter_11_value;
     VAR status: ost$status);

{
{ Procedure  ptfs_send_status_parameter
{
{ Purpose    This routine takes a NOS/VE status record and converts
{            it into a string.  This string may then be sent to other
{            NOS/VE systems for communicating status information.
{
{ Description
{            The NOS/VE status parameter is made up of three parts: ID,
{            condition, and text.  Each is placed in the string delimited
{            by a space.
{
{ Input parameters
{            Transfer_status      Status to convert to string
{
{ Output parameters
{            Special_options      Returned string value
{            Status               Return status
{
{ Algorithm
{
?? EJECT ??

    VAR
      condition_string: ost$string,
      ignore_status: ost$status,
      parameter: string (nfc$p11_max_param_len),
      parameter_length: nft$parameter_size;

{}
    status.normal := TRUE;
    IF NOT transfer_status.normal THEN
      osp$get_status_condition_string (transfer_status.condition, condition_string, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      parameter_length := condition_string.size;
      parameter (1, parameter_length) := condition_string.value;
      parameter (parameter_length + 1, 1) := ' ';
      parameter_length := parameter_length + 1;
      IF transfer_status.text.size > 0 THEN
        parameter_length := parameter_length + 1;
        parameter (parameter_length, transfer_status.text.size) := transfer_status.text.value;
        parameter_length := parameter_length + transfer_status.text.size - 1;
      IFEND;
      special_options.size := parameter_length;
      IF parameter_length > 0 THEN
        special_options.value := parameter;
      IFEND;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error,
            'ptfs_send_status_parameter status is normal', status);
    IFEND;

  PROCEND ptfs_send_status_parameter;
?? OLDTITLE ??
?? NEWTITLE := '  ptfs_scan_scl_command_file', EJECT ??

  PROCEDURE ptfs_scan_scl_command_file
    (    scan_file: fst$file_reference;
         force_job_log_echo: boolean;
     VAR begin_connection_time: ost$date_time;
     VAR nfv$control_block: nft$control_block;
     VAR status: ost$status);

{
{ Procedure  ptfs_scan_scl_command_file
{
{ Purpose    To scan a command file for SCL commands and
{            PTFS file transfer directives.
{
{ Description
{            This routine pushes the PTFS utility and calls SCL
{            to execute commands.
{
{ Input parameters
{            scan_file:    File to read for SCL commands
{            force_job_log_echo:  Have create_connection $output $job_log
{
{ Input/Output parameters
{            begin_connection_time: Time RFT received
{
{ Output parameters
{            status:       Return status
{

?? EJECT ??
    VAR
      conditions: pmt$condition,
      establish_descriptor: pmt$established_handler,
      ignore_status: ost$status,
      local_status: ost$status,
      no_prompt: string (1),
      server_utility_name: ost$name,

      ptfs_commands_entries: [STATIC, READ] array [1 .. 4] of clt$command_table_entry := [
            {} ['RECEIVE_FILE                   ', clc$nominal_entry, clc$advertised_entry, 2,
            clc$automatically_log, clc$linked_call, ^receive_file_command],
            {} ['RECF                           ', clc$abbreviation_entry, clc$advertised_entry, 2,
            clc$automatically_log, clc$linked_call, ^receive_file_command],
            {} ['SEND_FILE                      ', clc$nominal_entry, clc$advertised_entry, 1,
            clc$automatically_log, clc$linked_call, ^send_file_command],
            {} ['SENF                           ', clc$abbreviation_entry, clc$advertised_entry, 1,
            clc$automatically_log, clc$linked_call, ^send_file_command]];

?? NEWTITLE := '    ptfs_scan_scl_handler', EJECT ??

{
{     The primary purpose of this condition handler is to catch the results of a
{ logout command in the command file being scanned.  When LOGOUT is encountered,
{ the protocol processing is not completed and the connection is broken.  This
{ condition handler will finish the protocol.
{

    PROCEDURE ptfs_scan_scl_handler
      (    condition: pmt$condition;
           condition_desc: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR trap_status: ost$status);


      IF condition.reason = $pmt$block_exit_reason [pmc$program_termination] THEN
        ptfs_process_protocol (FALSE, user_ptfs_job_logout,
         nfv$control_block, begin_connection_time, local_status);
      ELSE
        ptfs_process_protocol (FALSE, ptfs_scan_scl_handler_id,
         nfv$control_block, begin_connection_time, local_status);
        osp$set_status_from_condition (nfc$status_id, condition, save_area, status, local_status);
        IF local_status.normal THEN
          nfp$format_message_to_job_log (status);
        IFEND;
      IFEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);

    PROCEND ptfs_scan_scl_handler;
?? OLDTITLE, EJECT ??
    conditions.selector := pmc$condition_combination;
    conditions.combination := $pmt$condition_combination [pmc$block_exit_processing];
    pmp$establish_condition_handler (conditions, ^ptfs_scan_scl_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      pmp$log ('ptfs_scan_scl_command_file unable to establish handler', ignore_status);
      nfp$format_message_to_job_log (status);
      RETURN;
    IFEND;

    server_utility_name := 'PTFS';
    no_prompt := '';
    clp$push_utility (server_utility_name, clc$global_command_search, ^ptfs_commands_entries, NIL, status);
    IF NOT status.normal THEN { Unable to process SCL commands }
      RETURN;
    ELSE
      IF force_job_log_echo THEN
        clp$create_file_connection (clc$echoed_commands, clc$job_log, ignore_status);
      IFEND;
    IFEND;

    clp$scan_command_file (scan_file, server_utility_name, no_prompt, status);
    IF force_job_log_echo THEN
      clp$delete_file_connection (clc$echoed_commands, clc$job_log, ignore_status);
    IFEND;
    clp$pop_utility (ignore_status);

{   If SCL had an error, set bad state of transfer and local status

    IF (NOT status.normal) THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, local_status);
      IF nfv$control_block.state_of_transfer.normal THEN
        osp$set_status_abnormal (nfc$status_id, nfe$transfer_rejected_message, '',
              nfv$control_block.state_of_transfer);
      IFEND;
      nfp$set_abnormal_if_normal (status, nfv$control_block.local_status);
    IFEND;

    pmp$disestablish_cond_handler (conditions, ignore_status);

  PROCEND ptfs_scan_scl_command_file;
?? OLDTITLE ??
?? NEWTITLE := 'build_05_directives_text', EJECT ??
{
{     The purpose of this routine is to concatenate directive entries
{  into a string. This string is logged via communication accounting.
{
{ USER_DIRECTIVES : (input) Linked list of directives.
{
{ TEXT : (output) Output string.
{

  PROCEDURE build_05_directives_text
    (    user_directives_p: ^nft$directive_entry;
     VAR text: ost$string);

    VAR
      current_entry_p: ^nft$directive_entry,
      current_line_length: ost$string_size;

    text.size := 0;
    IF (user_directives_p <> NIL) THEN
      current_entry_p := user_directives_p;
      /count_loop/
      REPEAT
        current_line_length := STRLENGTH(current_entry_p^.line);
        IF (osc$max_string_size-text.size>=current_line_length) THEN
          text.value(text.size+1,current_line_length) := current_entry_p^.line;
          text.size := text.size + current_line_length;
          current_entry_p := current_entry_p^.link;
          IF current_entry_p <> NIL THEN
            IF text.size+2 >= osc$max_string_size THEN
              EXIT /count_loop/;
            IFEND;
            text.size := text.size + 1;
            text.value(text.size,1) := '/';
          IFEND;
        ELSE
          text.value(text.size,*) := current_entry_p^.line;
          text.size := osc$max_string_size;
          EXIT /count_loop/;
        IFEND;
      UNTIL (current_entry_p = NIL);
    IFEND;

  PROCEND build_05_directives_text;
?? OLDTITLE ??
?? NEWTITLE := 'send_rneg', EJECT ??

  PROCEDURE send_rneg
    (    parameters: nft$parameter_set;
         rft_parameters: nft$parameter_set;
     VAR control_block: nft$control_block;
     VAR status: ost$status);

{
{     The purpose of this routine is to send an RNEG command.
{
{ PARAMETERS : (input) Parameters requested to be sent by caller.
{
{ RFT_PARAMETERS : (input) Parameters sent by initiator on RFT.
{
{ CONTROL_BLOCK : (input,output) Protocol engine control block.
{
{ STATUS : (output) Return status.
{

    VAR
      ignore_parameters: nft$parameter_set,
      select_parameters: nft$parameter_set;

    ignore_parameters := $nft$parameter_set[ ];
    select_parameters := parameters;
    IF ((nfc$special_options IN rft_parameters) AND (control_block.remote_host_type <>
          nfc$p22_nos_ve)) THEN

{ Ignore special options }

      control_block.send_special_options.size := control_block.receive_special_options.size;
      IF (control_block.send_special_options.size > 0) THEN
        control_block.send_special_options.value := control_block.receive_special_options.value;
      IFEND;
      ignore_parameters := ignore_parameters + $nft$parameter_set[ nfc$special_options ];
    IFEND;
    nfp$send_command (nfc$rneg, select_parameters, ignore_parameters, $nft$parameter_set[ ], control_block,
          status);

  PROCEND send_rneg;
?? OLDTITLE ??
?? NEWTITLE := 'send_rpos', EJECT ??

  PROCEDURE send_rpos
    (    parameters: nft$parameter_set;
         rft_parameters: nft$parameter_set;
     VAR control_block: nft$control_block;
     VAR status: ost$status);

{
{     The purpose of this routine is to send an RPOS command.
{
{ PARAMETERS : (input) Parameters requested to be sent by caller.
{
{ RFT_PARAMETERS : (input) Parameters sent by initiator on RFT.
{
{ CONTROL_BLOCK : (input,output) Protocol engine control block.
{
{ STATUS : (output) Return status.
{

    VAR
      ignore_parameters: nft$parameter_set,
      select_parameters: nft$parameter_set;

    ignore_parameters := $nft$parameter_set[ ];
    select_parameters := parameters;
    IF ((nfc$special_options IN rft_parameters) AND (control_block.remote_host_type <>
          nfc$p22_nos_ve)) THEN

{ Ignore special options }

      control_block.send_special_options.size := control_block.receive_special_options.size;
      IF (control_block.send_special_options.size > 0) THEN
        control_block.send_special_options.value := control_block.receive_special_options.value;
      IFEND;
      ignore_parameters := ignore_parameters + $nft$parameter_set[ nfc$special_options ];
    IFEND;
    nfp$send_command (nfc$rpos, select_parameters,ignore_parameters, $nft$parameter_set[ ], control_block,
          status);

  PROCEND send_rpos;
?? OLDTITLE ??
MODEND nfm$ptf_server;

