?? LEFT := 1, RIGHT := 110 ??
MODULE nam$log_me;
?? PUSH (LISTEXT:=ON) ??
*copyc clt$parameter_list
*copyc dmt$error_condition_codes
*copyc mme$condition_codes
*copyc nac$network_management_catalog
*copyc nac$reserved_saps
*copyc nae$log_me_conditions
*copyc nat$management_data_unit_syntax
*copyc nat$gt_interface
*copyc nat$gt_event
*copyc nat$network_message_priority
*copyc nlt$protocol
?? POP ??
*copyc amp$put_next
*copyc amp$return
*copyc clp$convert_string_to_file
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$include_file
*copyc clp$scan_parameter_list
*copyc fsp$close_file
*copyc fsp$open_file
*copyc nap$display_message
*copyc nap$get_file_cycle_count
*copyc nap$gt_accept_connection
*copyc nap$gt_close_sap
*copyc nap$gt_disconnect
*copyc nap$gt_open_sap
*copyc nap$gt_receive_connect_event
*copyc nap$gt_receive_connection_event
*copyc nap$gt_send_data
*copyc nap$gt_reject_connection
*copyc nlp$register_title
*copyc nlp$delete_registered_title
*copyc osp$append_status_integer
*copyc osp$i_await_activity_completion
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pfp$attach
*copyc pfp$convert_pft$path_to_fs_path
*copyc pmp$get_unique_name
{*copyc pmp$log
*copyc pmp$wait

  CONST
    index_bias = 2,
    timer_index = 1,
    sap_index = 2,
    version = 1;

  CONST
{  Disconnect Reason Codes
    protocol_version_mismatch = 1,
    unrecognizeable_pdu = 2,
    unexpected_pdu = 3,
    insufficient_resources = 4,
    service_unavailable = 5;

  CONST
{  Dependent LOG ME PDU types
    log_message = 1,
    prepare_to_disconnect = 2;

  CONST
{  Independent LOG ME PDU types
    log_domain_definition = 1;

  CONST
    nac$max_connections = 1000,
    nac$max_log_cycles = pfc$maximum_cycle_number,
    nac$max_log_message = 0ffff(16),
    nac$max_interval = 1440,
    nac$log_me_title_prefix = '$I_LOG_ME_',
    nac$log_me_title_prefix_length = 10;

  TYPE
    log_group = record
      title_registered: boolean,
      group_name: string (31),
      priority: 0 .. 0ff(16),
      directory_identifier: nat$directory_entry_identifier,
      password: nat$directory_password,
    recend;

  TYPE
    dependent_log_pdu_hdr = record
      length: 0 .. 0ff(16),
      version_number: 0 .. 0ff(16),
      pdu_type: 0 .. 0ff(16),
      time_stamp: nat$bcd_time,
      system_address: nat$system_address,
      log_message_number: 0 .. 0ffff(16),
      system_title: string (31),
    recend;

  TYPE
    independent_log_pdu_hdr = record
      length: 0 .. 0ff(16),
      pdu_type: 0 .. 0ff(16),
      version_number: 0 .. 0ff(16),
    recend;

  TYPE
    log_vdu_pairs = record
      string_hdr: nat$mdu_header,
      name: string (31),
      integer_hdr: nat$mdu_header,
      priority: 0 .. 0ff(16),
    recend;

  TYPE
    group_array = array [1 .. * ] of log_group;

  TYPE
    connection_state = (normal, message_incomplete);

  TYPE
    connection_information = record
      activity_status: ost$activity_status,
      connection_id: nat$gt_connection_id,
      data_area: array [1 .. 1] of nat$data_fragment,
      data_buffer: SEQ (REP 200(16) of cell),
      state: connection_state,
      message_length: integer,
      continuation_buffer: ^SEQ (REP 0ffff(16) of cell),
      event: nat$gt_event,
    recend;

  VAR
    active_connections: 0 .. nac$max_connections := 0,
    address:  nat$internet_address,
    connections: ^array [1 .. *] of ^connection_information,
    groups: ^group_array,
    log_file_termination_time: integer,
    log_file_id: amt$file_identifier,
    log_file_path: array [1 .. 4] of pft$name := [nac$management_family, nac$management_master_catalog,
      nac$cdcnet_subcatalog, nac$log_file],
    log_file_processing_requested: boolean,
    max_connection_index: 0 .. nac$max_connections,
    max_connections: 1 .. nac$max_connections,
    max_log_cycles: 2 .. nac$max_log_cycles,
    max_log_size: 0 .. amc$file_byte_limit,
    interval: integer,
    sap:  nat$gt_sap_identifier,
    temp_data_frag: array [1 .. 1] of nat$data_fragment,
    titles_registered: boolean,
    wait_list: ^ost$i_wait_list,
    wait_list_seq: ^SEQ ( * );

  ?? TITLE := 'exit_condition_handler', EJECT ??

  PROGRAM nap$log_me (parameter_list: clt$parameter_list;
    VAR status: ost$status);


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

      VAR
        disconnect_reason: 0 .. 0ff(16),
        local_status: ost$status,
        index: integer,
        output_data: array [1 .. 1] of nat$data_fragment;

      delete_titles;
      fsp$close_file (log_file_id, local_status);
      submit_log_processing_job;
      disconnect_reason := service_unavailable;
      output_data [1].address := ^disconnect_reason;
      output_data [1].length := #SIZE (disconnect_reason);
      FOR index := 1 TO max_connection_index DO
        IF connections^ [index] <> NIL THEN
          nap$gt_disconnect (connections^ [index]^.connection_id, output_data, local_status);
          delete_connection (index);
        IFEND;
      FOREND;
      FREE groups;
      nap$gt_close_sap (sap, local_status);

    PROCEND exit_condition_handler;
?? TITLE := 'nap$log_me', EJECT ??

    VAR
      activity_status: ost$activity_status,
      connection: ^connection_information,
      connection_index: integer,
      connect_buffer: [STATIC] SEQ (REP 20(16) of cell),
      connect_data: [STATIC] array [1 .. 1] of nat$data_fragment := [[^connect_buffer, #SIZE
        (connect_buffer)]],
      connect_event: nat$gt_connect_event,
      cycles: 0 .. pfc$maximum_cycle_number,
      data: ^SEQ ( * ),
      dep_log_pdu_hdr: ^dependent_log_pdu_hdr,
      disconnect_reason: 0 .. 0ff(16),
      input_pdu: ^SEQ ( * ),
      message_length: integer,
      new_connection: ^connection_information,
      output_data: array [1 .. 1] of nat$data_fragment,
      partial_message: ^SEQ ( * ),
      sap_id: nat$internet_sap_identifier,
      version_number: ^0 .. 0ff(16),
      wait_index: integer,
      wait_time: integer;

    process_parameters (parameter_list, groups, max_connections, max_log_cycles, max_log_size, interval,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    nap$get_file_cycle_count (log_file_path, cycles, status);
    IF (status.normal) AND (cycles > 0) THEN
       submit_log_processing_job;
    IFEND;

    titles_registered := FALSE;

    create_log_file (FALSE, log_file_id, log_file_termination_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE connections: [1 .. max_connections];
    FOR connection_index := 1 TO UPPERBOUND (connections^) DO
      connections^ [connection_index] := NIL;
    FOREND;
    max_connection_index := 0;

    osp$establish_block_exit_hndlr (^exit_condition_handler);

    nap$gt_open_sap (max_connections, nac$interact_message_priority, {reserved sap=} FALSE,
          sap, address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    register_titles (address, sap, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE wait_list_seq: [[REP (max_connections + index_bias) OF ost$i_activity]];
    RESET wait_list_seq;
    NEXT wait_list: [1 .. sap_index] IN wait_list_seq;

   IF log_file_processing_requested THEN
     wait_list^ [timer_index].activity := osc$i_await_time;
   ELSE
     wait_list^ [timer_index].activity := osc$i_null_activity;
   IFEND;
    wait_list^ [sap_index].activity := nac$i_await_activity_status;
    wait_list^ [sap_index].activity_status := ^activity_status;
    nap$gt_receive_connect_event (sap, connect_data, osc$nowait, connect_event, activity_status, status);
    IF NOT status.normal THEN
      nap$display_message (status);
      EXIT nap$log_me;
    IFEND;

  /main_loop/
    WHILE TRUE DO
      output_data [1].address := NIL;
      output_data [1].length := 0;
      IF log_file_processing_requested THEN
        wait_time := log_file_termination_time - (#free_running_clock (0) DIV 1000);
        IF wait_time >= 0 THEN
          wait_list^ [timer_index].milliseconds := wait_time;
        ELSE
          wait_list^ [timer_index].milliseconds := 0;
        IFEND;
      IFEND;
      osp$i_await_activity_completion (wait_list^, wait_index, status);
      IF status.normal THEN
        IF wait_index = timer_index THEN
          create_log_file (TRUE, log_file_id, log_file_termination_time, status);
          IF NOT status.normal THEN
            nap$display_message (status);
            EXIT /main_loop/;
          IFEND;
        ELSEIF wait_index = sap_index THEN
          IF connect_event.source.kind = osi THEN
            #unchecked_conversion (connect_event.source.osi_address.transport_sap_selector(1,
                  connect_event.source.osi_address.transport_sap_selector_length), sap_id);
          ELSE
            sap_id := connect_event.source.internet_address.sap;
          IFEND;
          IF activity_status.status.normal AND (sap_id = nac$xi_cdna_log_sap + nac$transport_sap_offset) AND
                (connect_event.data_length > 0) AND (active_connections < max_connections) THEN
            ALLOCATE new_connection;
            IF new_connection = NIL THEN
              { allocate failed }
              nap$gt_reject_connection (connect_event.connection, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
            ELSE
              new_connection^.connection_id := connect_event.connection;
              new_connection^.state := normal;
              new_connection^.data_area [1].address := ^new_connection^.data_buffer;
              new_connection^.data_area [1].length := #SIZE (new_connection^.data_buffer);
              data := ^connect_buffer;
              RESET data;
              NEXT version_number IN data;
              IF version_number^ = version THEN
                nap$gt_accept_connection (new_connection^.connection_id, output_data, NIL, status);
                IF status.normal THEN
                  add_connection_to_list (new_connection, connection_index);
                  send_domain_pdu (connection_index, FALSE);
                  temp_data_frag [1].address := new_connection^.data_area [1].address;
                  temp_data_frag [1].length := new_connection^.data_area [1].length;
                  nap$gt_receive_connection_event (new_connection^.connection_id, temp_data_frag, osc$nowait,
                        new_connection^.event, new_connection^.activity_status, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                    delete_connection (connection_index);
                  IFEND;
                ELSE
                  nap$display_message (status);
                  FREE new_connection;
                  nap$gt_reject_connection (connect_event.connection, output_data, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                  IFEND;
                IFEND;
              ELSE
                FREE new_connection;
                disconnect_reason := protocol_version_mismatch;
                output_data [1].address := ^disconnect_reason;
                output_data [1].length := #SIZE (disconnect_reason);
                nap$gt_reject_connection (connect_event.connection, output_data, status);
                IF NOT status.normal THEN
                  nap$display_message (status);
                IFEND;
              IFEND;
            IFEND;
          ELSE
            IF activity_status.status.normal THEN
{             pmp$log ('LG - CONNECTION REJECTED', status);
              IF active_connections < max_connections THEN
                disconnect_reason := unrecognizeable_pdu;
              ELSE
                disconnect_reason := insufficient_resources;
              IFEND;
              output_data [1].address := ^disconnect_reason;
              output_data [1].length := #SIZE (disconnect_reason);
              nap$gt_reject_connection (connect_event.connection, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
            IFEND;
          IFEND;
          nap$gt_receive_connect_event (sap, connect_data, osc$nowait, connect_event, activity_status,
                status);
          IF NOT status.normal THEN
            nap$display_message (status);
            EXIT nap$log_me;
          IFEND;
        ELSE
          connection_index := wait_index - index_bias;
          IF connections^ [connection_index]^.activity_status.status.normal THEN
            CASE connections^ [connection_index]^.event.kind OF
            = nac$gt_data_event =
              connection := connections^ [connection_index];
              CASE connection^.state OF
              = normal =
                data := ^connection^.data_buffer;
                RESET data;
                NEXT input_pdu: [[REP connection^.event.data.data_length OF cell]] IN data;
                RESET input_pdu;
                NEXT dep_log_pdu_hdr IN input_pdu;
                IF (dep_log_pdu_hdr <> NIL) AND (dep_log_pdu_hdr^.version_number = version) THEN
                  CASE dep_log_pdu_hdr^.pdu_type OF
                  = log_message =
                    IF connection^.event.data.end_of_message THEN
                      write_message_to_log (connection^.event.data.data_length, input_pdu, status);
                      IF NOT status.normal THEN
                        nap$display_message (status);
                        EXIT /main_loop/;
                      IFEND;
                      temp_data_frag [1].address := connection^.data_area [1].address;
                      temp_data_frag [1].length := connection^.data_area [1].length;
                      nap$gt_receive_connection_event (connection^.connection_id,
                            temp_data_frag, osc$nowait, connection^.event,
                            connection^.activity_status, status);
                      IF NOT status.normal THEN
                        nap$display_message (status);
                        delete_connection (connection_index);
                      IFEND;
                    ELSE
                      { Message is larger than default buffer. Message is moved to
                      { a allocated buffer where the entire message is built before
                      { writing it to the log file.
                      connection^.state := message_incomplete;
                      connection^.message_length := connection^.event.data.data_length;
                      ALLOCATE connection^.continuation_buffer;
                      RESET connection^.continuation_buffer;
                      NEXT partial_message: [[REP connection^.message_length OF cell]] IN
                         connection^.continuation_buffer;
                      partial_message^ := input_pdu^;
                      NEXT partial_message: [[REP nac$max_log_message - connection^.message_length OF cell]]
                           IN connection^.continuation_buffer;
                      temp_data_frag [1].address := partial_message;
                      temp_data_frag [1].length := nac$max_log_message - connection^.message_length;
                      nap$gt_receive_connection_event (connection^.connection_id, temp_data_frag,
                            osc$nowait, connection^.event,
                            connection^.activity_status, status);
                      IF NOT status.normal THEN
                        nap$display_message (status);
                        FREE connection^.continuation_buffer;
                        delete_connection (connection_index);
                      IFEND;
                    IFEND;
                  = prepare_to_disconnect =
                    nap$gt_disconnect (connections^ [connection_index]^.connection_id, output_data, status);
                    IF NOT status.normal THEN
                      nap$display_message (status);
                    IFEND;
                    delete_connection (connection_index);
                  ELSE
{                   pmp$log ('LG - LOG PDU TYPE INVALID', status);
                    disconnect_reason := unrecognizeable_pdu;
                    output_data [1].address := ^disconnect_reason;
                    output_data [1].length := #SIZE (disconnect_reason);
                    nap$gt_disconnect (connections^ [connection_index]^.connection_id, output_data, status);
                    IF NOT status.normal THEN
                      nap$display_message (status);
                    IFEND;
                    delete_connection (connection_index);
                  CASEND;
               ELSE
{                 pmp$log ('LG - INVALID LOG PDU', status);
                  disconnect_reason := unrecognizeable_pdu;
                  output_data [1].address := ^disconnect_reason;
                  output_data [1].length := #SIZE (disconnect_reason);
                  nap$gt_disconnect (connections^ [connection_index]^.connection_id, output_data, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                  IFEND;
                  delete_connection (connection_index);
                IFEND;
              = message_incomplete =
                IF connection^.event.data.end_of_message THEN
                  message_length := connection^.message_length + connection^.event.data.data_length;
                  write_message_to_log (message_length, connection^.continuation_buffer, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                    EXIT /main_loop/;
                  IFEND;
                  connection^.state := normal;
                  FREE connection^.continuation_buffer;
                  temp_data_frag [1].address := connection^.data_area [1].address;
                  temp_data_frag [1].length := connection^.data_area [1].length;
                  nap$gt_receive_connection_event (connection^.connection_id,
                        temp_data_frag, osc$nowait, connection^.event,
                        connection^.activity_status, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                    delete_connection (connection_index);
                  IFEND;
                ELSE
                  FREE connection^.continuation_buffer;
{                 pmp$log ('LG - MAX LOG MESSAGE SIZE EXCEEDED, CONNECTION TERMINATED', status);
                  disconnect_reason := insufficient_resources;
                  output_data [1].address := ^disconnect_reason;
                  output_data [1].length := #SIZE (disconnect_reason);
                  nap$gt_disconnect (connection^.connection_id, output_data, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                  IFEND;
                  delete_connection (connection_index);
                IFEND;
              ELSE
              CASEND;

            = nac$gt_expedited_data_event =
{             pmp$log ('LG - X-DATA EVENT', status);
              disconnect_reason := unexpected_pdu;
              output_data [1].address := ^disconnect_reason;
              output_data [1].length := #SIZE (disconnect_reason);
              nap$gt_disconnect (connections^ [connection_index]^.connection_id, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
              delete_connection (connection_index);

            = nac$gt_disconnect_event =
              delete_connection (connection_index);
{             pmp$log ('LG - DISCONNECT EVENT', status);
            CASEND;
          ELSE { NOT activity_status.status.normal
            nap$display_message (connections^ [connection_index]^.activity_status.status);
            disconnect_reason := service_unavailable;
            output_data [1].address := ^disconnect_reason;
            output_data [1].length := #SIZE (disconnect_reason);
            nap$gt_disconnect (connections^ [connection_index]^.connection_id, output_data, status);
            delete_connection (connection_index);
          IFEND;
        IFEND;
      ELSE
        nap$display_message (status);
        EXIT /main_loop/;
      IFEND;
    WHILEND /main_loop/;
  PROCEND nap$log_me;

?? TITLE := 'add_connection_to_list', EJECT ??

  PROCEDURE [INLINE] add_connection_to_list (connection: ^connection_information;
    VAR connection_index: integer);

    VAR
      i: integer;

    /main_loop/
    BEGIN
      FOR i := index_bias + 1 TO UPPERBOUND (wait_list^) DO
        IF wait_list^ [i].activity = osc$i_null_activity THEN
          wait_list^ [i].activity := nac$i_await_activity_status;
          wait_list^ [i].activity_status := ^connection^.activity_status;
          connections^ [i - index_bias] := connection;
          connection_index := i - index_bias;
          EXIT /main_loop/;
        IFEND;
      FOREND;

    { Last entry in wait_list is always in use.}

        RESET wait_list_seq;
        NEXT wait_list: [1 .. UPPERBOUND (wait_list^) + 1] IN wait_list_seq;
        wait_list^ [UPPERBOUND (wait_list^)].activity := nac$i_await_activity_status;
        wait_list^ [UPPERBOUND (wait_list^)].activity_status := ^connection^.activity_status;
        connections^ [UPPERBOUND (wait_list^) - index_bias] := connection;
        connection_index := UPPERBOUND (wait_list^) - index_bias;
        max_connection_index := connection_index;
    END /main_loop/;
    active_connections := active_connections + 1;

  PROCEND add_connection_to_list;

?? TITLE := 'create_log_file', EJECT ??

  PROCEDURE create_log_file (terminate_old_log: boolean;
    VAR file_id: amt$file_identifier;
    VAR termination_time: integer;
    VAR status: ost$status);

    VAR
      attachment_selections: [STATIC] array [1 .. 3] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes,
            [fsc$shorten, fsc$append, fsc$modify]], [fsc$specific_share_modes,
            [fsc$read]]], [fsc$sequential_access, TRUE], [fsc$free_behind, TRUE]],
      cycles: 0 .. pfc$maximum_cycle_number,
      file_name: clt$file,
      fs_path: fst$path,
      fs_path_size: fst$path_size,
      highest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      index: integer,
      log_processing_job_submitted: boolean,
      loop_count: 0 .. 2,
      mandated_attributes: [STATIC] array [1 .. 3] of fst$file_cycle_attribute :=
            [[fsc$file_limit, * ], [fsc$ring_attributes, *], [fsc$file_organization, amc$sequential]],
      password: [STATIC, READ] pft$password := ' ',
      titles_deleted: boolean;

    status.normal := TRUE;
    loop_count := 0;
    titles_deleted := NOT titles_registered;

    IF terminate_old_log THEN

{  Close and detach the log file.  }

      fsp$close_file (file_id, {ignore} status);
      osp$set_status_condition ( nae$log_file_terminated,  status);
      nap$display_message (status);
      status.normal := TRUE;
      submit_log_processing_job;
      log_processing_job_submitted := TRUE;
    ELSE
      log_processing_job_submitted := FALSE;
    IFEND;

{   Create new cycle of log file.

    mandated_attributes[1].file_limit := max_log_size;
    mandated_attributes[2].ring_attributes.r1 := 11;
    mandated_attributes[2].ring_attributes.r2 := 11;
    mandated_attributes[2].ring_attributes.r3 := 11;
    REPEAT
      IF NOT status.normal THEN
        nap$display_message (status);
        osp$set_status_condition ( nae$unable_to_create_log_file,  status);
        nap$display_message (status);
        IF NOT log_processing_job_submitted THEN
          submit_log_processing_job;
          log_processing_job_submitted := TRUE;
        IFEND;
        IF loop_count < 2  THEN
          loop_count := loop_count + 1;
          pmp$wait (60000, 60000);
        ELSE
          IF (NOT titles_deleted) AND (titles_registered) THEN
            delete_titles;
            nap$gt_close_sap (sap, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            titles_deleted := TRUE;
          IFEND;
          pmp$wait (60000, 60000);
        IFEND;
      IFEND;
      nap$get_file_cycle_count (log_file_path, cycles, status);
      IF status.normal THEN
        pfp$convert_pft$path_to_fs_path (log_file_path, fs_path, fs_path_size);
        IF cycles < max_log_cycles THEN
          fs_path (fs_path_size + 1, 6) := '.$NEXT';
          fs_path_size := fs_path_size + 6;
          clp$convert_string_to_file (fs_path (1, fs_path_size), file_name, status);
          IF status.normal THEN
            fsp$open_file (file_name.local_file_name, amc$record, ^attachment_selections, NIL,
                  ^mandated_attributes, NIL, NIL, file_id, status);
            termination_time := (#free_running_clock(0) DIV 1000) + interval;
          IFEND;
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$max_cycles_reached, fs_path (1, fs_path_size), status);
        IFEND;
      IFEND;
    UNTIL status.normal OR ((status.condition <> nae$max_cycles_reached) AND
         (status.condition <> pfe$cycle_overflow) AND (status.condition <> mme$volume_unavailable) AND
         (status.condition <> dme$unable_to_alloc_all_space));

    IF (titles_registered AND titles_deleted) THEN
      nap$gt_open_sap (max_connections, nac$interact_message_priority, {reserved_sap=} FALSE,
            sap, address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      register_titles (address, sap, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
  PROCEND create_log_file;

?? TITLE := 'delete_connection', EJECT ??

  PROCEDURE delete_connection (connection_index: integer);

    VAR
      i: integer;

    FREE connections^ [connection_index];
    active_connections := active_connections - 1;
    wait_list^ [connection_index + index_bias].activity := osc$i_null_activity;

    i := connection_index + index_bias;
    IF i = UPPERBOUND (wait_list^) THEN
      WHILE wait_list^ [i].activity = osc$i_null_activity DO
        i := i - 1;
      WHILEND;
      RESET wait_list_seq;
      NEXT wait_list: [1 .. i] IN wait_list_seq;
      max_connection_index := i - index_bias;
    IFEND;

  PROCEND delete_connection;

?? TITLE := 'delete_titles', EJECT ??

  PROCEDURE delete_titles;

    VAR
      i: integer,
      local_status: ost$status,
      title: string (41);

    FOR i := 1 TO UPPERBOUND (groups^) DO
      IF groups^ [i].title_registered THEN
        title := nac$log_me_title_prefix;
        title (nac$log_me_title_prefix_length + 1, * ) := groups^ [i].group_name;
        nlp$delete_registered_title (title, groups^ [i].password, groups^ [i].directory_identifier,
              local_status);
        IF local_status.normal THEN
          groups^ [i].title_registered := FALSE;
        ELSE
          nap$display_message (local_status);
        IFEND;
      IFEND;
    FOREND;
  PROCEND delete_titles;

?? TITLE := 'process_parameters', EJECT ??

  PROCEDURE process_parameters (parameter_list: clt$parameter_list;
    VAR groups: ^group_array;
    VAR max_connections: 1 .. nac$max_connections;
    VAR max_log_cycles: 2 .. nac$max_log_cycles;
    VAR max_log_size: 0 .. amc$file_byte_limit;
    VAR interval: integer;
    VAR status: ost$status);


{ PDT log_me_pdt (
{   groups,group,g: list 1..clc$max_value_sets, 1..2 of any = ((CATENET,1))
{   maximum_connections,mc:integer 1..nac$max_connections = 1000
{   maximum_log_cycles, mlc: integer 2..nac$max_log_cycles = pfc$maximum_cycl..
{ e_number
{   maximum_log_size, mls:integer 0..amc$file_byte_limit or key none = none
{   interval, i:integer 1..nac$max_interval or key none = none
{   status)

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

  VAR
    log_me_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
  ^log_me_pdt_names, ^log_me_pdt_params];

  VAR
    log_me_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 12
  ] of clt$parameter_name_descriptor := [['GROUPS', 1], ['GROUP', 1], ['G', 1]
  , ['MAXIMUM_CONNECTIONS', 2], ['MC', 2], ['MAXIMUM_LOG_CYCLES', 3], ['MLC', 3
  ], ['MAXIMUM_LOG_SIZE', 4], ['MLS', 4], ['INTERVAL', 5], ['I', 5], ['STATUS'
  , 6]];

  VAR
    log_me_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 6] of
  clt$parameter_descriptor := [

{ GROUPS GROUP G }
    [[clc$optional_with_default, ^log_me_pdt_dv1], 1, clc$max_value_sets, 1, 2
  , clc$value_range_not_allowed, [NIL, clc$any_value]],

{ MAXIMUM_CONNECTIONS MC }
    [[clc$optional_with_default, ^log_me_pdt_dv2], 1, 1, 1, 1,
  clc$value_range_not_allowed, [NIL, clc$integer_value, 1, nac$max_connections
  ]],

{ MAXIMUM_LOG_CYCLES MLC }
    [[clc$optional_with_default, ^log_me_pdt_dv3], 1, 1, 1, 1,
  clc$value_range_not_allowed, [NIL, clc$integer_value, 2, nac$max_log_cycles
  ]],

{ MAXIMUM_LOG_SIZE MLS }
    [[clc$optional_with_default, ^log_me_pdt_dv4], 1, 1, 1, 1,
  clc$value_range_not_allowed, [^log_me_pdt_kv4, clc$integer_value, 0,
  amc$file_byte_limit]],

{ INTERVAL I }
    [[clc$optional_with_default, ^log_me_pdt_dv5], 1, 1, 1, 1,
  clc$value_range_not_allowed, [^log_me_pdt_kv5, clc$integer_value, 1,
  nac$max_interval]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

  VAR
    log_me_pdt_kv4: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1
  ] of ost$name := ['NONE'];

  VAR
    log_me_pdt_kv5: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1
  ] of ost$name := ['NONE'];

  VAR
    log_me_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (13) :=
      '((CATENET,1))';

  VAR
    log_me_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (4) :=
      '1000';

  VAR
    log_me_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (24) :=
      'pfc$maximum_cycle_number';

  VAR
    log_me_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (4) :=
      'none';

  VAR
    log_me_pdt_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (4) :=
      'none';

?? FMT (FORMAT := ON) ??
?? POP ??
    VAR
      i: 0 .. clc$max_value_sets,
      set_count: 0 .. clc$max_value_sets,
      set_entry: 0 .. clc$max_value_sets,
      value: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, log_me_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('GROUPS', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    ALLOCATE groups: [1 .. set_count];

    FOR set_entry := 1 TO set_count DO
      clp$get_value ('GROUPS', set_entry, 2, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.kind = clc$integer_value) THEN
        IF (value.int.value >= nac$max_directory_priority) AND (value.int.value <=
              nac$min_directory_priority) THEN
          groups^ [set_entry].priority := value.int.value;
        ELSE
          osp$set_status_condition ( nae$invalid_log_group_priority,  status);
          osp$append_status_integer (osc$status_parameter_delimiter, value.int.value, 10, FALSE, status);
          RETURN;
        IFEND;
      ELSEIF (value.kind = clc$unknown_value) THEN
        groups^ [set_entry].priority := nac$max_directory_priority;
      ELSE
        osp$set_status_abnormal (nac$status_id, nae$invalid_log_group_priority, value.descriptor, status);
        RETURN;
      IFEND;
      clp$get_value ('GROUPS', set_entry, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (value.kind <> clc$name_value) THEN
        osp$set_status_abnormal (nac$status_id, nae$invalid_log_group_name, value.descriptor, status);
        RETURN;
      IFEND;
{ Check that group is unique.
      FOR i := 1 TO set_entry - 1 DO
        IF groups^ [i].group_name = value.name.value THEN
          osp$set_status_abnormal (nac$status_id, nae$duplicate_group, value.name.value, status);
          RETURN;
        IFEND;
      FOREND;
      groups^ [set_entry].group_name := value.name.value;
      groups^ [set_entry].title_registered := FALSE;
    FOREND;

    clp$get_value ('MAXIMUM_CONNECTIONS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    max_connections := value.int.value;

    clp$get_value ('MAXIMUM_LOG_CYCLES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    max_log_cycles := value.int.value;

    clp$get_value ('MAXIMUM_LOG_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$name_value THEN
      max_log_size := amc$file_byte_limit;
    ELSE
      max_log_size := value.int.value;
    IFEND;

    clp$get_value ('INTERVAL', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$name_value THEN
      log_file_processing_requested := FALSE;
    ELSE
      log_file_processing_requested := TRUE;
      interval := value.int.value * 60 * 1000;
    IFEND;

  PROCEND process_parameters;

?? TITLE := 'register_titles', EJECT ??

  PROCEDURE register_titles (address: nat$internet_address;
        sap: nat$gt_sap_identifier;
    VAR status: ost$status);

    VAR
      class: nat$title_class,
      distribute: boolean,
      domain: nat$title_domain,
      i: integer,
      osi_address: nat$osi_registration_address,
      service: nat$protocol,
      title: string (41),
      user_identifier: ost$name;


    status.normal := TRUE;
    osi_address.kind := nac$osi_transport_address;
    osi_address.transport_selector := sap.osi_sap_identifier;
    service := nac$cdna_transport;
    domain.kind := nac$catenet_domain;
    distribute := TRUE;
    class := nac$cdna_internal;
    user_identifier := nac$log_me_title_prefix;

    FOR i := 1 TO UPPERBOUND (groups^) DO
      title := nac$log_me_title_prefix;
      title (nac$log_me_title_prefix_length + 1, * ) := groups^ [i].group_name;
      nlp$register_title (title, osi_address, service, NIL, 0, groups^ [i].priority, domain,
            distribute, class, groups^ [i].password, user_identifier, groups^ [i].directory_identifier,
            status);
      IF status.normal THEN
        groups^ [i].title_registered := TRUE;
      ELSE
        nap$display_message (status);
      IFEND;
    FOREND;
  PROCEND register_titles;

?? TITLE := 'send_domain_pdu', EJECT ??

  PROCEDURE send_domain_pdu (connection_index: integer;
        send_to_all: boolean);

    VAR
      domain_pdu_header: independent_log_pdu_hdr,
      i: integer,
      output_data: array [1 .. 2] of nat$data_fragment,
      status: ost$status,
      vdu_pairs: ^array [1 .. * ] of log_vdu_pairs;

    domain_pdu_header.length := 2;
    domain_pdu_header.pdu_type := log_domain_definition;
    domain_pdu_header.version_number := version;
    ALLOCATE vdu_pairs: [1 .. UPPERBOUND (groups^)];
    FOR i := 1 TO UPPERBOUND (groups^) DO
      vdu_pairs^ [i].string_hdr.kind := nac$mdu_character_string;
      vdu_pairs^ [i].string_hdr.field := TRUE;
      vdu_pairs^ [i].string_hdr.length := 30;
      vdu_pairs^ [i].name := groups^ [i].group_name;
      vdu_pairs^ [i].integer_hdr.kind := nac$mdu_unsigned_integer;
      vdu_pairs^ [i].integer_hdr.field := TRUE;
      vdu_pairs^ [i].integer_hdr.length := 7;
      vdu_pairs^ [i].priority := groups^ [i].priority;
    FOREND;
    output_data [2].address := vdu_pairs;
    output_data [2].length := #SIZE (vdu_pairs^);
    output_data [1].address := ^domain_pdu_header;
    output_data [1].length := #SIZE (domain_pdu_header);
    IF send_to_all THEN
      FOR i := index_bias + 1 TO max_connection_index DO
        IF connections^ [i] <> NIL THEN
          nap$gt_send_data (connections^ [i]^.connection_id, output_data, TRUE, osc$wait,
                 connections^ [i]^.activity_status, status);
          IF NOT status.normal THEN
            nap$display_message (status);
          IFEND;
        IFEND;
      FOREND;
    ELSE
      nap$gt_send_data (connections^ [connection_index]^.connection_id, output_data, TRUE, osc$wait,
            connections^ [connection_index]^.activity_status, status);
      IF NOT status.normal THEN
        nap$display_message (status);
      IFEND;
    IFEND;
    FREE vdu_pairs;

  PROCEND send_domain_pdu;

?? TITLE := 'submit_log_processing_file', EJECT ??

  PROCEDURE submit_log_processing_job;

    VAR
      highest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      local_status: ost$status,
      master_log_processor_path: [STATIC, READ] array [1 .. 5] of pft$name :=
        [nac$management_family, nac$management_master_catalog, nac$cdcnet_subcatalog,
         nac$version_independent_catalog,nac$log_processor_job],
      name: ost$name,
      password: [STATIC, READ] pft$password := ' ',
      share: [STATIC, READ] pft$share_selections := [pfc$read],
      usage: [STATIC, READ] pft$usage_selections := [pfc$read],
      user_log_processor_path: [STATIC, READ] array [1 .. 5] of pft$name :=
        [nac$management_family, nac$management_master_catalog, nac$cdcnet_subcatalog,
         nac$site_controlled_subcatalog,nac$log_processor_job];

{  Submit a job to perform the desired processing on the log file.  }

    pmp$get_unique_name (name, local_status);
    pfp$attach (name, user_log_processor_path, highest_cycle, password, usage,
                share, pfc$no_wait, local_status);
    IF NOT local_status.normal THEN
       IF local_status.condition <> pfe$unknown_permanent_file THEN
         nap$display_message (local_status);
       IFEND;
       pmp$get_unique_name (name, local_status);
       pfp$attach (name, master_log_processor_path, highest_cycle, password, usage,
                   share, pfc$no_wait, local_status);
    IFEND;
    IF local_status.normal THEN
      clp$include_file (name, '', osc$null_name, local_status);
      IF NOT local_status.normal THEN
        nap$display_message (local_status);
        osp$set_status_condition ( nae$unable_to_process_log_file,  local_status);
        nap$display_message (local_status);
      IFEND;
      amp$return (name, {ignore} local_status);
    ELSE
      nap$display_message (local_status);
      osp$set_status_condition ( nae$unable_to_process_log_file,  local_status);
      nap$display_message (local_status);
    IFEND;
  PROCEND submit_log_processing_job;

?? TITLE := 'write_message_to_log', EJECT ??

  PROCEDURE write_message_to_log (message_length: integer;
    message: ^cell;
    VAR status: ost$status);

    VAR
      byte_address: amt$file_byte_address;

    amp$put_next (log_file_id, message, message_length, byte_address, status);
    IF NOT status.normal THEN
      CASE status.condition OF
      = ame$put_beyond_file_limit =
        create_log_file (TRUE, log_file_id, log_file_termination_time, status);
        IF status.normal THEN
          amp$put_next (log_file_id, message, message_length, byte_address, status);
        IFEND;

      = mme$volume_unavailable, dme$unable_to_alloc_all_space =
        osp$set_status_condition (nae$logging_suspended, status);
        nap$display_message (status);
        create_log_file (TRUE, log_file_id, log_file_termination_time, status);
        IF status.normal THEN
          REPEAT
            amp$put_next (log_file_id, message, message_length, byte_address, status);
            IF NOT status.normal AND ((status.condition = mme$volume_unavailable) OR
                  (status.condition = dme$unable_to_alloc_all_space)) THEN
              pmp$wait (30000, 30000);
            IFEND;
          UNTIL status.normal OR ((status.condition <> mme$volume_unavailable) AND
                (status.condition <> dme$unable_to_alloc_all_space));
        IFEND;
        IF status.normal THEN
          osp$set_status_condition (nae$logging_resumed, status);
          nap$display_message (status);
          status.normal := TRUE;
        IFEND;

      ELSE
      CASEND;
    IFEND;

  PROCEND write_message_to_log;

MODEND nam$log_me;
