?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: Interactive Facility: Executive' ??
?? NEWTITLE := 'Purpose and Design', EJECT ??
MODULE ifm$interactive_executive;

{  PURPOSE:
{    The purpose of the interactive executive is fourfold:
{      1.  To receive requests for new terminal connections to NOS/VE
{          interactive jobs.  When a new connection request is
{          received, the connecting user is briefly re-validated in
{          the NOS/VE system and a new interactive job is started if
{          the validation succeeds.  If the validation does not
{          succeed, the connection request is rejected.  If, for some
{          reason, a new job cannot be started, the connection request
{          is also rejected.
{      2.  To receive notifications of logical errors committed by
{          NOS/VE software - where the specific connection number
{          is not known.  These error notifications are recorded in
{          a NOS/VE log and are counted.  When the count of these
{          errors becomes too large, the NOS/VE interactive system
{          is stopped.
{      3.  To process commands from the NOS/VE operator facility that
{          affect the operation of the interactive system.  For
{          example, start-up the interactive system, stop the
{          interactive system, establish the "banner" message to be
{          displayed to terminals as they login, or send a broadcast
{          message to all terminals.
{      4.  To process "collector mode" input operations for
{          interactive jobs.
{
{  DESIGN:
{

?? TITLE := 'Global External Procedure Declarations', EJECT ??
*copyc IFV$MODULE_FOR_C180
*copyc TMC$WAIT_TIMES
*copyc MLP$SIGN_ON
*copyc PMT$PROGRAM_PARAMETERS
*copyc MLP$SIGN_OFF
*copyc MLP$RECEIVE_MESSAGE
*copyc MLP$SEND_MESSAGE
*copyc MLP$ADD_SENDER
*copyc PMP$WAIT
*copyc PMP$ESTABLISH_CONDITION_HANDLER
*copyc PMP$CONTINUE_TO_CAUSE
*copyc PMP$LOG
*copyc IIT$CONNECTION_DESCRIPTION
*copyc IIP$REPORT_LOGICAL_ERROR
*copyc OSP$UNPACK_STATUS_IDENTIFIER
*copyc i#move
  PROCEDURE [XREF] iip$interactive_shutdown (VAR status: ost$status);
*copyc JMT$JOB_MODE
*copyc jmp$get_attribute_defaults
*copyc OST$STATUS
*copyc IIP$ROUTE
*copyc IIP$REPORT_STATUS_ERROR
*copyc IIP$REPORT_UNHANDLED_MESSAGE
*copyc IIP$REPORT_UNHANDLED_SUPER_MSG
*copyc IIP$DPC64_TO_STRING
?? TITLE := 'Common Global Constants and Types', EJECT ??
*copyc iit$application_names_messages
?? TITLE := 'Module-Local Global Constants and Types', EJECT ??

  TYPE
    mli_condition = set of mlt$status;

?? TITLE := 'Global Variables', EJECT ??

  VAR
    mli_retry_condition: mli_condition := $mli_condition [mlc$busy_interlock,
      mlc$pool_buffer_not_avail, mlc$prior_msg_not_received,
      mlc$receive_list_full, mlc$receive_list_index_invalid],
    mli_ignore_condition: mli_condition := $mli_condition
      [mlc$dup_permits_ignored, mlc$msgs_from_sender_queued, mlc$ok,
      mlc$queued_msgs_lost, mlc$signal_failed_ignored,
      mlc$signal_to_c170_ignored],
    mli_fatal_condition: mli_condition := $mli_condition [mlc$ant_full,
      mlc$bad_c170_parameter, mlc$c170_c170_illegal, mlc$illegal_function,
      mlc$max_msgs_too_large, mlc$max_signons_this_appl,
      mlc$max_signons_this_task, mlc$message_too_long, mlc$message_truncated,
      mlc$mli_internal_error, mlc$nosve_not_up, mlc$permit_list_full,
      mlc$receiver_name_syntax_error, mlc$receiver_not_signed_on,
      mlc$sender_name_syntax_error, mlc$sender_not_permitted,
      mlc$sender_not_signed_on, mlc$system_name_no_match];

?? TITLE := 'PROCEDURE validate_login', EJECT ??

  PROCEDURE validate_login (VAR con_req: iit$input_supervisory_message;
    VAR rstatus: ost$status);

    rstatus.normal := TRUE;

  PROCEND validate_login;
?? TITLE := 'PROCEDURE reject_connection', EJECT ??

  PROCEDURE reject_connection (VAR problem_status: ost$status;
    VAR con_req: iit$input_supervisory_message);

    VAR
      con_rej: [STATIC] iit$output_supervisory_message := [[ * ,
        iic$supervisory_block, 0, iic$min_block_number, iic$60_bit_characters,
        * , 1], * , iic$sm_connection_rejected, [ * , * , * ]],
      problem_status_identifier: ost$status_identifier,
      status: ost$status,
      status_1: ost$status;

{ Set the reason for the connection reject

    osp$unpack_status_identifier (problem_status.condition, problem_status_identifier);
    IF problem_status_identifier = 'AV' THEN
      con_rej.connection_rejected.reason := iic$unspecified_reject;
    ELSEIF problem_status_identifier = 'JM' THEN
      con_rej.connection_rejected.reason := iic$unspecified_reject;
    ELSE
      con_rej.connection_rejected.reason := iic$unspecified_reject;
    IFEND;

{ Set the connection number of the connection being rejected

    con_rej.connection_rejected.connection_number := con_req.
          conreq_connection_number;

{ Send the connection reject

  /send_reject/
    REPEAT
      mlp$send_message (iic$exec_application_name,
            iic$output_supervisory_message, NIL, #LOC (con_rej), #SIZE
            (con_rej), iic$passon_application_name, status);
      IF (NOT status.normal) AND (status.condition IN mli_retry_condition) THEN
        pmp$wait (1000, 1000);
      IFEND;
    UNTIL status.normal OR NOT (status.condition IN mli_retry_condition);
    IF (NOT status.normal) AND (status.condition IN mli_fatal_condition) THEN
      iip$report_status_error (status, 'con_rej');
    IFEND;

{ Log the connection reject

{*fill in later*}

  PROCEND reject_connection;
?? TITLE := 'PROCEDURE record_login', EJECT ??

  PROCEDURE record_login (VAR con_req: iit$input_supervisory_message);

{*fill in later*}

  PROCEND record_login;
?? TITLE := 'PROCEDURE string_to_dpc64', EJECT ??

  PROCEDURE string_to_dpc64 (str: string ( * );
    VAR dpc: packed array [0 .. * ] OF iit$170_display_word;
    VAR number_of_dpc_words: integer);

    VAR
      display_code: [STATIC] array [0 .. 127] of 0 .. 3f(16) := [39, 39, 39,
        39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
        39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 45, 54, 52, 48, 43, 51, 55,
        56, 41, 42, 39, 37, 46, 38, 47, 40, 27, 28, 29, 30, 31, 32, 33, 34, 35,
        36, 0, 63, 58, 44, 59, 57, 60, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
        13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 49, 61, 50, 62,
        53, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
        39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39],
      eol_fill: integer,
      needed: integer,
      available: integer,
      leng: integer,
      dch: 0 .. 3f(16),
      i: integer,
      word: integer,
      character: integer;

{ Determine number of 6-bit end-of-line "00" characters and number of
{   characters to convert

    eol_fill := 10 - (STRLENGTH (str) MOD 10);
    IF eol_fill = 1 THEN
      eol_fill := 11;
    IFEND;
    needed := STRLENGTH (str) + eol_fill;
    available := (UPPERBOUND (dpc) + 1) * 10;
    IF available >= needed THEN
      leng := STRLENGTH (str);
    ELSE
      leng := available - eol_fill;
    IFEND;

{ Convert the string to display code

    FOR i := 1 TO leng DO
      word := (i - 1) DIV 10;
      character := (i - 1) MOD 10;
      dch := display_code [ORD (str (i))];
      IF character < 5 THEN
        dpc [word].left_character [character] := dch;
      ELSE
        dpc [word].right_character [character - 5] := dch;
      IFEND;
    FOREND;

{ Append the Z-type end-of-line

    FOR i := leng + 1 TO leng + eol_fill DO
      word := (i - 1) DIV 10;
      character := (i - 1) MOD 10;
      IF character < 5 THEN
        dpc [word].left_character [character] := 0;
      ELSE
        dpc [word].right_character [character - 5] := 0;
      IFEND;
    FOREND;

{ Return the number of display code words constructed

    number_of_dpc_words := word + 1;

  PROCEND string_to_dpc64;
?? TITLE := 'PROCEDURE start_job', EJECT ??

  PROCEDURE start_job (VAR con_req: iit$input_supervisory_message;
    VAR rstatus: ost$status);

    VAR
      status: ost$status,
      i: integer,
      job_parameters: jmt$system_job_parameters,
      user_id: ost$user_identification,
      temp_dc_array: packed array [1 .. 7] of iit$display_code,
      default_attribute_results: ^jmt$default_attribute_results,
      job_name: jmt$user_supplied_name,
      job_name_length: integer,
      user_name: ost$name,
      family_name: ost$name,
      user_name_length: integer,
      family_name_length: integer;

{ Assume abnormal status

    rstatus.normal := FALSE;

{ ROUTE the job file to the input queue

    temp_dc_array := con_req.conreq_user_name;
    iip$dpc64_to_string (temp_dc_array, 7, ' ', user_name, user_name_length);

{ If the user exists on NOS and is validated to use VEIAF
{ and the user exists on VE within a family we will accept
{ the job a "valid".  The NOS/VE default login family
{ is used only if a NULL family is returned
{ from NOS (the first character of the family is NULL), otherwise
{ the family that is passed from NOS is used.

    PUSH default_attribute_results: [1 .. 1 ];
    default_attribute_results^ [1].key := jmc$login_family;

    jmp$get_attribute_defaults (jmc$interactive_connected, default_attribute_results, status);
    IF NOT status.normal THEN
      iip$report_status_error (status, 'get_attribute_defaults');
      RETURN;
    IFEND;

    IF con_req.conreq_family_name[1] = 00(16) THEN
      user_id.family := default_attribute_results^ [1].login_family;
    ELSE
      temp_dc_array := con_req.conreq_family_name;
      iip$dpc64_to_string (temp_dc_array, 7, ' ', family_name,
        family_name_length);
      user_id.family := family_name(1,family_name_length);
    IFEND;

    user_id.user := user_name(1,user_name_length);

    job_name := user_name (1, user_name_length);

    con_req.conreq_fill6 := iic$initial_job_start;

    job_parameters.system_job_parameter_count := 20 * 8;
    i#move(^con_req, ^job_parameters.system_job_parameter, job_parameters.system_job_parameter_count);

    iip$route (user_id, job_name, job_parameters, status);
    IF NOT status.normal THEN
      iip$report_status_error (status, 'route');
      RETURN;
    IFEND;
    rstatus.normal := TRUE;

  PROCEND start_job;
?? TITLE := 'PROCEDURE initialize', EJECT ??

  PROCEDURE initialize (VAR rstatus: ost$status);

    VAR
      unique: mlt$application_name,
      status: ost$status,
      status_1: ost$status;

    rstatus.normal := TRUE;

{ Sign-on to the memory link

  /sign_on/
    REPEAT
      mlp$sign_on (iic$exec_application_name, mlc$max_queued_messages, unique,
            status);
      IF (NOT status.normal) AND (status.condition IN mli_retry_condition) THEN
        pmp$wait (1000, 1000);
      IFEND;
    UNTIL status.normal OR NOT (status.condition IN mli_retry_condition);
    IF (NOT status.normal) AND (status.condition IN mli_fatal_condition) THEN
      iip$report_status_error (status, 'signon');
      rstatus := status;
      RETURN;
    IFEND;

{ Permit any job / task to send

  /permit_all/
    REPEAT
      mlp$add_sender (iic$exec_application_name, mlc$null_name, status);
      IF (NOT status.normal) AND (status.condition IN mli_retry_condition) THEN
        pmp$wait (1000, 1000);
      IFEND;
    UNTIL status.normal OR NOT (status.condition IN mli_retry_condition);
    IF (NOT status.normal) AND (status.condition IN mli_fatal_condition) THEN
      iip$report_status_error (status, 'add_sender');
      rstatus := status;
      RETURN;
    IFEND;

{ Tell PASSON to start interactive processing

    start_passon (rstatus);

  PROCEND initialize;
?? TITLE := 'PROCEDURE start_passon', EJECT ??

  PROCEDURE start_passon (VAR status: ost$status);

    VAR
      start_interactive_msg: iit$output_supervisory_message;

    start_interactive_msg.header.pad1 := 0;
    start_interactive_msg.header.block_type := iic$supervisory_block;
    start_interactive_msg.header.address := 0;
    start_interactive_msg.header.block_number := iic$min_block_number;
    start_interactive_msg.header.character_type := iic$60_bit_characters;
    start_interactive_msg.header.fill1 := 0;
    start_interactive_msg.header.text_length := 0;
    start_interactive_msg.message_type := iic$sm_start_interactive;
    start_interactive_msg.start_interactive := 0;

    REPEAT
      pmp$wait (1000, 1000);
      mlp$send_message (iic$exec_application_name,
            iic$output_supervisory_message, NIL, #LOC (start_interactive_msg),
            #SIZE (start_interactive_msg), iic$passon_application_name,
            status);
    UNTIL status.normal OR (status.condition IN mli_ignore_condition) OR ((NOT
          (status.condition IN mli_retry_condition)) AND (status.condition <>
          mlc$receiver_not_signed_on) AND (status.condition <>
          mlc$sender_not_permitted));
    IF (NOT status.normal) AND (status.condition IN mli_fatal_condition) THEN
      iip$report_status_error (status, 'send_start_int');
      RETURN;
    IFEND;

  PROCEND start_passon;
?? TITLE := 'PROCEDURE quit', EJECT ??

  PROCEDURE quit;

    VAR
      stop_interactive_msg: [STATIC] iit$output_supervisory_message,
      status: ost$status,
      status_1: ost$status;

{ Initialize the "stop" message (until CYBIL bug fixed)

    stop_interactive_msg.header.pad1 := 0;
    stop_interactive_msg.header.block_type := iic$supervisory_block;
    stop_interactive_msg.header.address := 0;
    stop_interactive_msg.header.block_number := 0;
    stop_interactive_msg.header.character_type := iic$60_bit_characters;
    stop_interactive_msg.header.fill1 := 0;
    stop_interactive_msg.header.text_length := 0;
    stop_interactive_msg.message_type := iic$sm_stop_interactive;
    stop_interactive_msg.stop_interactive := 0;

{ Tell PASSON to stop interactive processing

  /stop_interactive/
    REPEAT
      mlp$send_message (iic$exec_application_name,
            iic$output_supervisory_message, NIL, #LOC (stop_interactive_msg),
            #SIZE (stop_interactive_msg), iic$passon_application_name, status);
      IF (NOT status.normal) AND (status.condition IN mli_retry_condition) THEN
        pmp$wait (1000, 1000);
      IFEND;
    UNTIL status.normal OR NOT (status.condition IN mli_retry_condition);
    IF (NOT status.normal) AND (status.condition IN mli_fatal_condition) THEN
      iip$report_status_error (status, 'stop_interactive');
    IFEND;

{ Sign off from the memory link

  /sign_off/
    REPEAT
      mlp$sign_off (iic$exec_application_name, status);
      IF (NOT status.normal) AND (status.condition IN mli_retry_condition) THEN
        pmp$wait (1000, 1000);
      IFEND;
    UNTIL status.normal OR NOT (status.condition IN mli_retry_condition);
    IF (NOT status.normal) AND (status.condition IN mli_fatal_condition) THEN
      iip$report_status_error (status, 'sign_off');
    IFEND;

  PROCEND quit;
?? TITLE := 'PROCEDURE handle_break', EJECT ??

  PROCEDURE handle_break (cond: pmt$condition;
        cd: ^pmt$condition_information;
        sa: ^ost$stack_frame_save_area;
    VAR ch_status: ost$status);

    VAR
      local_status: ost$status;

    iip$interactive_shutdown (local_status);
    pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
    ch_status.normal := TRUE;
  PROCEND handle_break;
?? TITLE := 'PROCEDURE ifexec', EJECT ??

  PROCEDURE [XDCL, #GATE] ifexec (params: pmt$program_parameters;
    VAR rstatus: ost$status);

    VAR
      status: ost$status,
      bxeh: pmt$established_handler,
      block_exit_cond: pmt$condition,
      state: [STATIC] (waiting_for_started, running) := waiting_for_started,
      shutdown_received: [STATIC] boolean := FALSE,
      fatal_error: [STATIC] boolean := FALSE,
      sender_application: mlt$application_name,
      input_message: iit$general_message,
      upline_super_msg: ^iit$input_supervisory_message,
      message_length: mlt$message_length,
      message_class: mlt$arbitrary_info;

{ suspend any jobs currently running

    iip$interactive_shutdown (status);


{ Establish the typed pointer to the input message area

    upline_super_msg := #LOC (input_message);

{ Initialize the interactive executive

    initialize (status);
    IF NOT status.normal THEN
      quit;
      rstatus := status;
      RETURN;
    IFEND;

    block_exit_cond.selector := pmc$condition_combination;
    block_exit_cond.combination := $pmt$condition_combination
          [pmc$block_exit_processing];
    pmp$establish_condition_handler (block_exit_cond, ^handle_break, ^bxeh,
          status);

{ Main loop: delay, check for incoming messages, process incoming
{  messages

  /main_loop/
    REPEAT

{ Delay

{ Try to receive a message

      mlp$receive_message (iic$exec_application_name, message_class, NIL, #LOC
            (input_message), message_length, #SIZE (input_message), 0,
            sender_application, status);
      IF NOT status.normal THEN
        IF status.condition IN mli_fatal_condition THEN
          iip$report_status_error (status, 'receive');
          fatal_error := TRUE;
        IFEND;
        pmp$wait (tmc$infinite_wait, tmc$infinite_wait);
        CYCLE /main_loop/;
      IFEND;

{ A message was received - process it

      IF sender_application = iic$passon_application_name THEN
        CASE state OF
        = waiting_for_started =
          IF message_class = iic$input_supervisory_message THEN
            IF upline_super_msg^.message_type = iic$sm_interactive_started THEN
              state := running;
              pmp$log ('IF: PASSON STARTED', status);
            ELSEIF upline_super_msg^.message_type = iic$sm_start_interactive
                  THEN
{ ignore it
            ELSE
              iip$report_unhandled_super_msg (upline_super_msg^);
            IFEND;
          ELSE
            iip$report_unhandled_message (#LOC (input_message), message_class,
                  sender_application, message_length);
          IFEND;
        = running =
          CASE message_class OF
          = iic$input_supervisory_message =
            IF upline_super_msg^.message_type = iic$sm_connection_request THEN
              validate_login (upline_super_msg^, status);
              IF NOT status.normal THEN
                reject_connection (status, upline_super_msg^);
              ELSE
                start_job (upline_super_msg^, status);
                IF NOT status.normal THEN
                  reject_connection (status, upline_super_msg^);
                ELSE
                  record_login (upline_super_msg^);
                IFEND;
              IFEND;
            ELSEIF upline_super_msg^.message_type = iic$sm_logical_error THEN
              iip$report_logical_error (upline_super_msg^);
            ELSEIF upline_super_msg^.message_type = iic$sm_shutdown THEN
              IF upline_super_msg^.shutdown.immediate THEN
                shutdown_received := TRUE;
              IFEND;
            ELSEIF upline_super_msg^.message_type = iic$sm_start_interactive
                  THEN

{ react to passon restart

              pmp$log ('IF: PASSON RESTART', status);
              iip$interactive_shutdown (status);
              start_passon (status);
              IF NOT status.normal THEN
                fatal_error := TRUE;
              IFEND;
            ELSEIF upline_super_msg^.message_type = iic$sm_interactive_started
                  THEN
{ ignore it
              pmp$log ('IF: PASSON RESTART COMPLETE', status);
            ELSE
              iip$report_unhandled_super_msg (upline_super_msg^);
            IFEND;
          ELSE
            iip$report_unhandled_message (#LOC (input_message), message_class,
                  sender_application, message_length);
          CASEND;
        ELSE
        CASEND;
      ELSE
        iip$report_unhandled_message (#LOC (input_message), message_class,
              sender_application, message_length);
      IFEND;
    UNTIL shutdown_received OR fatal_error;

{ End the interactive executive

    IF fatal_error THEN
      rstatus := status;
    ELSE
      rstatus.normal := TRUE;
    IFEND;
    quit;

  PROCEND ifexec;
MODEND
