?? RIGHT := 110 ??
MODULE uom$create_device_connection;
{
{ PURPOSE:
{
{   This module contains code that establishes a connection to a device that is
{   accessed via the CDCNET Device Outcall Gateway application.
{
{   The Device Outcall Gateway application serves as a rendezvous point for a
{   device connected to a CDCNET asynchronous LIM port that wishes to accept
{   connections from host applications.  Such a device is known as a server
{   device.  A server device may be a terminal, a printer, a modem, or any other
{   device that may be connected to a CDCNET asynchonous LIM port.
{
{   A server device declares its intention to accept connections from host
{   applications by connecting to the Device Outcall Gateway application and
{   sending a DEFINE_SERVER_DEVICE command to the application.  This command
{   specifies the title by which the server device is to be known.  The Device
{   Outcall Gateway registers this title on behalf of the server device.
{
{   A host application that wishes to establish a connection to a server device
{   uses the server device's title to establish a connection to the Device
{   Outcall Gateway application.  When a host application establishes a
{   connection to the Device Outcall Gateway, the gateway "pairs" this
{   connection with the connection from the server device; data received over
{   one connection is forwarded over the paired connection.
{
{   The code in this module establishes a connection to a server device on
{   behalf of a host application.  The host application must be defined via the
{   MANAGE_NETWORK_APPLICATIONS utility.
{
{ DESIGN:
{
{   This module contains two procedures.  The first procedure is a command
{   processor that supports a command interface to establish a device
{   connection.  A program description specifying this procedure as the starting
{   procedure must be created in a NOS/VE object library in order to provide a
{   command interface.
{
{   The second procedure is a program interface for establishing a device
{   connection.  It may be called by programs that need to establish a device
{   connection.  It is called by the command processor procedure described
{   above.
{
?? TITLE := 'Message Templates', EJECT ??
*copyc uoe$credc_condition_codes
?? TITLE := 'Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc fst$temporary_file_path
?? POP ??
*copyc amp$return
*copyc clp$create_environment_variable
*copyc clp$change_variable
*copyc clp$evaluate_parameters
*copyc nap$begin_directory_search
*copyc nap$end_directory_search
*copyc nap$get_title_translation
*copyc nap$request_connection
*copyc osp$generate_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$get_unique_name
*copyc rmp$request_terminal
?? TITLE := '[XDCL] uop$_create_device_connection', EJECT ??

  PROCEDURE [XDCL] uop$_create_device_connection
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ram$credc) create_device_connection, credc (
{   device, d: name = $required
{   terminal_file, tf: file = $required
{   application, a: name = $required
{   translation_wait_time, twt: integer = 16
{   connection_wait_time, cwt: integer 1 .. clc$max_integer = 10
{   service_data, sd: string 1..63 = $optional
{   network_file, nf: data_name = credc_network_file
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 15] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type7: record
        header: clt$type_specification_header,
        default_value: string (18),
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 6, 19, 16, 0, 19, 56],
    clc$command, 15, 8, 3, 0, 0, 0, 8, 'RAM$CREDC'], [
    ['A                              ',clc$abbreviation_entry, 3],
    ['APPLICATION                    ',clc$nominal_entry, 3],
    ['CONNECTION_WAIT_TIME           ',clc$nominal_entry, 5],
    ['CWT                            ',clc$abbreviation_entry, 5],
    ['D                              ',clc$abbreviation_entry, 1],
    ['DEVICE                         ',clc$nominal_entry, 1],
    ['NETWORK_FILE                   ',clc$nominal_entry, 7],
    ['NF                             ',clc$abbreviation_entry, 7],
    ['SD                             ',clc$abbreviation_entry, 6],
    ['SERVICE_DATA                   ',clc$nominal_entry, 6],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['TERMINAL_FILE                  ',clc$nominal_entry, 2],
    ['TF                             ',clc$abbreviation_entry, 2],
    ['TRANSLATION_WAIT_TIME          ',clc$nominal_entry, 4],
    ['TWT                            ',clc$abbreviation_entry, 4]],
    [
{ PARAMETER 1
    [6, 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, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [12, 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 3
    [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, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 4
    [14, 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, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 5
    [3, 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, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 6
    [10, 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, 8, clc$optional_parameter, 0
  , 0],
{ PARAMETER 7
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 18],
{ PARAMETER 8
    [11, 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$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '16'],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, clc$max_integer, 10],
    '10'],
{ PARAMETER 6
    [[1, 0, clc$string_type], [1, 63, FALSE]],
{ PARAMETER 7
    [[1, 0, clc$data_name_type],
    'credc_network_file'],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$device = 1,
      p$terminal_file = 2,
      p$application = 3,
      p$translation_wait_time = 4,
      p$connection_wait_time = 5,
      p$service_data = 6,
      p$network_file = 7,
      p$status = 8;

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

    VAR
      device_title: ^nat$title_pattern,
      ignore_status: ost$status,
      network_file_name: fst$temporary_file_path,
      network_file_value: clt$data_value,
      service_data: ^SEQ ( * ),
      type_spec_header: clt$type_specification_header;

?? EJECT ??
    status.normal := TRUE;

{   Isolate parameter values.

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    PUSH device_title: [#SIZE (pvt [p$device].value^.name_value)];
    device_title^ := pvt [p$device].value^.name_value;
    IF pvt [p$service_data].specified THEN
      service_data := #SEQ (pvt [p$service_data].value^.string_value^);
    ELSE
      service_data := NIL;
    IFEND;

{   Call the program interface to create the device connection.

    uop$create_device_connection (device_title^, pvt [p$terminal_file].
          value^.file_value^, pvt [p$application].value^.name_value,
          pvt [p$translation_wait_time].value^.integer_value.value,
          pvt [p$connection_wait_time].value^.integer_value.value, service_data, network_file_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Store the network file name in the specified SCL variable.

    network_file_value.kind := clc$file;
    network_file_value.file_value := ^network_file_name;
    clp$change_variable (pvt [p$network_file].value^.data_name_value, ^network_file_value, status);
    IF NOT status.normal THEN
      IF status.condition = cle$unknown_variable THEN
        type_spec_header.version := 1;
        type_spec_header.name_size := 0;
        type_spec_header.kind := clc$file_type;
        clp$create_environment_variable (pvt [p$network_file].value^.data_name_value, clc$job_scope,
              clc$read_write, clc$immediate_evaluation, #SEQ (type_spec_header), ^network_file_value, status);
      IFEND;
    IFEND;
    IF NOT status.normal THEN
      amp$return (network_file_name, ignore_status);
      amp$return (pvt [p$terminal_file].value^.file_value^, ignore_status);
      osp$generate_message (status, ignore_status);
      osp$set_status_abnormal ('  ', uoe$unable_to_change_nf_var, pvt [p$network_file].value^.data_name_value,
            status);
    IFEND;

  PROCEND uop$_create_device_connection;
?? TITLE := '[XDCL] uop$create_device_connection', EJECT ??
*copy uoh$create_device_connection

  PROCEDURE [XDCL] uop$create_device_connection
    (    device_title: nat$title_pattern;
         terminal_file_name: fst$file_reference;
         application_name: ost$name;
         translation_wait_time: integer;
         connection_wait_time: integer;
         service_data: ^SEQ ( * );
     VAR network_file_name: fst$temporary_file_path;
     VAR status: ost$status);

    TYPE
      uot$outcall_connect_data_header = record
        version: 0 .. 255,
        device_title: ost$name,
        service_data_length: 0 .. 63,
      recend;

    VAR
      connect_data: ^SEQ ( * ),
      connect_data_data: ^SEQ ( * ),
      connect_data_header: ^uot$outcall_connect_data_header,
      ignore_status: ost$status,
      network_attributes: array [1 .. 1] of nat$create_attribute,
      ready_index: integer,
      search_id: nat$directory_search_identifier,
      server_address: nat$network_address,
      terminal_attributes: array [1 .. 1] of ift$connection_attribute,
      translated_title: ost$name,
      translation_attributes: array [1 .. 2] of nat$translation_attribute,
      translation_attributes_p: ^nat$translation_attributes;

    status.normal := TRUE;

{   Validate parameters.

    IF (service_data <> NIL) AND (#SIZE (service_data^) > 63) THEN
      osp$set_status_condition (uoe$service_data_too_large, status);
      RETURN;
    IFEND;
    IF connection_wait_time <= 0 THEN
      osp$set_status_condition (uoe$invalid_conn_wait_time, status);
      RETURN;
    IFEND;

{   Translate the device's title to obtain the address of its device outcall server.

    nap$begin_directory_search (device_title, application_name, FALSE, search_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    translation_attributes [1].selector := nac$translation_title;
    translation_attributes [1].title := ^translated_title;
    translation_attributes [2].selector := nac$translation_priority;
    translation_attributes_p := ^translation_attributes;
    nap$get_title_translation (search_id, translation_wait_time * 1000, translation_attributes_p,
          server_address, status);
    nap$end_directory_search (search_id, ignore_status);
    IF NOT status.normal THEN
      IF status.condition = nae$directory_search_complete THEN
        osp$set_status_abnormal ('  ', uoe$server_not_active, device_title, status);
      ELSEIF status.condition = nae$no_translation_available THEN
        osp$set_status_abnormal ('  ', uoe$server_busy_or_not_active, device_title, status);
      IFEND;
      RETURN;
    IFEND;
    IF translation_attributes [2].priority = 0ff(16) THEN
      osp$set_status_abnormal ('  ', uoe$server_busy, device_title, status);
      RETURN;
    IFEND;

{   Generate a unique name for the network file.

    network_file_name := '$LOCAL.';
    pmp$get_unique_name (network_file_name (8, 31), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{  Allocate space for the connect_data on the connection request.

    IF service_data = NIL THEN
      PUSH connect_data: [[REP #SIZE (uot$outcall_connect_data_header) OF cell]];
      NEXT connect_data_header IN connect_data;
      connect_data_header^.service_data_length := 0;
    ELSE
      PUSH connect_data: [[REP (#SIZE (uot$outcall_connect_data_header) + #SIZE (service_data^)) OF cell]];
      NEXT connect_data_header IN connect_data;
      connect_data_header^.service_data_length := #SIZE (service_data^);
      NEXT connect_data_data: [[REP connect_data_header^.service_data_length OF cell]] IN connect_data;
      connect_data_data^ := service_data^;
    IFEND;
    connect_data_header^.version := 1;
    connect_data_header^.device_title := translated_title;

{   Create a network connection to the Device Outcall Gateway.

    network_attributes [1].kind := nac$connect_data;
    network_attributes [1].connect_data := connect_data;

    nap$request_connection (server_address, application_name, network_file_name, nac$cdna_virtual_terminal,
          ^network_attributes, connection_wait_time * 1000, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Create a terminal file for the connection.

    terminal_attributes [1].key := ifc$null_connection_attribute;
    rmp$request_terminal (terminal_file_name, ^network_file_name (8, 31), terminal_attributes, status);

{   *** Change the preceding line to the following when PSR NV0T624 is answered.

{   rmp$request_terminal (terminal_file_name, ^network_file_name, terminal_attributes, status);

    IF NOT status.normal THEN
      amp$return (network_file_name, ignore_status);
    IFEND;

  PROCEND uop$create_device_connection;
?? OLDTITLE ??
MODEND uom$create_device_connection;


