$TITLE( 'REXECSRV - iRMX REMOTE COMMAND EXECUTION SERVER' )

$OPTIMIZE(3) DEBUG PAGELENGTH(60) PAGEWIDTH(132)
$COMPACT( EXPORTS OUTPUT_TASK, MAIN_TASK )
$LARGE( CICO EXPORTS CI, CO, CSTS )

rexec_server: DO;

/****************************************************************************/
/*                                                                          */
/*  MODULE NAME:    rexec_server (REXECSRV.PLM)                             */
/*                                                                          */
/*  LAST UPDATE:    January 16, 1992 [19:58:00]                             */
/*                                                                          */
/*  AUTHOR:         N. Scott Pearson, Cableshare Inc.                       */
/*                                                                          */
/*  DESCRIPTION:    This module provides the server portion of the  remote  */
/*                  command  execution  facility. It is started as a back-  */
/*      ground job on the processor  board  which  is  to  service  remote  */
/*      command execution requests from other processors.                   */
/*                                                                          */
/****************************************************************************/

$INCLUDE( :SD:INC/PLM286/LTKSEL.LIT )
$INCLUDE( :SD:INC/PLM286/PLM286.LIT )
$INCLUDE( :SD:INC/PLM286/RMXII.LIT )
$INCLUDE( :SD:INC/PLM286/RMXII.EXT )

$INCLUDE( REXEC.LIT )

/****************************************************************************/
/* CO - External subroutine which outputs a character to the SDM console.   */
/****************************************************************************/

co: PROCEDURE( ch ) EXTERNAL;
    DECLARE ch BYTE;
END co;

/****************************************************************************/
/* COS - Subroutine which puts an ASCIIZ string to the SDM console.         */
/****************************************************************************/

cos: PROCEDURE( str_ptr );

    DECLARE index WORD, str_ptr POINTER, str BASED str_ptr (1) BYTE;

    index = 0;

    DO WHILE ( str(index) <> 0 );
        CALL CO( str(index) );
        index = index + 1;
    END;

END cos;

/****************************************************************************/
/* COD - Subroutine which outputs the contents of a WORD, in decimal, to    */
/* the SDM console.                                                         */
/****************************************************************************/

cod: PROCEDURE( value );

    DECLARE value WORD, index BYTE, array (6) BYTE;

    array(0) = value / 10000 + '0';
    array(1) = (value / 1000) MOD 10 + '0';
    array(2) = (value / 100) MOD 10 + '0';
    array(3) = (value / 10) MOD 10 + '0';
    array(4) = value MOD 10 + '0';
    array(5) = 0;

    index = 0;

    DO WHILE ( ( index < 4 ) AND ( array(index) = '0' ) );
        index = index + 1;
    END;

    CALL cos( @array(index) );

END cod;

/****************************************************************************/
/* COH - Subroutine which outputs the contents of a WORD, in hexadecimal,   */
/* to the SDM console.                                                      */
/****************************************************************************/

coh: PROCEDURE( value );

    DECLARE value WORD, xlate (16) BYTE DATA( '0123456789ABCDEF' );

    CALL CO( xlate(SHR( HIGH(value), 4 )) );
    CALL CO( xlate(HIGH(value) AND 0FH) );
    CALL CO( xlate(SHR( LOW(value), 4 )) );
    CALL CO( xlate(LOW(value) AND 0FH) );

END coh;

/****************************************************************************/
/* ABORT - Aborts the server with appropriate messages                      */
/****************************************************************************/

abort: PROCEDURE( instance, ccode );

    DECLARE ( instance, ccode ) WORD;

    CALL cos( @( CR, LF, LF, 'REMOTE COMMAND EXECUTION SERVER ABORTING!!!', 0 ) );
    CALL cos( @( CR, LF, LF, '    CODE LOCATION:  ', 0 ) );
    CALL cod( instance );
    CALL cos( @( CR, LF,     '    CONDITION CODE: ', 0 ) );
    CALL coh( ccode );
    CALL cos( @( CR, LF, LF, 0 ) );

    CAUSE$INTERRUPT( 3 );

END abort;

/****************************************************************************/
/* Global Variables                                                         */
/****************************************************************************/

DECLARE requestors_socket       DWORD;
DECLARE request_port_tkn        TOKEN;
DECLARE request_pool_tkn        TOKEN;
DECLARE bit_bucket_tkn          TOKEN;
DECLARE stream_file_tkn         TOKEN;
DECLARE command_tkn             TOKEN;
DECLARE excep_attribs           EXCEP$HANDLER$DESCR;

/****************************************************************************/
/* OUTPUT_TASK - Is the mainline for our output support task. This task     */
/* reads, via the special stream file, all output generated by user         */
/* commands and delivers this output back to the rexec utility from which   */
/* the command came.                                                        */
/****************************************************************************/

output_task: PROCEDURE PUBLIC;

    DECLARE status                  WORD;
    DECLARE char                    BYTE;
    DECLARE output_rq               OUTPUT_REQUEST_DESCR;
    DECLARE dummy              (20) BYTE;
    DECLARE count                   WORD;
    DECLARE trans_id                WORD;
    DECLARE remote_tkn              TOKEN;

    CALL RQ$SET$EXCEPTION$HANDLER( @excep_attribs, @status );

    remote_tkn = RQ$S$ATTACH$FILE( @( 8, ':REMOTE:' ), @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 1, status );

    CALL RQ$S$OPEN( remote_tkn, OPEN$READ$SHARE$RW, 2, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 1, status );

    output_rq.opcode = OUTPUT_REQUEST;
    output_rq.length = 0;

    DO FOREVER;

        count = RQ$S$READ$MOVE( remote_tkn, @char, 1, @status );

        IF ( ( status <> E$OK ) OR ( count <> 1 ) ) THEN
            CALL abort( 2, status );

        output_rq.info(output_rq.length) = char;
        output_rq.length = output_rq.length + 1;

        IF ( ( output_rq.length = 255 ) OR ( char = LF ) ) THEN DO;

            trans_id = RQ$SEND( request_port_tkn, requestors_socket, @dummy,
                @output_rq, SIZE(output_rq), SINGLE$BUFFER + SYNC$TRANSMISSION, @status );

            /* ignore status, dispatcher may have been destroyed */
            /* (all we can do is try to give them the output) */

            output_rq.length = 0;
        END;
    END;

END output_task;

/****************************************************************************/
/* MAIN_TASK - Performs the initialisation of the server and the processing */
/* of remote command execution requests.                                    */
/****************************************************************************/

main_task: PROCEDURE PUBLIC;

    DECLARE buffer_tkn              TOKEN;
    DECLARE buffer_ptr              POINTER;
    DECLARE request                 BASED buffer_ptr REXEC_REQUEST_DESCR;
    DECLARE response                BASED buffer_ptr REXEC_RESPONSE_DESCR;
    DECLARE port_attribs            DATA$PORT$CREATE$DESCR;
    DECLARE msg_attribs             MSG$RECEIVED$DESCR;
    DECLARE user_tkn                TOKEN;
    DECLARE directory_tkn           TOKEN;
    DECLARE trans_id                WORD;
    DECLARE dummy              (20) BYTE;
    DECLARE output_task_tkn         TOKEN;
    DECLARE status                  WORD;
    DECLARE aux_status              WORD;
    DECLARE instance                WORD;
    DECLARE index                   WORD;

    /************************************************************************/
    /* Ensure that we are not inadvertently deleted.                        */
    /************************************************************************/

    excep_attribs.excep$handler$ptr = NIL;
    excep_attribs.excep$mode = NO$EXCEPTIONS;
    
    CALL RQ$SET$EXCEPTION$HANDLER( @excep_attribs, @status );

    /************************************************************************/
    /* Create the port we use to receive requests and associate a buffer    */
    /* pool - and buffers - with it.                                        */
    /************************************************************************/

    port_attribs.port$id = 900H;
    port_attribs.type = DATA$PORT;
    port_attribs.reserved = 0;
    port_attribs.flags = FIFO$QUEUING$PORT + NO$BUFFER$CHAINING;

    request_port_tkn = RQ$CREATE$PORT( 40, @port_attribs, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 4, status );

    request_pool_tkn = RQ$CREATE$BUFFER$POOL( 40, NO$BUFFER$CHAINING, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 5, status );

    DO index = 1 TO 40;
        buffer_tkn = RQ$CREATE$SEGMENT( SIZE(request), @status );

        IF ( status <> E$OK ) THEN
            CALL abort( 6, status );

        CALL RQ$RELEASE$BUFFER( request_pool_tkn, buffer_tkn, SINGLE$BUFFER, @status );

        IF ( status <> E$OK ) THEN
            CALL abort( 7, status );
    END;

    CALL RQ$ATTACH$BUFFER$POOL( request_pool_tkn, request_port_tkn, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 8, status );

    /************************************************************************/
    /* Create the command connection we will use to request the execution   */
    /* of user commands. To do this, we must first create connections to    */
    /* the "files" we will provide for console input and output of these    */
    /* commands. The CI connection is to the bit bucket. Using this ensures */
    /* that, if the command requests input, they are informed that there is */
    /* none. The CO connection is to a stream file. This stream file is     */
    /* used to capture the command's output so that we can deliver it to    */
    /* the rexec utility which requested the command's execution.           */
    /************************************************************************/

    bit_bucket_tkn = RQ$S$ATTACH$FILE( @( 4, ':BB:' ), @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 9, status );

    CALL RQ$S$OPEN( bit_bucket_tkn, OPEN$READ$SHARE$RW, 2, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 9, status );

    stream_file_tkn = RQ$S$CREATE$FILE( @( 8, ':STREAM:' ), @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 10, status );

    CALL RQ$S$CATALOG$CONNECTION( THIS$JOB, stream_file_tkn, @( 8, ':REMOTE:' ), @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 10, status );

    stream_file_tkn = RQ$S$ATTACH$FILE( @( 8, ':REMOTE:' ), @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 10, status );

    CALL RQ$S$OPEN( stream_file_tkn, OPEN$WRITE$SHARE$RW, 2, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 10, status );

    command_tkn = RQ$C$CREATE$COMMAND$CONNECTION( bit_bucket_tkn, stream_file_tkn, 0, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 11, status );

    /************************************************************************/
    /* Create our output task                                               */
    /************************************************************************/

    output_task_tkn = RQ$CREATE$TASK( MAX$JOB$PRIORITY, @output_task, SELECTOR$OF(@command_tkn),
        NIL, 800H, NO$NPX$UTILIZATION, @status );

    IF ( status <> E$OK ) THEN
        CALL abort( 12, status );

    /************************************************************************/
    /* main processing loop                                                 */
    /************************************************************************/

    DO FOREVER;

        /********************************************************************/
        /* Obtain the next request                                          */
        /********************************************************************/

        buffer_ptr = RQ$RECEIVE( request_port_tkn, WAIT$INDEFINITELY, @msg_attribs, @status );

        IF ( status <> E$OK ) THEN
            CALL abort( 13, status );

        IF ( msg_attribs.status <> E$OK ) THEN
            CALL abort( 14, status );

        IF ( msg_attribs.flags <> (MSG$IN$SINGLE$BUFFER + TRANSACTIONLESS$MSG) ) THEN
            CALL abort( 15, 0FFFFH );

        IF ( request.opcode <> REXEC_REQUEST ) THEN DO;
            instance = 1;
            status = E$CONTEXT;
            GOTO return_status_1;
        END;

        /********************************************************************/
        /* Become the appropriate user                                      */
        /********************************************************************/

        user_tkn = RQ$CREATE$USER( @request.id_array_size, @status );

        IF ( status <> E$OK ) THEN DO;
            instance = 2;
            GOTO return_status_1;
        END;

        CALL RQ$SET$DEFAULT$USER( THIS$JOB, user_tkn, @status );

        IF ( status <> E$OK ) THEN DO;
            instance = 3;
            GOTO return_status_2;
        END;

        /********************************************************************/
        /* Move to the proper current directory                             */
        /********************************************************************/

        directory_tkn = RQ$S$ATTACH$FILE( @request.directory, @status );

        IF ( status <> E$OK ) THEN DO;
            instance = 4;
            GOTO return_status_2;
        END;

        CALL RQ$SET$DEFAULT$PREFIX( THIS$JOB, directory_tkn, @status );

        IF ( status <> E$OK ) THEN DO;
            instance = 5;
            GOTO return_status_3;
        END;

        /********************************************************************/
        /* Execute the command                                              */
        /********************************************************************/

        requestors_socket = msg_attribs.remote$socket;
        instance = 0;

        CALL RQ$C$SEND$COMMAND( command_tkn, @request.command, @aux_status, @status );

        IF ( status = E$OK ) THEN
            status = aux_status;

        CALL RQ$SLEEP( 100, @status );

        /********************************************************************/
        /* Return the status of the command execution attempt to the caller */
        /********************************************************************/

        return_status_3:

            CALL RQ$S$DELETE$CONNECTION( directory_tkn, @aux_status );

            IF ( aux_status <> E$OK ) THEN
                CALL abort( 16, aux_status );

        return_status_2:

            CALL RQ$DELETE$USER( user_tkn, @aux_status );

            IF ( aux_status <> E$OK ) THEN
                CALL abort( 17, aux_status );

        return_status_1:

            response.opcode   = REXEC_RESPONSE;
            response.status   = status;
            response.instance = instance;

            trans_id = RQ$SEND( request_port_tkn, requestors_socket, @dummy,
                buffer_ptr, SIZE(response), SINGLE$BUFFER + SYNC$TRANSMISSION, @status );

            /* ignore status, dispatcher may have been destroyed */
            /* (all we can do is try to give them the output) */

            CALL RQ$RELEASE$BUFFER( request_pool_tkn, SELECTOR$OF(buffer_ptr), SINGLE$BUFFER, @status );

            IF ( status <> E$OK ) THEN
                CALL abort( 19, status );
    END;

END main_task;

CALL main_task;

END rexec_server;

