?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE NETWORK ACCESS: TCP/IP Management Access Agent' ??
MODULE nlm$tcpip_mgmt_access_agent;

{ PURPOSE:
{   This module contains procedures neccesary to communicate with the TCP/IP Management Access
{   Provider (TMAP) in the TCP/IP communications device. These procedures provide the TCP/IP
{   Management Access Agent (TMAA) in the host.
{ DESIGN:
{   The TMAA and the TMAP communicate over a channel connection. After a device is loaded,
{   the TMAP initiates the channel connection connect request. The TMAA and the TMAP exchange
{   initialization information over the channel connection.
{   TMAA initialization begins with a CC connect indication - a negotiate protocol request - from
{   TMAP.  TMAA responds with a CC connect confirm - a negotiate protocol response.  After the
{   device receives the confirm the CC connection is established and all subsequent requests
{   will use the CC data service with the exception of breaking the connection which uses a
{   a CC disconnect request.  Once the connection is established TMAP sends a device configure
{   request which contains the local device IP address and which protocol(s), TCP and/or UDP, are
{   supported.  TMAA responds with a device confirm.  After the initialization of the
{   TMAA/TMAP is complete, the TMAA will allow the users in the host to obtain routing
{   information and will also process subnet available indications from the TMAP.
{   Any protocol errors encountered will result in disconnecting the channel connection.
{
{   The XDCL'd procedures have been grouped in alphabetical order followed by the internal
{   procedures. The internal procedures are also in alphabetical order.
{
{   The following Finite
{   State Machine describes the states and the associated events. Please refer to the TCP/IP
{   Management Access Agent Protocol Specification (A8551),the TCP/IP Management Access
{   Provider Protocol Specification (A8552), and TCP/IP Host Routing DAP (A8608) for more
{   information.
{
{   This module contains code that executes in ring 3. It resides on OSF$JOB_TEMPLATE_23D.
{
{ NOTES:
{   The following abreviations have been used in this module.
{        ID  = Identifier
{        IP  = Internet Protocol
{        PDU = Protocol Data Unit
{        TCP = Transport Class Protocol
{        UDP = User Datagram Protocol

?? NEWTITLE := 'Finite State Machine', EJECT ??

{ It was decided by GSA that host routing would always be enabled.

{----------------+----------------+----------------+----------------+----------------+
{                |     (a)        |     (b)        |     (d)        |     (e)        |
{                | nlc$tm_closed  | nlc$tm_        | nlc$tm_        | nlc$tm_closed  |
{                |  (initial)     | configuration_ | enable_host_   |                |
{                |                | ind_wait       | routing        |                |
{----------------+----------------+----------------+----------------+----------------+
{                |                |                |                |                |
{ CC connect     |     (1)        |                |                |                |
{   indication   |     a->b       |      -         |      -         |      -         |
{ nlc$tm_        |                |                |                |                |
{ negotiate_     |                |                |                |                |
{ protocol_req   |                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{                |                |                |                |                |
{ CC disconnect  |                |     (5)        |     (21)       |                |
{   indication   |      -         |     b->e       |     d->e       |      -         |
{                |                |                |                |                |
{                |                |                |                |                |
{                |                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{ NOT host       |                |                |                |                |
{ routing enabled|                |                |                |                |
{ CC data        |                |     (6)        |     (20)       |                |
{   indication   |      -         |     b->c       |     d->e       |      -         |
{ nlc$tm_        |                |                |                |                |
{ device_config_ |                |                |                |                |
{ req            |                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{     host       |                |                |                |                |
{ routing enabled|                |                |                |                |
{ CC data        |                |     (6)        |     (20)       |                |
{   indication   |      -         |     b->d       |     d->e       |      -         |
{ nlc$tm_        |                |                |                |                |
{ device_config_ |                |                |                |                |
{ req            |                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{                |                |                |                |                |
{ CC data        |                |                |                |                |
{   indication   |                |     (7)        |     (15)       |                |
{ nlc$tm_        |      -         |     b->e       |     d->d       |      -         |
{ address_       |                |                |                |                |
{ accessible_res |                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{                |                |                |                |                |
{ CC data        |                |                |                |                |
{   indication   |                |     (7)        |     (16)       |                |
{ nlc$tm_        |      -         |     b->e       |     d->d       |      -         |
{ subnet_        |                |                |                |                |
{ available_ind  |                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{                |                |                |                |                |
{ CC data        |                |                |                |                |
{   indication   |                |     (7)        |     (17)       |                |
{ nlc$tm_        |      -         |     b->e       |     d->d       |      -         |
{ subnet_        |                |                |                |                |
{ unavailable_ind|                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+
{                |                |                |                |                |
{ CC data        |                |                |                |                |
{   indication   |                |     (7)        |     (18)       |                |
{ nlc$tm_        |      -         |     b->e       |     d->d       |      -         |
{ route_         |                |                |                |                |
{ unavailable_ind|                |                |                |                |
{----------------+----------------+----------------+----------------+----------------+

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc nae$tcpip_mgmt_condition_codes
*copyc nlt$cc_interface
*copyc nlt$device_ids
*copyc nlt$device_list
*copyc nlt$tm_connection
*copyc nlt$tm_device_list
*copyc nlt$tm_pdu
*copyc nlt$tm_protocol
*copyc nlt$tm_static_route_definitions
*copyc ofe$error_codes
*copyc ost$status
?? POP ??

*copyc avp$configuration_administrator
*copyc avp$system_displays
*copyc nap$display_message
*copyc nap$namve_system_error
*copyc nlp$bm_create_message
*copyc nlp$bm_extract_message_prefix
*copyc nlp$bm_flush_message
*copyc nlp$bm_get_message_length
*copyc nlp$bm_release_message
*copyc nlp$cc_accept_connection
*copyc nlp$cc_disconnect
*copyc nlp$cc_initialize_template
*copyc nlp$cc_send_data_fragments
*copyc nlp$cl_activate_layer
*copyc nlp$cl_activate_receiver
*copyc nlp$cl_deactivate_layer
*copyc nlp$cl_get_exclusive_via_cid
*copyc nlp$cl_get_layer_connection
*copyc nlp$cl_initialize_template
*copyc nlp$cl_release_exclusive_access
*copyc nlp$get_exclusive_access
*copyc nlp$get_nonexclusive_access
*copyc nlp$release_exclusive_access
*copyc nlp$release_nonexclusive_access
*copyc nlp$sk_tcp_device_available
*copyc nlp$udp_device_available
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$clear_job_signature_lock
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$get_executing_task_gtid
*copyc pmp$log_ascii
*copyc pmp$ready_task
*copyc pmp$wait
*copyc syp$cycle
*copyc nav$network_paged_heap
*copyc nav$sk_socket_layer_active
*copyc nlv$configured_network_devices
*copyc nlv$tm_address_accessible
*copyc nlv$tm_device_configuration
*copyc nlv$tm_host
*copyc nlv$tm_route_cache
*copyc nlv$tm_static_routing_table
*copyc nlv$tm_subnet_list
*copyc oss$job_paged_literal

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    one_minute = 60000, { Milliseconds
    ten_minutes = 600000, { Milliseconds
    mics_to_mills = 1024, { approximate conversion to milliseconds - faster than using 1000
    nlc$tm_version = 1;

  TYPE
    local_route_cost = 0 .. nlc$tm_maximum_route_cost + 1;

  VAR
    initial_connection: nlt$tm_connection := [ * , nlc$tm_closed, nlc$tm_version],
    nlv$log_tcpip_device_select: [XREF] boolean,
    nlv$tm_class_a_network_mask: 0 .. 0ffffffff(16) := 0ff000000(16),
    nlv$tm_class_b_network_mask: 0 .. 0ffffffff(16) := 0ffff0000(16),
    nlv$tm_class_c_network_mask: 0 .. 0ffffffff(16) := 0ffffff00(16),

{ PURPOSE:
{   This variable is initialized to its index's mirror image.  For example,
{   01(16) or 00000001(2) has a mirror image of 80(16) or 10000000(2), 83(16)
{   or 10000011(2) has a mirror image of C1(16) or 11000001(2).

    inverse_table: [READ, oss$job_paged_literal] array [0 .. 0ff(16)] of 0 .. 0ff(16) := [
?? FMT (FORMAT := OFF) ??
{ 00(16)} 00(16), 80(16), 40(16), 0C0(16), 20(16), 0A0(16), 60(16), 0E0(16),
          10(16), 90(16), 50(16), 0D0(16), 30(16), 0B0(16), 70(16), 0F0(16),
{ 10(16)} 08(16), 88(16), 48(16), 0C8(16), 28(16), 0A8(16), 68(16), 0E8(16),
          18(16), 98(16), 58(16), 0D8(16), 38(16), 0B8(16), 78(16), 0F8(16),
{ 20(16)} 04(16), 84(16), 44(16), 0C4(16), 24(16), 0A4(16), 64(16), 0E4(16),
          14(16), 94(16), 54(16), 0D4(16), 34(16), 0B4(16), 74(16), 0F4(16),
{ 30(16)} 0C(16), 8C(16), 4C(16), 0CC(16), 2C(16), 0AC(16), 6C(16), 0EC(16),
          1C(16), 9C(16), 5C(16), 0DC(16), 3C(16), 0BC(16), 7C(16), 0FC(16),
{ 40(16)} 02(16), 82(16), 42(16), 0C2(16), 22(16), 0A2(16), 62(16), 0E2(16),
          12(16), 92(16), 52(16), 0D2(16), 32(16), 0B2(16), 72(16), 0F2(16),
{ 50(16)} 0A(16), 8A(16), 4A(16), 0CA(16), 2A(16), 0AA(16), 6A(16), 0EA(16),
          1A(16), 9A(16), 5A(16), 0DA(16), 3A(16), 0BA(16), 7A(16), 0FA(16),
{ 60(16)} 06(16), 86(16), 46(16), 0C6(16), 26(16), 0A6(16), 66(16), 0E6(16),
          16(16), 96(16), 56(16), 0D6(16), 36(16), 0B6(16), 76(16), 0F6(16),
{ 70(16)} 0E(16), 8E(16), 4E(16), 0CE(16), 2E(16), 0AE(16), 6E(16), 0EE(16),
          1E(16), 9E(16), 5E(16), 0DE(16), 3E(16), 0BE(16), 7E(16), 0FE(16),
{ 80(16)} 01(16), 81(16), 41(16), 0C1(16), 21(16), 0A1(16), 61(16), 0E1(16),
          11(16), 91(16), 51(16), 0D1(16), 31(16), 0B1(16), 71(16), 0F1(16),
{ 90(16)} 09(16), 89(16), 49(16), 0C9(16), 29(16), 0A9(16), 69(16), 0E9(16),
          19(16), 99(16), 59(16), 0D9(16), 39(16), 0B9(16), 79(16), 0F9(16),
{ A0(16)} 05(16), 85(16), 45(16), 0C5(16), 25(16), 0A5(16), 65(16), 0E5(16),
          15(16), 95(16), 55(16), 0D5(16), 35(16), 0B5(16), 75(16), 0F5(16),
{ B0(16)} 0D(16), 8D(16), 4D(16), 0CD(16), 2D(16), 0AD(16), 6D(16), 0ED(16),
          1D(16), 9D(16), 5D(16), 0DD(16), 3D(16), 0BD(16), 7D(16), 0FD(16),
{ C0(16)} 03(16), 83(16), 43(16), 0C3(16), 23(16), 0A3(16), 63(16), 0E3(16),
          13(16), 93(16), 53(16), 0D3(16), 33(16), 0B3(16), 73(16), 0F3(16),
{ D0(16)} 0B(16), 8B(16), 4B(16), 0CB(16), 2B(16), 0AB(16), 6B(16), 0EB(16),
          1B(16), 9B(16), 5B(16), 0DB(16), 3B(16), 0BB(16), 7B(16), 0FB(16),
{ E0(16)} 07(16), 87(16), 47(16), 0C7(16), 27(16), 0A7(16), 67(16), 0E7(16),
          17(16), 97(16), 57(16), 0D7(16), 37(16), 0B7(16), 77(16), 0F7(16),
{ F0(16)} 0F(16), 8F(16), 4F(16), 0CF(16), 2F(16), 0AF(16), 6F(16), 0EF(16),
          1F(16), 9F(16), 5F(16), 0DF(16), 3F(16), 0BF(16), 7F(16), 0FF(16)];

?? FMT (FORMAT := ON) ??

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$tm_connect_event_processor' ??
?? NEWTITLE := '  disconnect', EJECT ??
*copy nlh$tm_connect_event_processor

  PROCEDURE [XDCL] nlp$tm_connect_event_processor
    (    cl_connection { input, output } : ^nlt$cl_connection;
         event { input, output } : nlt$cc_event;
     VAR inventory_report: integer);


    PROCEDURE disconnect
      (    disconnect_reason: nlt$tm_release_reason);

      VAR
        data_fragment: array [1 .. 1] of nat$data_fragment,
        message_id: nlt$bm_message_id,
        release_pdu: nlt$tm_release_request;

      release_pdu.header.kind := nlc$tm_release_request;
      release_pdu.header.length := #SIZE (nlt$tm_release_request);
      release_pdu.reason := disconnect_reason;
      data_fragment [1].address := ^release_pdu;
      data_fragment [1].length := release_pdu.header.length;
      nlp$bm_create_message (data_fragment, message_id, {ignore} status);
      nlp$cc_disconnect (cl_connection, message_id, {ignore} status);

    PROCEND disconnect;
?? OLDTITLE, EJECT ??

    VAR
      connection: ^nlt$tm_connection,
      data_fragment: array [1 .. 1] of nat$data_fragment,
      data_length: integer,
      layer_active: boolean,
      message_id: nlt$bm_message_id,
      negotiate_protocol_req_pdu: nlt$tm_negotiate_protocol_req,
      negotiate_protocol_res_pdu: nlt$tm_negotiate_protocol_res,
      status: ost$status;

    inventory_report := 0;

    IF event.kind = nlc$cc_connect_event THEN
      message_id := event.connect.data;

{ FSM #1.

      IF nlv$tm_host.name_length > 0 THEN
        nlp$bm_get_message_length (message_id, data_length);
        IF data_length = #SIZE (nlt$tm_negotiate_protocol_req) THEN
          data_fragment [1].address := ^negotiate_protocol_req_pdu;
          data_fragment [1].length := #SIZE (nlt$tm_negotiate_protocol_req);
          nlp$bm_flush_message (data_fragment, message_id, data_length, status);
          IF status.normal THEN
            IF negotiate_protocol_req_pdu.header.kind = nlc$tm_negotiate_protocol_req THEN
              negotiate_protocol_res_pdu.header.kind := nlc$tm_negotiate_protocol_res;
              negotiate_protocol_res_pdu.header.length := #SIZE (nlt$tm_negotiate_protocol_res);
              negotiate_protocol_res_pdu.version := nlc$tm_version;
              data_fragment [1].address := ^negotiate_protocol_res_pdu;
              data_fragment [1].length := negotiate_protocol_res_pdu.header.length;
              nlp$bm_create_message (data_fragment, message_id, {ignore} status);
              nlp$cc_accept_connection (cl_connection, event.connect.class, message_id, {ignore} status);
              nlp$cl_activate_layer (nlc$tcpip_mgmt_access_agent, cl_connection);
              nlp$cl_get_layer_connection (nlc$tcpip_mgmt_access_agent, cl_connection, {ignore} layer_active,
                    connection);
              connection^.device_id := event.connect.device_id;
              connection^.state := nlc$tm_configuration_ind_wait;
              connection^.version := negotiate_protocol_res_pdu.version;

{ Activate receiver so that all events are received in the current task.

              nlp$cl_activate_receiver (cl_connection);
            ELSE { Pdu.kind <> nlc$tm_negotiate_protocol_req
              disconnect (nlc$tm_invalid_encoding);
            IFEND;
          ELSE { The incoming pdu contains extra bytes of data.
            nlp$bm_release_message (message_id);
            disconnect (nlc$tm_header_length_incorrect);
          IFEND;
        ELSE { The pdu was incorrect.
          nlp$bm_release_message (message_id);
          disconnect (nlc$tm_header_indicernible);
        IFEND;
      ELSE { TCP/IP has not been configured.
        osp$set_status_abnormal (nac$status_id, nae$tm_tcpip_not_configured,
              nlv$configured_network_devices.network_device_list^ [event.connect.device_id].element, status);
        nap$display_message (status);
        nlp$bm_release_message (message_id);
        disconnect (nlc$tm_host_not_configured);
      IFEND;
    ELSE { Unsupported CC event.
      nap$namve_system_error ( {Recoverable_error=} TRUE,
            'Invalid CC connect event received by TCP/IP Management.', NIL);
    IFEND;
  PROCEND nlp$tm_connect_event_processor;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$tm_define_tcpip_host', EJECT ??
*copy nlh$tm_define_tcpip_host

  PROCEDURE [XDCL] nlp$tm_define_tcpip_host
    (    host_name: string ( * );
         forward_search_range: nlt$tm_search_range);

    VAR
      device_count: integer,
      i: integer,
      j: integer,
      k: integer,
      route_seq: ^SEQ ( * );

    nlv$tm_host.name := host_name;
    nlv$tm_host.name_length := #SIZE (host_name);
    device_count := UPPERBOUND (nlv$configured_network_devices.network_device_list^);

    REPEAT
      ALLOCATE nlv$tm_device_configuration: [1 .. device_count] IN nav$network_paged_heap^;
      IF nlv$tm_device_configuration = NIL THEN
        syp$cycle;
      IFEND;
    UNTIL nlv$tm_device_configuration <> NIL;
    nlv$tm_device_configuration^.lock.lock_id := 0;
    nlv$tm_device_configuration^.count := device_count;
    nlv$tm_device_configuration^.tcp.count := 0;
    nlv$tm_device_configuration^.tcp.identifier := 1;
    nlv$tm_device_configuration^.udp.count := 0;
    nlv$tm_device_configuration^.udp.identifier := 1;

    FOR i := 1 TO device_count DO
      nlv$tm_device_configuration^.list [i].protocol := nlc$tm_null;
      nlv$tm_device_configuration^.list [i].local_device_address.full := 0;
    FOREND;

{ Initialize routing tables.

    REPEAT
      ALLOCATE route_seq: [[REP (nlc$tm_hash_elements * (#SIZE (nlt$tm_cache_entry) +
            (#SIZE (nlt$tm_cache_device) * device_count)) * forward_search_range) OF cell]]
           IN nav$network_paged_heap^;
      IF route_seq = NIL THEN
        syp$cycle;
      IFEND;
    UNTIL route_seq <> NIL;
    nav$sk_socket_layer_active := TRUE;
    RESET route_seq;
    nlv$tm_route_cache.forward_search_range := forward_search_range;
    nlv$tm_route_cache.refresh_interval := one_minute;
    nlv$tm_route_cache.stale_release_interval := ten_minutes;
    FOR i := 0 TO nlc$tm_hash_elements - 1 DO
      nlv$tm_route_cache.element_list [i].lock.lock_id := 0;
      NEXT nlv$tm_route_cache.element_list [i].entry_list: [1 .. forward_search_range] IN route_seq;
      FOR j := 1 TO forward_search_range DO
        nlv$tm_route_cache.element_list [i].entry_list^ [j].destination_address.full := 0;
        nlv$tm_route_cache.element_list [i].entry_list^ [j].refresh_timestamp := 0;
        nlv$tm_route_cache.element_list [i].entry_list^ [j].last_used_timestamp := 0;
        nlv$tm_route_cache.element_list [i].entry_list^ [j].device_count := 0;
        nlv$tm_route_cache.element_list [i].entry_list^ [j].unavailable_routes :=
              $nlt$device_ids [];
        NEXT nlv$tm_route_cache.element_list [i].entry_list^ [j].device_list: [1 .. device_count] IN
              route_seq;
        FOR k := 1 TO device_count DO
          nlv$tm_route_cache.element_list [i].entry_list^ [j].device_list^ [k].device_id := 0;
          nlv$tm_route_cache.element_list [i].entry_list^ [j].device_list^ [k].
                usage_count := nlc$tm_maximum_usage_count;
        FOREND;
      FOREND;
    FOREND;
  PROCEND nlp$tm_define_tcpip_host;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$tm_event_processor', EJECT ??
*copy nlh$tm_event_processor

  PROCEDURE [XDCL] nlp$tm_event_processor
    (    cl_connection { input, output } : ^nlt$cl_connection;
         event { input, output } : nlt$cc_event;
     VAR inventory_report: integer);

?? NEWTITLE := '  deactivate_device' ??
?? NEWTITLE := '    find_tcp_device' ??

    PROCEDURE deactivate_device
      (    device_id: nlt$device_identifier);

{ NOTES:
{   The intent is to change the device id only if a TCP device is found.
{   The device id should never be zero because it is used to index into
{   an array with the smallest index of 1.

      PROCEDURE [INLINE] find_tcp_device
        (VAR device_id: nlt$device_identifier);

        VAR
          i: integer;

      /find_tcp_device_loop/
        FOR i := 1 TO nlv$tm_device_configuration^.count DO
          IF (nlv$tm_device_configuration^.list [i].protocol = nlc$tm_tcp_udp) OR
                (nlv$tm_device_configuration^.list [i].protocol = nlc$tm_tcp) THEN
            device_id := i;
            EXIT /find_tcp_device_loop/;
          IFEND;
        FOREND /find_tcp_device_loop/;

      PROCEND find_tcp_device;
?? NEWTITLE := '    find_udp_device', EJECT ??
?? OLDTITLE ??

{ NOTES:
{   The intent is to change the device id only if a UDP device is found.
{   The device id should never be zero because it is used to index into
{   an array with the smallest index of 1.

      PROCEDURE [INLINE] find_udp_device
        (VAR device_id: nlt$device_identifier);

        VAR
          i: integer;

      /find_udp_device_loop/
        FOR i := 1 TO nlv$tm_device_configuration^.count DO
          IF (nlv$tm_device_configuration^.list [i].protocol = nlc$tm_tcp_udp) OR
                (nlv$tm_device_configuration^.list [i].protocol = nlc$tm_udp) THEN
            device_id := i;
            EXIT /find_udp_device_loop/;
          IFEND;
        FOREND /find_udp_device_loop/;

      PROCEND find_udp_device;
?? OLDTITLE ??
?? EJECT ??
      VAR
        previous_request: ^^nlt$tm_addr_access_req_entry,
        request: ^nlt$tm_addr_access_req_entry,
        tcp_device: boolean,
        udp_device: boolean;

{ Update nlv$tm_device_configuration.

      osp$set_job_signature_lock (nlv$tm_device_configuration^.lock);
      nlv$tm_device_configuration^.list [device_id].local_device_address.full := 0;
      tcp_device := (nlv$tm_device_configuration^.list [device_id].protocol = nlc$tm_tcp_udp) OR
            (nlv$tm_device_configuration^.list [device_id].protocol = nlc$tm_tcp);
      udp_device := (nlv$tm_device_configuration^.list [device_id].protocol = nlc$tm_tcp_udp) OR
            (nlv$tm_device_configuration^.list [device_id].protocol = nlc$tm_udp);
      nlv$tm_device_configuration^.list [device_id].protocol := nlc$tm_null;
      IF tcp_device THEN
        nlv$tm_device_configuration^.tcp.count := nlv$tm_device_configuration^.tcp.count - 1;
        IF nlv$tm_device_configuration^.tcp.count >= 1 THEN
          find_tcp_device (nlv$tm_device_configuration^.tcp.identifier);
        IFEND;
      IFEND;
      IF udp_device THEN
        nlv$tm_device_configuration^.udp.count := nlv$tm_device_configuration^.udp.count - 1;
        IF nlv$tm_device_configuration^.udp.count >= 1 THEN
          find_udp_device (nlv$tm_device_configuration^.udp.identifier);
        IFEND;
      IFEND;
      osp$clear_job_signature_lock (nlv$tm_device_configuration^.lock);

{ Update nlv$tm_address_accessible.

      osp$set_job_signature_lock (nlv$tm_address_accessible.lock);
      previous_request := ^nlv$tm_address_accessible.first_request;
      WHILE previous_request^ <> NIL DO

{ If the response has already been processed (i.e., the route state is not equal to
{ nlc$tm_await_route_status) just leave it.

        request := previous_request^;
        IF request^.response_queue [device_id].route_status = nlc$tm_await_route_status THEN
          request^.response_count := request^.response_count + 1;
          request^.response_queue [device_id].route_status := nlc$tm_route_unknown;
        IFEND;

        IF request^.request_count = request^.response_count THEN
          IF request^.refresh THEN
            update_route_cache (request^);
            previous_request^ := request^.nextt;
            FREE request IN nav$network_paged_heap^;
          ELSE { NOT refresh.
            pmp$ready_task (request^.task_id, {ignore} status);
            previous_request := ^request^.nextt;
          IFEND;
        ELSE
          previous_request := ^request^.nextt;
        IFEND;
      WHILEND;
      osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);

{ Remove any subnet entries.

      nlp$get_exclusive_access (nlv$tm_subnet_list.lock);
      previous_subnet := ^nlv$tm_subnet_list.root;
      WHILE previous_subnet^ <> NIL DO
        IF device_id = previous_subnet^^.local_device THEN
          subnet := previous_subnet^;
          previous_subnet^ := subnet^.nextt;
          FREE subnet IN nav$network_paged_heap^;
        ELSE
          previous_subnet := ^previous_subnet^^.nextt;
        IFEND;
      WHILEND;
      nlp$release_exclusive_access (nlv$tm_subnet_list.lock);

    PROCEND deactivate_device;
?? OLDTITLE ??
?? NEWTITLE := 'disconnect', EJECT ??

    PROCEDURE disconnect
      (    disconnect_reason: nlt$tm_release_reason);

      VAR
        data_fragment: array [1 .. 1] of nat$data_fragment,
        message_id: nlt$bm_message_id,
        release_pdu: nlt$tm_release_request;

      nap$namve_system_error ( {Recoverable_error=} TRUE, 'TMAA disconnect', NIL);
      release_pdu.header.kind := nlc$tm_release_request;
      release_pdu.header.length := #SIZE (nlt$tm_release_request);
      release_pdu.reason := disconnect_reason;
      data_fragment [1].address := ^release_pdu;
      data_fragment [1].length := release_pdu.header.length;
      nlp$bm_create_message (data_fragment, message_id, {ignore} status);
      nlp$cc_disconnect (cl_connection, message_id, {ignore} status);
      deactivate_device (connection^.device_id);
      nlp$cl_deactivate_layer (nlc$tcpip_mgmt_access_agent, cl_connection);

    PROCEND disconnect;
?? OLDTITLE, EJECT ??

    VAR
      address_accessible_req_pdu: nlt$tm_address_accessible_req,
      address_accessible_res_pdu: ^nlt$tm_address_accessible_res,
      bytes_moved: nat$data_length,
      cache_entry: ^nlt$tm_cache_entry,
      connection: ^nlt$tm_connection,
      data_fragment: array [1 .. 1] of nat$data_fragment,
      data_length: integer,
      device_config_confirm_pdu: nlt$tm_device_config_confirm,
      device_config_request_pdu: ^nlt$tm_device_config_request,
      device_index: nlt$device_identifier,
      enable_host_routing_req_pdu: nlt$tm_enable_host_routing_req,
      error_string: ^string (80),
      hash: nlt$tm_hash_range,
      i: integer,
      index: 0 .. 255,
      layer_active: boolean,
      length: integer,
      message_id: nlt$bm_message_id,
      pdu_header: ^nlt$tm_pdu_header,
      pdu_seq: ^SEQ ( * ),
      previous_request: ^^nlt$tm_addr_access_req_entry,
      previous_subnet: ^^nlt$tm_subnet_entry,
      release_indication_pdu: nlt$tm_release_indication,
      release_request_pdu: nlt$tm_release_request,
      request: ^nlt$tm_addr_access_req_entry,
      response_entry: ^nlt$tm_addr_access_res_entry,
      route_unavailable_ind_pdu: ^nlt$tm_route_unavailable_ind,
      status: ost$status,
      subnet: ^nlt$tm_subnet_entry,
      subnet_available_ind_pdu: ^nlt$tm_subnet_available_ind,
      subnet_unavailable_ind_pdu: ^nlt$tm_subnet_unavailable_ind;

    inventory_report := 0;
    nlp$cl_get_layer_connection (nlc$tcpip_mgmt_access_agent, cl_connection, layer_active, connection);
    IF layer_active THEN
      CASE event.kind OF

?? NEWTITLE := 'nlc$cc_data_event', EJECT ??
?? NEWTITLE := 'nlc$tm_device_config_request', EJECT ??

      = nlc$cc_data_event =

        message_id := event.data.data;
        nlp$bm_get_message_length (message_id, data_length);
        IF data_length > #SIZE (nlt$tm_pdu_header) THEN
          PUSH pdu_seq: [[REP data_length OF cell]];
          data_fragment [1].address := pdu_seq;
          data_fragment [1].length := data_length;
          nlp$bm_flush_message (data_fragment, message_id, data_length, {ignore} status);
          RESET pdu_seq;
          NEXT pdu_header IN pdu_seq;
          CASE pdu_header^.kind OF
          = nlc$tm_device_config_request =
            IF connection^.state = nlc$tm_configuration_ind_wait THEN
              NEXT device_config_request_pdu IN pdu_seq;
              IF device_config_request_pdu <> NIL THEN
                device_config_confirm_pdu.header.kind := nlc$tm_device_config_confirm;
                device_config_confirm_pdu.header.length := #SIZE (nlt$tm_device_config_confirm);
                data_fragment [1].address := ^device_config_confirm_pdu;
                data_fragment [1].length := device_config_confirm_pdu.header.length;
                nlp$cc_send_data_fragments (cl_connection, data_fragment, {ignore} status);

                enable_host_routing_req_pdu.header.kind := nlc$tm_enable_host_routing_req;
                enable_host_routing_req_pdu.header.length := #SIZE (nlt$tm_enable_host_routing_req);
                data_fragment [1].address := ^enable_host_routing_req_pdu;
                data_fragment [1].length := enable_host_routing_req_pdu.header.length;
                nlp$cc_send_data_fragments (cl_connection, data_fragment, {ignore} status);
                connection^.state := nlc$tm_enable_host_routing;
                osp$set_job_signature_lock (nlv$tm_device_configuration^.lock);
                nlv$tm_device_configuration^.list [connection^.device_id].connection_id :=
                      cl_connection^.identifier;
                nlv$tm_device_configuration^.list [connection^.device_id].local_device_address :=
                      device_config_request_pdu^.host_internet_address;
                IF device_config_request_pdu^.tcp_access_enabled THEN
                  nlv$tm_device_configuration^.list [connection^.device_id].protocol := nlc$tm_tcp;
                  IF nlv$tm_device_configuration^.tcp.count = 0 THEN
                    nlv$tm_device_configuration^.tcp.identifier := connection^.device_id;
                  IFEND;
                  nlv$tm_device_configuration^.tcp.count := nlv$tm_device_configuration^.tcp.count + 1;

                  nlp$sk_tcp_device_available (connection^.device_id,
                        device_config_request_pdu^.host_internet_address.full);
                IFEND;

                IF device_config_request_pdu^.udp_access_enabled THEN
                  nlv$tm_device_configuration^.list [connection^.device_id].protocol := nlc$tm_udp;
                  IF nlv$tm_device_configuration^.udp.count = 0 THEN
                    nlv$tm_device_configuration^.udp.identifier := connection^.device_id;
                  IFEND;
                  nlv$tm_device_configuration^.udp.count := nlv$tm_device_configuration^.udp.count + 1;

                  nlp$udp_device_available (connection^.device_id,
                        device_config_request_pdu^.host_internet_address.full);
                IFEND;

                IF (device_config_request_pdu^.udp_access_enabled) AND
                      (device_config_request_pdu^.tcp_access_enabled) THEN
                  nlv$tm_device_configuration^.list [connection^.device_id].protocol := nlc$tm_tcp_udp;
                IFEND;
                osp$clear_job_signature_lock (nlv$tm_device_configuration^.lock);
              ELSE { The incoming pdu too small.
                disconnect (nlc$tm_header_indicernible);
              IFEND;
            ELSE { IF connection^.state <> nlc$tm_config_ind_wait THEN
              disconnect (nlc$tm_invalid_encoding);
            IFEND;
?? OLDTITLE ??
?? NEWTITLE := 'nlc$tm_address_accessible_res', EJECT ??

          = nlc$tm_address_accessible_res =
            CASE connection^.state OF
            = nlc$tm_enable_host_routing =
              NEXT address_accessible_res_pdu IN pdu_seq;
              IF address_accessible_res_pdu <> NIL THEN
                osp$set_job_signature_lock (nlv$tm_address_accessible.lock);
                previous_request := ^nlv$tm_address_accessible.first_request;

              /find_request/
                WHILE (previous_request^ <> NIL) AND
                      (previous_request^^.request_id <> address_accessible_res_pdu^.request_id) DO
                  previous_request := ^previous_request^^.nextt;
                WHILEND /find_request/;

                request := previous_request^;
                IF (request <> NIL) AND (request^.response_queue [connection^.device_id].route_status =
                     nlc$tm_await_route_status) THEN
                  IF nlv$log_tcpip_device_select THEN
                    PUSH error_string;
                    STRINGREP (error_string^, length, 'TCPIP: response, device', connection^.device_id,
                          ': cost', address_accessible_res_pdu^.route_cost, ', status',
                          $INTEGER(address_accessible_res_pdu^.route_status), ' for address',
                          request^.destination_address.full : #(16));
                    pmp$log_ascii (error_string^ (1, length), $pmt$ascii_logset [pmc$system_log],
                          pmc$msg_origin_program, {ignore} status);
                    status.normal := TRUE;
                  IFEND;
                  request^.response_count := request^.response_count + 1;
                  response_entry := ^request^.response_queue [connection^.device_id];

                  IF (NOT (connection^.device_id IN request^.unavailable_routes)) AND
                        (address_accessible_res_pdu^.route_status <> nlc$tm_route_unknown) THEN
                    IF address_accessible_res_pdu^.route_status = request^.
                          response_queue [request^.first_device_index].route_status THEN
                      IF address_accessible_res_pdu^.route_cost = request^.
                            response_queue [request^.first_device_index].route_cost THEN
                        response_entry^.route_status := address_accessible_res_pdu^.route_status;
                        response_entry^.route_cost := address_accessible_res_pdu^.route_cost;
                        request^.save_count := request^.save_count + 1;
                      ELSEIF address_accessible_res_pdu^.route_cost < request^.
                            response_queue [request^.first_device_index].route_cost THEN
                        response_entry^.route_cost := address_accessible_res_pdu^.route_cost;
                        response_entry^.route_status := address_accessible_res_pdu^.route_status;
                        request^.save_count := 1;
                        request^.first_device_index := connection^.device_id;
                      IFEND;

                    ELSEIF address_accessible_res_pdu^.route_status = nlc$tm_route_known THEN
                      response_entry^.route_cost := address_accessible_res_pdu^.route_cost;
                      response_entry^.route_status := nlc$tm_route_known;
                      request^.save_count := 1;
                      request^.first_device_index := connection^.device_id;
                    ELSEIF (request^.response_queue [request^.first_device_index].route_status <>
                          nlc$tm_route_known) AND (address_accessible_res_pdu^.route_status =
                          nlc$tm_route_indeterminate) THEN
                      response_entry^.route_cost := address_accessible_res_pdu^.route_cost;
                      response_entry^.route_status := nlc$tm_route_indeterminate;
                      request^.save_count := 1;
                      request^.first_device_index := connection^.device_id;
                    IFEND;
                  IFEND;
                  IF (request^.request_count = request^.response_count) OR
                        ((request^.response_queue [request^.first_device_index].route_status =
                        nlc$tm_route_known) AND (request^.ready_on_first_route_known)) THEN
                    IF request^.refresh THEN
                      update_route_cache (request^);
                      previous_request^ := request^.nextt;
                      FREE request IN nav$network_paged_heap^;
                    ELSE
                      pmp$ready_task (request^.task_id, {ignore} status);
                    IFEND;
                  IFEND;
                ELSE { Request not found.

{ If a select device request times out, the request is removed from the queue.
{ So it is possible to get to this point.

                  IF nlv$log_tcpip_device_select THEN
                    PUSH error_string;
                    STRINGREP (error_string^, length, 'TCPIP: response (late), device', connection^.device_id,
                          ': cost', address_accessible_res_pdu^.route_cost, ', status',
                          address_accessible_res_pdu^.route_status);
                    pmp$log_ascii (error_string^ (1, length), $pmt$ascii_logset [pmc$system_log],
                          pmc$msg_origin_program, {ignore} status);
                    status.normal := TRUE;
                  IFEND;

                IFEND;
                osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
              ELSE { The incoming pdu too small.
                disconnect (nlc$tm_header_indicernible);
              IFEND;
            ELSE { connection^.state <> nlc$tm_enable_host_routing
              disconnect (nlc$tm_invalid_encoding);
            CASEND;
?? OLDTITLE ??
?? NEWTITLE := 'nlc$tm_route_unavailable_ind', EJECT ??

          = nlc$tm_route_unavailable_ind =
            CASE connection^.state OF
            = nlc$tm_enable_host_routing =
              NEXT route_unavailable_ind_pdu IN pdu_seq;
              IF route_unavailable_ind_pdu <> NIL THEN
                hash := f$hash_address (route_unavailable_ind_pdu^.internet_address);
                osp$set_job_signature_lock (nlv$tm_route_cache.element_list [hash].lock);
                index := destination_address_index (route_unavailable_ind_pdu^.internet_address,
                      nlv$tm_route_cache.element_list [hash].entry_list);
                IF nlv$log_tcpip_device_select THEN
                  PUSH error_string;
                  STRINGREP (error_string^, length, 'TCPIP: response, device', connection^.device_id,
                        ': route unavail for', route_unavailable_ind_pdu^.internet_address.full : #(16));
                  pmp$log_ascii (error_string^ (1, length), $pmt$ascii_logset [pmc$system_log],
                        pmc$msg_origin_program, {ignore} status);
                  status.normal := TRUE;
                IFEND;
                IF index > 0 THEN { Address found.
                  cache_entry := ^nlv$tm_route_cache.element_list [hash].entry_list^ [index];
                  IF (cache_entry^.device_count > 0) AND
                     (NOT (connection^.device_id IN cache_entry^.unavailable_routes)) THEN
                    cache_entry^.unavailable_routes := cache_entry^.unavailable_routes +
                          $nlt$device_ids [connection^.device_id];

                  /remove_cache_entry_loop/
                    FOR i := 1 TO cache_entry^.device_count DO
                      IF cache_entry^.device_list^ [i].device_id = connection^.device_id THEN
                        IF cache_entry^.device_count > i THEN  { Compress device list.
                          cache_entry^.device_list^ [i] := cache_entry^.
                                device_list^ [cache_entry^.device_count];
                        IFEND;
                        cache_entry^.device_count := cache_entry^.device_count - 1;
                        EXIT /remove_cache_entry_loop/;
                      IFEND;
                    FOREND /remove_cache_entry_loop/;

                  IFEND;
                IFEND;
                osp$clear_job_signature_lock (nlv$tm_route_cache.element_list [hash].lock);
              ELSE { The incoming pdu too small.
                disconnect (nlc$tm_header_indicernible);
              IFEND;
            ELSE { connection^.state <> nlc$tm_enable_host_routing
              disconnect (nlc$tm_invalid_encoding);
            CASEND;
?? OLDTITLE ??
?? NEWTITLE := 'nlc$tm_subnet_available_ind', EJECT ??

          = nlc$tm_subnet_available_ind =
            IF connection^.state = nlc$tm_enable_host_routing THEN
              NEXT subnet_available_ind_pdu IN pdu_seq;
              IF subnet_available_ind_pdu <> NIL THEN
                IF (subnet_available_ind_pdu^.internet_address.class < 0) OR
                     (subnet_available_ind_pdu^.internet_address.class > 3) THEN { Invalid address.
                  nap$namve_system_error ( {Recoverable_error=} TRUE, 'Invalid TCP/IP address class TMAA.',
                        NIL);
                  RETURN;
                IFEND;

                REPEAT
                  ALLOCATE subnet IN nav$network_paged_heap^;
                  IF subnet = NIL THEN
                    syp$cycle;
                  IFEND;
                UNTIL subnet <> NIL;

                subnet^.nextt := NIL;
                subnet^.destination_address := subnet_available_ind_pdu^.internet_address;
                subnet^.local_device := connection^.device_id;
                subnet^.protocol := nlv$tm_device_configuration^.list [connection^.device_id].protocol;
                subnet^.mask := subnet_available_ind_pdu^.subnet_mask;
                subnet^.subnet_id := subnet_available_ind_pdu^.subnet_id;
                subnet^.route_cost := subnet_available_ind_pdu^.route_cost;
                CASE subnet_available_ind_pdu^.internet_address.class OF
                = 0, 1 = { Class a.
                  subnet^.network_mask.value := nlv$tm_class_a_network_mask;
                = 2 = { Class b.
                  subnet^.network_mask.value := nlv$tm_class_b_network_mask;
                = 3 = { Class c.
                  subnet^.network_mask.value := nlv$tm_class_c_network_mask;
                ELSE { Invalid address - already verified to be valid above.
                CASEND;

                nlp$get_exclusive_access (nlv$tm_subnet_list.lock);
                previous_subnet := ^nlv$tm_subnet_list.root;

              /duplicate_subnet_search/
                WHILE (previous_subnet^ <> NIL) AND NOT ((previous_subnet^^.subnet_id =
                      subnet_available_ind_pdu^.subnet_id) AND (connection^.device_id =
                      previous_subnet^^.local_device)) DO
                  previous_subnet := ^previous_subnet^^.nextt;
                WHILEND /duplicate_subnet_search/;
                IF previous_subnet^ = NIL THEN
                  previous_subnet^ := subnet;
                ELSE { Duplicate subnet found.
                  FREE subnet IN nav$network_paged_heap^;
                  nap$namve_system_error ( {Recoverable_error=} TRUE, 'Duplicate subnet found in TMAA.', NIL);
                IFEND;
                nlp$release_exclusive_access (nlv$tm_subnet_list.lock);
              ELSE { The incoming pdu too small.
                disconnect (nlc$tm_header_indicernible);
              IFEND;
            ELSE { connection^.state <> nlc$tm_enable_host_routing
              disconnect (nlc$tm_invalid_encoding);
            IFEND;
?? OLDTITLE ??
?? NEWTITLE := 'nlc$tm_subnet_unavailable_ind', EJECT ??

          = nlc$tm_subnet_unavailable_ind =
            IF connection^.state = nlc$tm_enable_host_routing THEN
              NEXT subnet_unavailable_ind_pdu IN pdu_seq;
              IF subnet_unavailable_ind_pdu <> NIL THEN
                nlp$get_exclusive_access (nlv$tm_subnet_list.lock);
                previous_subnet := ^nlv$tm_subnet_list.root;
                WHILE (previous_subnet^ <> NIL) AND ((connection^.device_id <>
                      previous_subnet^^.local_device) OR (previous_subnet^^.subnet_id <>
                      subnet_unavailable_ind_pdu^.subnet_id)) DO
                  previous_subnet := ^previous_subnet^^.nextt;
                WHILEND;
                IF previous_subnet^ <> NIL THEN
                  subnet := previous_subnet^;
                  previous_subnet^ := subnet^.nextt;
                  FREE subnet IN nav$network_paged_heap^;
                ELSE { Subnet not found.
                  PUSH error_string;
                  STRINGREP (error_string^, length, 'Subnet', subnet_unavailable_ind_pdu^.subnet_id,
                        ' NOT found for device', connection^.device_id);
                  nap$namve_system_error ( {Recoverable_error=} TRUE, error_string^ (1, length), NIL);
                IFEND;
                nlp$release_exclusive_access (nlv$tm_subnet_list.lock);
              ELSE { The incoming pdu too small.
                disconnect (nlc$tm_header_indicernible);
              IFEND;
            ELSE { connection^.state <> nlc$tm_enable_host_routing
              disconnect (nlc$tm_invalid_encoding);
            IFEND;
          ELSE { Unexpected pdu.kind.
            disconnect (nlc$tm_invalid_encoding);
          CASEND;
        ELSE { The pdu was incorrect.
          nlp$bm_release_message (message_id);
          disconnect (nlc$tm_header_indicernible);
        IFEND;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := 'nlc$cc_disconnect_event', EJECT ??
      = nlc$cc_disconnect_event =

{ Validate pdu.

{       IF event.disconnect.reason = nlc$cc_dr_normal_disconnect THEN

{ FSM #5, #21.

          message_id := event.disconnect.data;
{         nlp$bm_extract_message_prefix (^release_indication_pdu, #SIZE (nlt$tm_release_indication),
{               message_id, bytes_moved);
          nlp$bm_release_message (message_id);
{       ELSE { NOT nlc$cc_dr_normal_disconnect.

{ Log message - layer disconnect.

{       IFEND;

{ Process disconnect

        deactivate_device (connection^.device_id);
        nlp$cl_deactivate_layer (nlc$tcpip_mgmt_access_agent, cl_connection);
      ELSE { Unknown CC event kind.
        PUSH error_string;
        STRINGREP (error_string^, length, 'Invalid CC event received:', event.kind);
        nap$namve_system_error ( {Recoverable_error=} TRUE, error_string^ (1, length), NIL);
        nlp$bm_release_message (message_id);
      CASEND;
    ELSE { NOT layer active.
      PUSH error_string;
      STRINGREP (error_string^, length, 'CC event received while inactive:', event.kind);
      nap$namve_system_error ( {Recoverable_error=} TRUE, error_string^ (1, length), NIL);
      nlp$bm_release_message (message_id);
    IFEND;
  PROCEND nlp$tm_event_processor;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nlp$tm_get_device_by_name', EJECT ??
*copy nlh$tm_get_device_by_name

  PROCEDURE [XDCL, #GATE] nlp$tm_get_device_by_name
    (    local_device_name: cmt$element_name;
     VAR local_device_id: nlt$device_identifier;
     VAR status: ost$status);

    VAR
      i: integer;

    status.normal := TRUE;
    FOR i := 1 TO UPPERBOUND (nlv$configured_network_devices.network_device_list^) DO
      IF nlv$configured_network_devices.network_device_list^ [i].element = local_device_name THEN
        local_device_id := i;
        RETURN;
      IFEND;
    FOREND;
    osp$set_status_abnormal (nac$status_id, nae$tm_device_name_not_found, local_device_name, status);

  PROCEND nlp$tm_get_device_by_name;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nlp$tm_get_static_routes', EJECT ??
*copy nlh$tm_get_static_routes

  PROCEDURE [XDCL, #GATE] nlp$tm_get_static_routes
    (    static_routes: ^nlt$tm_static_route_definitions;
     VAR count: integer;
     VAR status: ost$status);

    VAR
      i: integer;

    status.normal := TRUE;
    count := 0;
    IF NOT (avp$configuration_administrator () OR avp$system_displays ()) THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active, 'configuration_administration OR system_displays',
            status);
      RETURN;
    IFEND;

    nlp$get_exclusive_access (nlv$tm_static_routing_table.lock);
    IF nlv$tm_static_routing_table.routes <> NIL THEN
      count := UPPERBOUND (nlv$tm_static_routing_table.routes^);
      IF (static_routes <> NIL) AND (UPPERBOUND (static_routes^) >= count) THEN
        FOR i := 1 TO count DO
          static_routes^ [i].local_device_name := nlv$tm_static_routing_table.routes^ [i].local_device_name;
          static_routes^ [i].local_device_id := nlv$tm_static_routing_table.routes^ [i].local_device_id;
          static_routes^ [i].destination_address := nlv$tm_static_routing_table.routes^ [i].
                destination_address.full;
          static_routes^ [i].destination_address_mask := nlv$tm_static_routing_table.routes^ [i].mask.value;
          static_routes^ [i].strict_route := nlv$tm_static_routing_table.routes^ [i].strict_route;
        FOREND;
      ELSE { IF (static_routes = NIL) OR (UPPERBOUND (static_routes^) < count) THEN
        osp$set_status_condition (nae$tm_route_list_too_small, status);
      IFEND;
    ELSE
      count := 0;
    IFEND;
    nlp$release_exclusive_access (nlv$tm_static_routing_table.lock);

  PROCEND nlp$tm_get_static_routes;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$tm_initialize', EJECT ??
*copy nlh$tm_initialize

  PROCEDURE [XDCL] nlp$tm_initialize;

    VAR
      null_connect_event_processor: nlt$cl_event_processor,
      null_sap_event_processor: nlt$cl_event_processor;

    null_connect_event_processor.layer := nlc$tcpip_mgmt_access_agent;
    null_sap_event_processor.layer := nlc$tcpip_mgmt_access_agent;

    nlp$cl_initialize_template (nlc$tcpip_mgmt_access_agent, nlc$tcpip_mgmt_access_agent,
          #SIZE (nlt$tm_connection), 0, null_sap_event_processor, nac$nil, null_connect_event_processor,
          nac$nil);
    nlp$cc_initialize_template (nlc$tcpip_mgmt_access_agent);

  PROCEND nlp$tm_initialize;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nlp$tm_install_static_routes', EJECT ??
*copy nlh$tm_install_static_routes

  PROCEDURE [XDCL, #GATE] nlp$tm_install_static_routes
    (    static_routes: ^nlt$tm_static_route_definition;
     VAR status: ost$status);

    VAR
      count: integer,
      i: integer,
      static_route: ^nlt$tm_static_route_definition,
      static_routing_table: ^nlt$tm_static_routes;

    status.normal := TRUE;
    IF NOT avp$configuration_administrator () THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active, 'configuration_administration', status);
      RETURN;
    IFEND;

    IF nlv$tm_host.name_length > 0 THEN
      count := 0;
      static_route := static_routes;
      WHILE static_route <> NIL DO
        static_route := static_route^.nextt;
        count := count + 1;
      WHILEND;

{ Allocate the new static routing table before freeing the old table.  This
{ will allow going back to the old table if the allocate for the new table fails.

      ALLOCATE static_routing_table: [1 .. count] IN nav$network_paged_heap^;
      IF static_routing_table <> NIL THEN
        nlp$get_exclusive_access (nlv$tm_static_routing_table.lock);
        IF nlv$tm_static_routing_table.routes <> NIL THEN
          FREE nlv$tm_static_routing_table.routes IN nav$network_paged_heap^;
        IFEND;
        nlv$tm_static_routing_table.routes := static_routing_table;

        static_route := static_routes;
        FOR i := 1 TO count DO
          nlv$tm_static_routing_table.routes^ [i].local_device_name := static_route^.local_device_name;
          nlv$tm_static_routing_table.routes^ [i].local_device_id := static_route^.local_device_id;
          nlv$tm_static_routing_table.routes^ [i].destination_address.full :=
                static_route^.destination_address;
          nlv$tm_static_routing_table.routes^ [i].mask.value := static_route^.destination_address_mask;
          nlv$tm_static_routing_table.routes^ [i].strict_route := static_route^.strict_route;
          static_route := static_route^.nextt;
        FOREND;
        nlp$release_exclusive_access (nlv$tm_static_routing_table.lock);
      ELSE { IF static_routing_table = NIL THEN
        osp$set_status_condition (nae$tm_resources_unavailable, status);
      IFEND;
    ELSE
      osp$set_status_condition (nae$tm_host_not_defined, status);
    IFEND;
  PROCEND nlp$tm_install_static_routes;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$tm_tcp_select_device', EJECT ??
*copy nlh$tm_tcp_select_device

  PROCEDURE [XDCL] nlp$tm_tcp_select_device
    (    destination_address: nat$sk_ip_address;
     VAR device_id: nlt$device_identifier;
     VAR local_address: nat$sk_ip_address;
     VAR status: ost$status);

    VAR
      device: nlt$tm_device_list,
      local_destination_address: nlt$tcpip_address,
      tcp_device: nlt$tm_device_information;

    status.normal := TRUE;
    tcp_device := nlv$tm_device_configuration^.tcp;
    IF (tcp_device.count = 1) AND (nlv$tm_static_routing_table.routes = NIL) THEN
      device_id := tcp_device.identifier;
      local_address := nlv$tm_device_configuration^.list [device_id].local_device_address.full;
    ELSEIF tcp_device.count > 0 THEN
      local_destination_address.full := destination_address;
      find_best_local_device (local_destination_address, tcp_device, nlc$tm_tcp, device_id, status);
      IF status.normal THEN
        local_address := nlv$tm_device_configuration^.list [device_id].local_device_address.full;
      IFEND;
    ELSE { TCP device count is zero.
      osp$set_status_condition (nae$tm_no_tcp_device_available, status);
    IFEND;

  PROCEND nlp$tm_tcp_select_device;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nlp$tm_udp_select_device', EJECT ??
*copy nlh$tm_udp_select_device

  PROCEDURE [XDCL, #GATE] nlp$tm_udp_select_device
    (    destination_address: nat$sk_ip_address;
     VAR device_id: nlt$device_identifier;
     VAR status: ost$status);


    VAR
      device: nlt$tm_device_list,
      local_destination_address: nlt$tcpip_address,
      udp_device: nlt$tm_device_information;

    status.normal := TRUE;
    udp_device := nlv$tm_device_configuration^.udp;
    IF (udp_device.count = 1) AND (nlv$tm_static_routing_table.routes = NIL) THEN
      device_id := udp_device.identifier;
    ELSEIF udp_device.count > 0 THEN
      local_destination_address.full := destination_address;
      find_best_local_device (local_destination_address, udp_device, nlc$tm_udp, device_id, status);
    ELSE { UDP device count is zero.
      osp$set_status_condition (nae$tm_no_udp_device_available, status);
    IFEND;

  PROCEND nlp$tm_udp_select_device;
?? OLDTITLE ??
?? NEWTITLE := 'await_query_responses', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to wait for the response to the routing
{   queries sent to the devices. This procedure may wait for two intervals.
{   In the first interval, all devices must respond to complete the request.
{   In the second (longer) interval, the first route known response will complete
{   the request.

  PROCEDURE await_query_responses
    (    executing_taskid: ost$global_task_id;
     VAR address_accessible_req_entry { input, output } : nlt$tm_addr_access_req_entry);

    VAR
      current_time: integer,
      expiration_time: integer,
      remaining_time: integer,
      wait_for_all_responses: boolean;

    IF address_accessible_req_entry.request_count <= address_accessible_req_entry.response_count THEN
      RETURN; { All devices have responded.
    IFEND;

    remaining_time := 1000;
    expiration_time := (#FREE_RUNNING_CLOCK (0) DIV 1000) + remaining_time;
    wait_for_all_responses := TRUE;

  /wait_loop/
    REPEAT
      pmp$wait (remaining_time, remaining_time);
      #SPOIL (address_accessible_req_entry);

      IF address_accessible_req_entry.request_count <= address_accessible_req_entry.response_count THEN
        EXIT /wait_loop/; { All devices have responded.
      IFEND;

      current_time := #FREE_RUNNING_CLOCK (0) DIV 1000;
      remaining_time := (expiration_time - current_time);
      IF (remaining_time <= 0) AND (wait_for_all_responses) THEN
        address_accessible_req_entry.ready_on_first_route_known := TRUE;
        #SPOIL (address_accessible_req_entry);
        remaining_time := 2 * (500 * (address_accessible_req_entry.request_count -
              address_accessible_req_entry.response_count));
        expiration_time := current_time + remaining_time;
        wait_for_all_responses := FALSE;
      IFEND;

      IF (NOT wait_for_all_responses) AND (address_accessible_req_entry.response_queue
             [address_accessible_req_entry.first_device_index].route_status = nlc$tm_route_known) THEN
        EXIT /wait_loop/;
      IFEND;
    UNTIL remaining_time <= 0;{/wait_loop/}

  PROCEND await_query_responses;
?? OLDTITLE ??
?? NEWTITLE := '  destination_address_index', EJECT ??

{ PURPOSE:
{   This function returns the array index of the specified destination
{   address, if found.  If the destination address is not found or the
{   destination address entry is stale an index of zero is returned.
{   In addition, the stale entry is invalidated i.e., the destination
{   address and the last used timestamp are zeroed out.

  FUNCTION [INLINE] destination_address_index
    (    destination_address: nlt$tcpip_address;
         cache_entry_list: ^nlt$tm_route_cache_entry_list): 0 .. 0ff(16);

    VAR
      current_time: integer,
      i: 0 .. 0ff(16);

    current_time := #FREE_RUNNING_CLOCK (0) DIV mics_to_mills;
    FOR i := 1 TO UPPERBOUND (cache_entry_list^) DO
      IF destination_address.full = cache_entry_list^ [i].destination_address.full THEN

        IF (cache_entry_list^ [i].last_used_timestamp + nlv$tm_route_cache.stale_release_interval) >
              current_time THEN
          destination_address_index := i;

        ELSE { Stale cache entry.
          destination_address_index := 0;
          cache_entry_list^ [i].destination_address.full := 0;
          cache_entry_list^ [i].last_used_timestamp := 0;
        IFEND;
        RETURN;
      IFEND;
    FOREND;
    destination_address_index := 0;

  FUNCEND destination_address_index;
?? OLDTITLE ??
?? NEWTITLE := '  device_available', EJECT ??

  FUNCTION [INLINE] device_available
    (    device_id: nlt$device_identifier;
         protocol: nlt$tm_protocol): boolean;

    device_available := (nlv$tm_device_configuration^.list [device_id].protocol = protocol) OR
          (nlv$tm_device_configuration^.list [device_id].protocol = nlc$tm_tcp_udp);

  FUNCEND device_available;
?? OLDTITLE ??
?? NEWTITLE := '  find_best_local_device', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to choose a device identifier with the lowest usage count
{   from the cache entry's device list from among those that support the requested protocol.
{   If a device identifier is found, the device's usage
{   count will be incremented and the cache entry's usage timestamp will be updated.  If a
{   device identifier is not found, the return parameter 'found' will be set to FALSE.
{   A cache refresh will be initiated if the refresh time has been reached.
{
{   If no cache entry is found, the static route table and the subnet and network lists will
{   be searched. If the destination address still has not been found, all active devices
{   supporting the requested protocol will be polled.

  PROCEDURE find_best_local_device
    (    destination_address: nlt$tcpip_address;
         tm_device_information: nlt$tm_device_information;
         protocol: nlt$tm_protocol;
     VAR device_id: nlt$device_identifier;
     VAR status: ost$status);

    VAR
      cache_entry_list: ^nlt$tm_route_cache_entry_list,
      cache_entry: ^nlt$tm_cache_entry,
      device: nlt$tm_device_list,
      device_index: integer,
      device_protocol: nlt$tm_protocol,
      found: boolean,
      hash: nlt$tm_hash_range,
      i: integer,
      index: 0 .. 255,
      len: integer,
      msg: string (80),
      refresh: boolean,
      unavailable_routes: nlt$device_ids,
      usage_count: nlt$tm_usage_count;

    found := FALSE;
    refresh := FALSE;
    unavailable_routes := $nlt$device_ids [];
    hash := f$hash_address (destination_address);
    cache_entry_list := nlv$tm_route_cache.element_list [hash].entry_list;
    index := destination_address_index (destination_address, cache_entry_list);
    IF index > 0 THEN { Address found.
      usage_count := nlc$tm_maximum_usage_count;
      cache_entry := ^cache_entry_list^ [index];

    /find_least_used/
      FOR i := 1 TO cache_entry^.device_count DO
        device_protocol := nlv$tm_device_configuration^.list [cache_entry^.device_list^ [i].device_id]
              .protocol;
        IF (cache_entry^.device_list^ [i].usage_count < usage_count) AND ((device_protocol = nlc$tm_tcp_udp)
              OR (device_protocol = protocol)) THEN
          usage_count := cache_entry^.device_list^ [i].usage_count;
          device_index := i;
          device_id := cache_entry^.device_list^ [i].device_id;
          found := TRUE;
        IFEND;
      FOREND /find_least_used/;

      IF found THEN
        IF cache_entry^.device_list^ [device_index].usage_count = nlc$tm_maximum_usage_count - 1 THEN

{ Reset the usage counts to zero.

          FOR i := 1 TO cache_entry^.device_count DO
            cache_entry^.device_list^ [i].usage_count := 0;
          FOREND;
        IFEND;
        cache_entry^.device_list^ [device_index].usage_count :=
              cache_entry^.device_list^ [device_index].usage_count + 1;
        cache_entry^.last_used_timestamp := #FREE_RUNNING_CLOCK (0) DIV mics_to_mills;
        IF cache_entry^.last_used_timestamp > (cache_entry^.refresh_timestamp +
              nlv$tm_route_cache.refresh_interval) THEN
          refresh := TRUE;
          cache_entry^.unavailable_routes := $nlt$device_ids [];
        ELSE { Do not refresh.
          IF NOT (device_id IN cache_entry^.unavailable_routes) THEN
            IF nlv$log_tcpip_device_select THEN
              STRINGREP (msg, len, 'TCPIP: selected device', device_id, ' for address',
                    destination_address.full : #(16));
              pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
                    {ignore} status);
              status.normal := TRUE;
            IFEND;
            RETURN;
          ELSE
            unavailable_routes := cache_entry^.unavailable_routes;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    IF nlv$log_tcpip_device_select THEN
      STRINGREP (msg, len, 'TCPIP: search parameters:', index, ' ', found, ' ', refresh, ' for address',
            destination_address.full : #(16));
      pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
            {ignore} status);
      status.normal := TRUE;
    IFEND;

    PUSH device.list: [1 .. tm_device_information.count];
    device.count := 0;
    search_static_table (destination_address, protocol, unavailable_routes, device, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF device.count > 0 THEN {device found - cache it now.
      refresh := FALSE;
    ELSEIF tm_device_information.count = 1 THEN
      device.count := 1;
      device.list^ [1].identifier := tm_device_information.identifier;
    ELSE { IF device.count = 0 THEN
      search_subnet_list (destination_address, protocol, unavailable_routes, device, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF device.count > 0 THEN {device found - cache it now.
        refresh := FALSE;
      IFEND;
    IFEND;

    IF device.count = 0 THEN
      poll_devices_for_routing_info (destination_address, unavailable_routes, protocol, refresh,
            { network_search_refresh = } FALSE, device, status);
      IF (NOT status.normal) OR (refresh) THEN
        RETURN;
      IFEND;
    ELSE
      IF nlv$log_tcpip_device_select THEN
        STRINGREP (msg, len, 'TCPIP: device count', device.count, ', refresh ', refresh, ', for address',
              destination_address.full : #(16));
        pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
              {ignore} status);
        status.normal := TRUE;
      IFEND;
    IFEND;

    IF (device.count > 0) THEN
      IF (NOT refresh) THEN
        osp$set_job_signature_lock (nlv$tm_route_cache.element_list [hash].lock);
        index := f$find_new_address_index (destination_address, cache_entry_list);
        cache_entry := ^cache_entry_list^ [index];
        cache_entry^.last_used_timestamp := #FREE_RUNNING_CLOCK (0) DIV mics_to_mills;
        cache_entry^.refresh_timestamp := cache_entry^.last_used_timestamp;

      /update_route_cache/
        BEGIN
          IF (cache_entry^.destination_address.full = destination_address.full) AND
                (cache_entry^.device_count = device.count) THEN
          /check_for_config_changes/
            BEGIN
              FOR i := 1 TO device.count DO
                IF cache_entry^.device_list^ [i].device_id <> device.list^ [i].identifier THEN
                  IF nlv$log_tcpip_device_select THEN
                    STRINGREP (msg, len, 'TCPIP: configuration changed ... reinitialize cache for address',
                          destination_address.full : #(16), i);
                    pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
                          {ignore} status);
                    status.normal := TRUE;
                  IFEND;
                  EXIT /check_for_config_changes/; {configuration has changed  ... reinitialize cache.
                IFEND;
              FOREND;
              EXIT /update_route_cache/; {no change in configuration: cache was used and is still valid.
            END /check_for_config_changes/;
          IFEND;
          cache_entry^.destination_address := destination_address;
          cache_entry^.device_count := device.count;
          cache_entry^.unavailable_routes := $nlt$device_ids[];

          FOR i := 1 TO device.count DO
            cache_entry^.device_list^ [i].device_id := device.list^ [i].identifier;
            cache_entry^.device_list^ [i].usage_count := 0;
          FOREND;
          device_id := cache_entry^.device_list^ [1].device_id;
          cache_entry^.device_list^ [1].usage_count := 1;
          found := TRUE;
        END /update_route_cache/;

        osp$clear_job_signature_lock (nlv$tm_route_cache.element_list [hash].lock);
      IFEND;
    IFEND;
    IF NOT found THEN
      IF protocol = nlc$tm_tcp THEN
        set_status_with_address (nae$tm_no_tcp_routes_known, destination_address, status);
      ELSE
        set_status_with_address (nae$tm_no_udp_routes_known, destination_address, status);
      IFEND;
    IFEND;

  PROCEND find_best_local_device;
?? OLDTITLE ??
?? NEWTITLE := '  f$find_new_address_index', EJECT ??

{ PURPOSE:
{   This function returns the array index for a new cache entry.  The
{   index returned will be the smallest index possible.  The intent is
{   to keep the entries as close as possible to the front of the queue.
{   The array is searched for a matching destination address, the first empty
{   entry or the first stale entry.  If an empty or stale entry is found the
{   remainder of the queue will be searched for a duplicate destination address
{   entry.  If a duplicate is found it will be moved to the earlier slot.
{   If neither a duplicate, an empty, nor a stale entry is found the least recently used
{   entry will be returned. If the destination address in the entry returned matches
{   the reqested destination address, then this is an existing cache entry.

  FUNCTION [INLINE] f$find_new_address_index
    (    destination_address: nlt$tcpip_address;
         cache_entry_list: ^nlt$tm_route_cache_entry_list): 1 .. 0ff(16);

    VAR
      current_time: integer,
      duplicate: boolean,
      i: 0 .. 0ff(16),
      index: 0 .. 0ff(16),
      least_recently_used: 1 .. 0ff(16);

    current_time := #FREE_RUNNING_CLOCK (0) DIV mics_to_mills;
    least_recently_used := 1;
    index := 0;

  /search/
    FOR i := 1 TO UPPERBOUND (cache_entry_list^) DO
      duplicate := destination_address.full = cache_entry_list^ [i].destination_address.full;
      IF (duplicate) OR (cache_entry_list^ [i].destination_address.full = 0) OR
            ((cache_entry_list^ [i].last_used_timestamp + nlv$tm_route_cache.stale_release_interval) <
            current_time) THEN
        IF index = 0 THEN
          index := i;
          IF duplicate THEN
            EXIT /search/;
          IFEND;
        ELSEIF duplicate THEN { replace expired entry.
          cache_entry_list^ [index] := cache_entry_list^ [i];
          cache_entry_list^ [i].destination_address.full := 0;
          cache_entry_list^ [i].last_used_timestamp := 0;
          EXIT /search/;
        IFEND;
      ELSEIF cache_entry_list^ [i].last_used_timestamp < cache_entry_list^ [least_recently_used].
            last_used_timestamp THEN
        least_recently_used := i;
      IFEND;
    FOREND /search/;
    IF index > 0 THEN
      f$find_new_address_index := index;
    ELSE
      f$find_new_address_index := least_recently_used;
    IFEND;

  FUNCEND f$find_new_address_index;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] f$hash_address', EJECT ??

{ PURPOSE:
{   The purpose of this function is to change one 32 bit address into a hash point
{   with a value of 0 to 255.

  FUNCTION [INLINE] f$hash_address
    (    address: nlt$tcpip_address): 0 .. 0ff(16);

    f$hash_address := (address.sub_part [1] + inverse_table [address.sub_part [2]] +
          inverse_table [address.sub_part [3]] + address.sub_part [4]) MOD 256;

  FUNCEND f$hash_address;
?? OLDTITLE ??
?? NEWTITLE := 'poll_devices_for_routing_info', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to send the routing queries to all the
{   configured devices and to await the responses from the devices.
{   The exception is if this is a request to refresh the routing cache;
{   in which case, the requests are issued but task does not wait for the
{   responses.
{
{ INTERFACE REQUIREMENTS:
{   The caller must not have exclusive or nonexclusive access to the
{   nlv$tm_sublist_list lock if 'refresh' is FALSE.
{
{ NOTE:
{   The parameter network_search_refresh specifies that this request is being
{   called because the destination address matched with multiple networks in
{   the subnet list.  The devices are being polled to determine the route costs
{   to be associated with the destination address.  In case no device returns with
{   a route known response continue to use the old routes cached.  This feature
{   is a result of discussions with GSA.
{   The parameter device.count will in most cases be zero.  The exception is if
{   network_search_refresh then the device.count will indicate the number of
{   network matches found in the subnet search.  In the case where the device count
{   is nonzero, only the devices on the device list will be polled.

  PROCEDURE poll_devices_for_routing_info
    (    destination_address: nlt$tcpip_address;
         unavailable_routes: nlt$device_ids;
         protocol: nlt$tm_protocol;
         refresh: boolean;
         network_search_refresh: boolean;
     VAR device { input, output } : nlt$tm_device_list;
     VAR status: ost$status);

?? NEWTITLE :='  send_routing_query', EJECT ??

   PROCEDURE send_routing_query
     (    device_id: nlt$device_identifier;
          request: array [1 .. 1] of nat$data_fragment;
          protocol: nlt$tm_protocol;
      VAR addr_access_req_entry: {input, output} nlt$tm_addr_access_req_entry;
      VAR query_count: {input, output} nlt$device_count);


    VAR
      cl_connection: ^nlt$cl_connection,
      connection: ^nlt$tm_connection,
      connection_exists: boolean,
      ignore_status: ost$status,
      layer_active: boolean,
      len: integer,
      msg: string (80);

{ Send only to protocol specific devices.

      IF (nlv$tm_device_configuration^.list [device_id].protocol = nlc$tm_tcp_udp) OR
            (nlv$tm_device_configuration^.list [device_id].protocol = protocol) THEN
        IF nlv$log_tcpip_device_select THEN
          STRINGREP (msg, len, 'TCPIP: poll device', device_id, ' for address',
                destination_address.full : #(16));
          pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
                {ignore} status);
          status.normal := TRUE;
        IFEND;
        nlp$cl_get_exclusive_via_cid (nlv$tm_device_configuration^.list [device_id].connection_id,
              connection_exists, cl_connection);
        IF connection_exists THEN
          nlp$cl_get_layer_connection (nlc$tcpip_mgmt_access_agent, cl_connection, layer_active,
                connection);
          IF (layer_active) AND (connection^.state = nlc$tm_enable_host_routing) THEN
            nlp$cc_send_data_fragments (cl_connection, data_fragment, ignore_status);
            addr_access_req_entry.response_queue [device_id].route_status :=
                  nlc$tm_await_route_status;
            query_count := query_count + 1;
{* Debug Begin
{*}       ELSE
{*}         IF NOT layer_active THEN
{*}           IF nlv$log_tcpip_device_select THEN
{*}             STRINGREP (msg, len, 'TCPIP: skip poll, layer not active, device: ', device_id,
{*}                   ' for address', destination_address.full : #(16));
{*}             pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
{*}                   {ignore} status);
{*}             status.normal := TRUE;
{*}           IFEND;
{*}         IFEND;
{*}
{*}         IF connection^.state <> nlc$tm_enable_host_routing THEN
{*}           IF nlv$log_tcpip_device_select THEN
{*}             STRINGREP (msg, len, 'TCPIP: skip poll, state <> nlc$tm_enable_host_routing, device: ',
{*}                   device_id, ' for address', destination_address.full : #(16));
{*}             pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
{*}                   {ignore} status);
{*}             status.normal := TRUE;
{*}           IFEND;
{*}         IFEND;
{* Debug End
          IFEND;
          nlp$cl_release_exclusive_access (cl_connection);
{* Debug Begin
{*}     ELSE { NOT connection_exists
{*}       IF nlv$log_tcpip_device_select THEN
{*}         STRINGREP (msg, len, 'TCPIP: skip poll, device: ', device_id, ' for address',
{*}               destination_address.full : #(16));
{*}         pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
{*}               {ignore} status);
{*}         status.normal := TRUE;
{*}       IFEND;
{* Debug End
        IFEND;
      ELSE
        IF nlv$log_tcpip_device_select THEN
          STRINGREP (msg, len, 'TCPIP: skip device', device_id, ' for address',
                destination_address.full : #(16));
          pmp$log_ascii (msg (1, len), $pmt$ascii_logset [pmc$system_log], pmc$msg_origin_program,
                {ignore} status);
          status.normal := TRUE;
        IFEND;
      IFEND;

    PROCEND send_routing_query;
 ?? OLDTITLE, EJECT ??

    VAR
      addr_accessible_request_entry: ^nlt$tm_addr_access_req_entry,
      address_accessible_task: ^nlt$tm_address_accessible_task,
      best_cost: nlt$tm_route_cost,
      best_status: nlt$tm_route_status,
      cl_connection: ^nlt$cl_connection,
      connection: ^nlt$tm_connection,
      connection_exists: boolean,
      data_fragment: array [1 .. 1] of nat$data_fragment,
      device_id: nlt$device_identifier,
      device_index: integer,
      executing_task_id: ost$global_task_id,
      i: integer,
      ignore_status: ost$status,
      message_id: nlt$bm_message_id,
      pdu: nlt$tm_address_accessible_req,
      previous_addr_access_req_entry: ^^nlt$tm_addr_access_req_entry,
      query_count: nlt$device_count,
      request_count: nlt$device_count;

    status.normal := TRUE;

    pmp$get_executing_task_gtid (executing_task_id);
    osp$set_job_signature_lock (nlv$tm_address_accessible.lock);
    addr_accessible_request_entry := nlv$tm_address_accessible.first_request;

  /check_for_destination_address/
    WHILE (addr_accessible_request_entry <> NIL) AND (addr_accessible_request_entry^.request_id <>
          destination_address.full) DO
      addr_accessible_request_entry := addr_accessible_request_entry^.nextt;
    WHILEND /check_for_destination_address/;

    IF addr_accessible_request_entry <> NIL THEN { Destination address found.
      addr_accessible_request_entry^.unavailable_routes := unavailable_routes;
      IF refresh THEN { The outstanding request will update the cache.
        osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
        RETURN;
      ELSE { NOT refresh.
        query_count := 1;

        IF addr_accessible_request_entry^.refresh THEN
          addr_accessible_request_entry^.refresh := FALSE;
          addr_accessible_request_entry^.task_id := executing_task_id;

        ELSE { Queue the task id on the outstanding request.
          ALLOCATE address_accessible_task IN nav$network_paged_heap^;
          IF address_accessible_task <> NIL THEN
            address_accessible_task^.task_id := executing_task_id;
            address_accessible_task^.nextt := addr_accessible_request_entry^.task_queue;
            addr_accessible_request_entry^.task_queue := address_accessible_task;
            addr_accessible_request_entry^.task_queue_count :=
                  addr_accessible_request_entry^.task_queue_count + 1;
          ELSE { Heap full
            osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
            osp$set_status_condition (nae$tm_resources_unavailable, status);
            RETURN;
          IFEND;
        IFEND;
        osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
      IFEND;

    ELSE { Destination address is not currently queued.
      pdu.header.kind := nlc$tm_address_accessible_req;
      pdu.header.length := #SIZE (nlt$tm_address_accessible_req);
      pdu.request_id := destination_address.full;
      pdu.internet_address := destination_address;

      data_fragment [1].address := ^pdu;
      data_fragment [1].length := pdu.header.length;

{ Poll the devices for routing information.

      ALLOCATE addr_accessible_request_entry: [1 .. nlv$tm_device_configuration^.count] IN
            nav$network_paged_heap^;

{ Initialize request queue.

      IF addr_accessible_request_entry <> NIL THEN
        addr_accessible_request_entry^.request_id := destination_address.full;
        addr_accessible_request_entry^.task_id := executing_task_id;
        addr_accessible_request_entry^.destination_address := destination_address;
        IF device.count = 0 THEN
          addr_accessible_request_entry^.request_count := UPPERBOUND (device.list^);
        ELSE { device.count > 0 THEN
          addr_accessible_request_entry^.request_count := device.count;
        IFEND;
        addr_accessible_request_entry^.response_count := 0;
        addr_accessible_request_entry^.save_count := 0;

{ The first device index is initialized to 1.  This was just an arbitrary choice.  It just needed to
{ be a value that was within the size of the response queue.  The route cost is initialized to a value
{ greater than is possible to be received over the network so the first route known or route indeterminate
{ regardless of the cost will become the first device index.  This allowed the code to not have to check
{ whether the response received was the first.

        addr_accessible_request_entry^.first_device_index := 1;
        addr_accessible_request_entry^.task_queue_count := 0;
        addr_accessible_request_entry^.ready_on_first_route_known := FALSE;
        addr_accessible_request_entry^.refresh := refresh;
        addr_accessible_request_entry^.unavailable_routes := unavailable_routes;
        addr_accessible_request_entry^.network_search_refresh := network_search_refresh;
        addr_accessible_request_entry^.task_queue := NIL;
        FOR i := 1 TO nlv$tm_device_configuration^.count DO
          addr_accessible_request_entry^.response_queue [i].route_status := nlc$tm_route_unknown;
          addr_accessible_request_entry^.response_queue [i].route_cost := nlc$tm_maximum_route_cost;
        FOREND;

        addr_accessible_request_entry^.nextt := nlv$tm_address_accessible.first_request;
        nlv$tm_address_accessible.first_request := addr_accessible_request_entry;
        osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
      ELSE { Heap full
        osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
        osp$set_status_condition (nae$tm_resources_unavailable, status);
        RETURN;
      IFEND;

{ Send the routing queries.

      IF device.count = 0 THEN
        query_count := 0;
        device_id := 1;
        request_count := UPPERBOUND (device.list^);
        WHILE (device_id <= nlv$tm_device_configuration^.count) AND (query_count < request_count) DO
          IF NOT (device_id IN unavailable_routes) THEN
            send_routing_query (device_id, data_fragment, protocol, addr_accessible_request_entry^,
                  query_count);
          IFEND;
          device_id := device_id + 1;
        WHILEND;
      ELSE { IF device.count > 0 THEN
        query_count := 0;
        request_count := device.count;
        FOR i := 1 to device.count DO
          IF NOT (device.list^[i].identifier IN unavailable_routes) THEN
            send_routing_query (device.list^[i].identifier, data_fragment, protocol,
                  addr_accessible_request_entry^, query_count);
          IFEND;
        FOREND;
      IFEND;

      IF query_count < request_count THEN
        osp$set_job_signature_lock (nlv$tm_address_accessible.lock);
        previous_addr_access_req_entry := ^nlv$tm_address_accessible.first_request;

      /find_addr_accessible_request/
        WHILE (previous_addr_access_req_entry^ <> NIL) AND
              (previous_addr_access_req_entry^^.request_id <> destination_address.full) DO
          previous_addr_access_req_entry := ^previous_addr_access_req_entry^^.nextt;
        WHILEND /find_addr_accessible_request/;

{ Note it is possible to not find the entry if the request was for a refresh because
{ the refresh requests are removed in the event processor.

        addr_accessible_request_entry := previous_addr_access_req_entry^;
        IF addr_accessible_request_entry <> NIL THEN
          addr_accessible_request_entry^.request_count := query_count;
          IF query_count <= addr_accessible_request_entry^.response_count THEN
            IF (addr_accessible_request_entry^.refresh) OR (query_count = 0) THEN
              update_route_cache (addr_accessible_request_entry^);
              previous_addr_access_req_entry^ := addr_accessible_request_entry^.nextt;
              FREE addr_accessible_request_entry IN nav$network_paged_heap^;
            IFEND;
          IFEND;
        IFEND;
        osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);
      IFEND;
    IFEND;

    IF query_count > 0 THEN
      IF refresh THEN
        RETURN;
      ELSE
        await_query_responses (executing_task_id, addr_accessible_request_entry^);
      IFEND;
    ELSE { Devices are inaccessible
      IF protocol = nlc$tm_tcp THEN
        osp$set_status_condition (nae$tm_no_tcp_device_available, status);
      ELSE { IF protocol = nlc$tm_udp THEN
        osp$set_status_condition (nae$tm_no_udp_device_available, status);
      IFEND;
    IFEND;

    osp$set_job_signature_lock (nlv$tm_address_accessible.lock);
    previous_addr_access_req_entry := ^nlv$tm_address_accessible.first_request;
    WHILE (previous_addr_access_req_entry^ <> NIL) AND (previous_addr_access_req_entry^^.request_id <>
          destination_address.full) DO
      previous_addr_access_req_entry := ^previous_addr_access_req_entry^^.nextt;
    WHILEND;
    addr_accessible_request_entry := previous_addr_access_req_entry^;

{ Fill in device_list.

    IF addr_accessible_request_entry <> NIL THEN
      IF addr_accessible_request_entry^.save_count > 0 THEN
        device_index := 1;
        best_cost := addr_accessible_request_entry^.response_queue
              [addr_accessible_request_entry^.first_device_index].route_cost;
        best_status := addr_accessible_request_entry^.response_queue
              [addr_accessible_request_entry^.first_device_index].route_status;
        FOR i := 1 TO UPPERBOUND (addr_accessible_request_entry^.response_queue) DO
          IF (addr_accessible_request_entry^.response_queue [i].route_status = best_status)
                AND (addr_accessible_request_entry^.response_queue [i].route_cost = best_cost) THEN
            device.list^ [device_index].identifier := i;
            device_index := device_index + 1;
          IFEND;
        FOREND;
      IFEND;
      device.count := addr_accessible_request_entry^.save_count;

{ Ready all tasks queued on the request.

      IF addr_accessible_request_entry^.task_queue_count > 0 THEN
        addr_accessible_request_entry^.task_queue_count := addr_accessible_request_entry^.task_queue_count -1;
        WHILE addr_accessible_request_entry^.task_queue <> NIL DO
          pmp$ready_task (addr_accessible_request_entry^.task_queue^.task_id, ignore_status);
          address_accessible_task := addr_accessible_request_entry^.task_queue;
          addr_accessible_request_entry^.task_queue := address_accessible_task^.nextt;
          FREE address_accessible_task IN nav$network_paged_heap^;
        WHILEND;
      ELSE { Last task to process the request.  Discard the request.
        previous_addr_access_req_entry^ := addr_accessible_request_entry^.nextt;
        FREE addr_accessible_request_entry IN nav$network_paged_heap^;
      IFEND;
    IFEND;
    osp$clear_job_signature_lock (nlv$tm_address_accessible.lock);

  PROCEND poll_devices_for_routing_info;
?? OLDTITLE ??
?? NEWTITLE := '  search_static_table', EJECT ??

{ PURPOSE:
{   The purpose of this request is to search the static routing table for an address
{   match.  The search will continue until either a match is found to an available device
{   or a match is found to a strict static route (which may or may not be available) or the
{   complete table has been searched.  If a match is found either the device list will be updated
{   or an abnormal status will be generated.  The abnormal status will be generated if the
{   match is for a device that is unavailable and the route has been defined as a strict
{   route.

    PROCEDURE search_static_table
      (    destination_address: nlt$tcpip_address;
           protocol: nlt$tm_protocol;
           unavailable_routes: nlt$device_ids;
       VAR device: nlt$tm_device_list;
       VAR status: ost$status);

      VAR
      i: integer;

      status.normal := TRUE;
      device.count := 0;
      nlp$get_nonexclusive_access (nlv$tm_static_routing_table.lock);
      IF nlv$tm_static_routing_table.routes <> NIL THEN

      /static_search/
        FOR i := 1 TO UPPERBOUND (nlv$tm_static_routing_table.routes^) DO

          IF (destination_address.set_value * nlv$tm_static_routing_table.routes^ [i].mask.set_value) =
                (nlv$tm_static_routing_table.routes^ [i].destination_address.set_value *
                nlv$tm_static_routing_table.routes^ [i].mask.set_value) THEN

            IF (device_available (nlv$tm_static_routing_table.routes^ [i].local_device_id, protocol)) AND
                  NOT (nlv$tm_static_routing_table.routes^ [i].local_device_id IN unavailable_routes) THEN
              device.count := 1;
              device.list^ [1].identifier := nlv$tm_static_routing_table.routes^ [i].local_device_id;
              EXIT /static_search/;
            ELSE { The device is not available or it is an unavailable route.
              IF nlv$tm_static_routing_table.routes^ [i].strict_route THEN
                set_status_with_address (nae$tm_strict_device_unavailabl, nlv$tm_static_routing_table.routes^
                      [i].destination_address, status);
                osp$append_status_parameter (osc$status_parameter_delimiter,
                      nlv$configured_network_devices.network_device_list^
                      [nlv$tm_static_routing_table.routes^ [i].local_device_id].element, status);
                EXIT /static_search/;
              IFEND;
            IFEND;
          IFEND;
        FOREND /static_search/;
      IFEND;
      nlp$release_nonexclusive_access (nlv$tm_static_routing_table.lock);
    PROCEND search_static_table;

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

{ PURPOSE:
{   The purpose of this request is to search the subnet list.  The subnet list may be
{   searched twice: once using the subnet mask and again using the network mask.
{   The network search will only be done if a match is not found with the subnet search.
{   If more than one network match is found, the devices will be polled to determine
{   which path(s) have the least cost but the current list is queued until the devices
{   respond.
{
{   On return the device list contains only those devices which can reach the destination.
{
{ NOTE:
{   There may be more than one subnet for each device.  The variable used_routes is used
{   keep track of which devices have already been saved on the device list.

    PROCEDURE search_subnet_list
      (    destination_address: nlt$tcpip_address;
           protocol: nlt$tm_protocol;
           unavailable_routes: nlt$device_ids;
       VAR device: nlt$tm_device_list;
       VAR status: ost$status);

      VAR
        route_cost: local_route_cost,
        subnet: ^nlt$tm_subnet_entry,
        used_routes: nlt$device_ids;

      status.normal := TRUE;
      route_cost := nlc$tm_maximum_route_cost + 1;
      device.count := 0;
      nlp$get_nonexclusive_access (nlv$tm_subnet_list.lock);
      subnet := nlv$tm_subnet_list.root;

{ Search the complete subnet list.

    /subnet_search/
      WHILE subnet <> NIL DO
        IF ((destination_address.set_value * subnet^.mask.set_value) =
              (subnet^.destination_address.set_value * subnet^.mask.set_value)) AND
              ((subnet^.protocol = nlc$tm_tcp_udp) OR (subnet^.protocol = protocol)) AND
              (NOT (subnet^.local_device IN unavailable_routes)) THEN
          IF (device.count = 0) OR (route_cost > subnet^.route_cost) THEN
            device.count := 1;
            device.list^ [1].identifier := subnet^.local_device;
            route_cost := subnet^.route_cost;
            used_routes := $nlt$device_ids [subnet^.local_device];
          ELSEIF (route_cost = subnet^.route_cost) AND (device.count < UPPERBOUND (device.list^)) THEN
            IF NOT (subnet^.local_device IN used_routes) THEN
              device.count := device.count + 1;
              device.list^ [device.count].identifier := subnet^.local_device;
              used_routes := used_routes + $nlt$device_ids [subnet^.local_device];
            IFEND;
          IFEND;
        IFEND;
        subnet := subnet^.nextt;
      WHILEND /subnet_search/;

      IF device.count = 0 THEN
        used_routes := $nlt$device_ids [];
        subnet := nlv$tm_subnet_list.root;

      /network_search/
        WHILE (subnet <> NIL) AND (device.count < UPPERBOUND (device.list^)) DO

{ If a match is found in the network search, the devices need to be polled to get
{ the costs associated with the routes.  It is possible to get a device unavailable
{ from all of the devices.  If that occurs leave the routes as they are.

          IF ((destination_address.set_value * subnet^.network_mask.set_value) =
                (subnet^.destination_address.set_value * subnet^.network_mask.set_value)) AND
                ((subnet^.protocol = nlc$tm_tcp_udp) OR (subnet^.protocol = protocol)) AND
                (NOT (subnet^.local_device IN unavailable_routes)) THEN
            IF NOT (subnet^.local_device IN used_routes) THEN
              device.count := device.count + 1;
              device.list^ [device.count].identifier := subnet^.local_device;
              used_routes := used_routes + $nlt$device_ids [subnet^.local_device];
            IFEND;
          IFEND;
          subnet := subnet^.nextt;
        WHILEND /network_search/;
        nlp$release_nonexclusive_access (nlv$tm_subnet_list.lock);

{ If all of the active devices can access this network, suppress the network poll and just let the
{ full device poll cover it.

        IF (device.count > 1) AND (device.count < UPPERBOUND (device.list^)) THEN
          poll_devices_for_routing_info (destination_address, unavailable_routes, protocol,
                { refresh = } FALSE, { network_search_refresh = } TRUE, device, status);
        ELSE
          device.count := 0;
        IFEND;
      ELSE
        nlp$release_nonexclusive_access (nlv$tm_subnet_list.lock);
      IFEND;
    PROCEND search_subnet_list;
?? OLDTITLE ??
?? NEWTITLE := '  set_status_with_address', EJECT ??

  PROCEDURE set_status_with_address
    (    condition: ost$status_condition_code;
         address: nlt$tcpip_address;
     VAR status: ost$status);

{ Format the address into the 255.255.255.255 format.

     VAR
       error_length: integer,
       error_string: string (20);

       STRINGREP (error_string, error_length, address.sub_part [1], '.', address.sub_part [2], '.',
             address.sub_part [3], '.', address.sub_part [4]);
       osp$set_status_abnormal (nac$status_id, condition, error_string (1, error_length), status);

  PROCEND set_status_with_address;
?? OLDTITLE ??
?? NEWTITLE := 'update_route_cache', EJECT ??

{ PURPOSE:
{   The purpose of this request is to update the host routing cache.  This procedure
{   is to be called when the last refresh route query response has been received.

    PROCEDURE update_route_cache
      (VAR request: nlt$tm_addr_access_req_entry);

      VAR
        best_cost: nlt$tm_route_cost,
        best_status: nlt$tm_route_status,
        cache_entry: ^nlt$tm_cache_entry,
        device_id: nlt$device_identifier,
        device_index: nlt$device_identifier,
        hash: nlt$tm_hash_range,
        i: integer,
        index: 0 .. 255;

      hash := f$hash_address (request.destination_address);
      osp$set_job_signature_lock (nlv$tm_route_cache.element_list [hash].lock);
      index := f$find_new_address_index (request.destination_address,
            nlv$tm_route_cache.element_list [hash].entry_list);
      cache_entry := ^nlv$tm_route_cache.element_list [hash].entry_list^ [index];

      IF request.save_count > 0 THEN
        cache_entry^.last_used_timestamp := #FREE_RUNNING_CLOCK (0) DIV mics_to_mills;
        cache_entry^.refresh_timestamp := cache_entry^.last_used_timestamp;
        best_cost := request.response_queue [request.first_device_index].route_cost;
        best_status := request.response_queue [request.first_device_index].route_status;

      /update_cache/
        BEGIN
          IF (cache_entry^.destination_address.full = request.destination_address.full) AND
                (cache_entry^.device_count = request.save_count) THEN
          /check_for_config_changes/
            BEGIN
              FOR i := 1 TO cache_entry^.device_count DO
                device_id := cache_entry^.device_list^ [i].device_id;
                IF (request.response_queue [device_id].route_status <> best_status ) OR
                      (request.response_queue [device_id].route_cost <> best_cost) THEN
                  EXIT /check_for_config_changes/; {configuration has changed  ... reinitialize cache.
                IFEND;
              FOREND;
              EXIT /update_cache/; {no change in configuration ... keep cache entry intact.
            END /check_for_config_changes/;
          IFEND;

{ Initialize cache entry

          cache_entry^.destination_address := request.destination_address;
          cache_entry^.device_count := request.save_count;
          cache_entry^.unavailable_routes := $nlt$device_ids[];
          device_index := 1;

          FOR i := 1 TO UPPERBOUND (request.response_queue) DO
            IF (request.response_queue [i].route_status = best_status ) AND
                  (request.response_queue [i].route_cost = best_cost) THEN
              cache_entry^.device_list^ [device_index].device_id := i;
              cache_entry^.device_list^ [device_index].usage_count := 0;
              device_index := device_index + 1;
            IFEND;
          FOREND;
        END /update_cache/;

      ELSEIF NOT request.network_search_refresh THEN

{ If none of the devices polled returned a route known and the request was a network search refresh
{ then leave the routes found on the network search of the subnet table cached.  This is how GSA
{ has designed the network search to work. Otherwise, invalidate destination address.

        cache_entry^.destination_address.full := 0;
        cache_entry^.last_used_timestamp := 0;
      IFEND;
      osp$clear_job_signature_lock (nlv$tm_route_cache.element_list [hash].lock);

    PROCEND update_route_cache;
?? OLDTITLE ??

MODEND nlm$tcpip_mgmt_access_agent;
