Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/mxdata.bli
There are 7 other files named mxdata.bli in the archive. Click here to see a list.
MODULE mxdata =
BEGIN

!
!			  COPYRIGHT (c) 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY: Decmail/MS - Message eXchange Node/Domain Database
!
! ABSTRACT: This module contains the data structures and routines for
!   initializing and maintaining MX's Node/Domain Database.
!
!
! ENVIRONMENT: TOPS-10, TOPS-20
!
! AUTHOR: Richard B. Waddington, CREATION DATE:
!
! MODIFIED BY:
!
!   MX: VERSION 1.0
! 01	-
!--
!
! INCLUDE FILES:
!
%IF %SWITCHES(TOPS20) %THEN
    LIBRARY 'monsym';
    UNDECLARE time;
    LIBRARY 'mxjlnk';
%FI
LIBRARY 'mxnlib';       ! Our version of NML's utility library
LIBRARY 'mxlib';
LIBRARY 'tbl';
REQUIRE 'BLT';
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
        mx$database_routines,
        search_domain,
        build_table,
        lclchk,
        gatchk;
!
! MACROS:
!
%IF %SWITCHES(TOPS10) %THEN

SWITCHES LIST(NOEXPAND);
! The following table is used to convert strings to SIXBIT.
BIND
    sx_tab = CH$TRANSTABLE(REP %O'40' OF (0),		!Undefined in SIXBIT
                           seq(%O'0', %O'77'),		!Standard SIXBIT
                           0,				!Undefined in SIXBIT
			   seq(%O'41', %O'72'),		!Lower case => upper
			   REP 5 OF (0));		!Undefined in SIXBIT
SWITCHES LIST(EXPAND);

%FI

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
EXTERNAL
    NODNAM,             !The local host DECNET name
    NETTAB: VECTOR[];

EXTERNAL ROUTINE
    nmu$memory_manager,
    mx$parse_host_file,
    nmu$text,
    tbl_lookup,
    tbl_add;
!	;		!
%global_routine('MX$ASSIGN_DOMAIN_NAME', name, id) =

!++
! FUNCTIONAL DESCRIPTION:
!       This routine sets the domain name for a particular domain.  If
!   id is negative, then NETTAB is searched for an available entry.
!
! FORMAL PARAMETERS:
!
!	name:   The address of an ASCIZ string.
!       id:     The domain id whose name is to be assigned.
!
! IMPLICIT INPUTS:
!
!	NETTAB (The Domain Table)
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!       The domain id for this domain if successful,
!       -2 otherwise.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    LOCAL
        dom:    REF domain_data_block;

    IF .id LSS 0
    THEN
        BEGIN
        id = 0;
        WHILE .nettab[.id] NEQ 0 DO id = .id + 1;
        END;

    IF .id GTR max_number_of_domains
    THEN
        RETURN -2;

    dom = .nettab[.id];
    dom[DOM_NAME] = name;
    RETURN .id
    END;			!End of MX$ASSIGN_DOMAIN_NAME
%global_routine('MX$DATA_INITIALIZE', id)  =

!++
! FUNCTIONAL DESCRIPTION:
!       This routine will set up the domain database for a particular
!   domain.  It must be called before service to a domain can even be
!   considered.
!
! FORMAL PARAMETERS:
!
!       id:     The domain id of this domain
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!       Domain Data Records, and Tbluk tables may be set up and
!   initialized.
!
! ROUTINE VALUE:
!
!       1 if successful, -2 otherwise
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	After a domain has been initialized, MX is capable of
!   ENABLING/DISABLING mail/gateway service to or from the domain.
!   Note that services MUST BE EXPLICITLY enabled via OPR or the
!   MX.INIT file in order to send or recieve mail.  (Local mail is
!   enabled by default)
!
!--

    BEGIN
    LOCAL
        dom:    REF domain_data_block;

    $TRACE('Database Initialized');

    dom = .nettab[.id];

    build_table(.dom,.id);

    IF .dom[DOM_NODE_TABLE] EQL 0
    THEN
        RETURN -2;

    dom[DOM_INITIALIZED_FLAG] = 1;
    dom[DOM_SUSPENDED_FLAG] = 0;
    time_current(0, dom[dom_last_init_time]);

    IF .id EQL $local
    THEN
        BEGIN
        dom[DOM_INCOMING_FLAG] = 1;
        dom[DOM_OUTGOING_FLAG] = 1;
        END;

    RETURN 1;
    END;			!End of MX$DATA_INITIALIZE
%global_routine ('MX$DATA_SUSPEND', id) =	!

!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine suspends service to a domain.  Any work requests scheduled
!   for this domain will be held until the domain is re-initialized.  This has
!   not yet been implemented.
!
! FORMAL PARAMETERS:
!
!	id:         The domain id
!
! IMPLICIT INPUTS:
!
!	NETTAB and the domain data records
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    $TRACE('Database Suspended');
    RETURN 1;
    END;			!End of MX$DATA_GET_SPACE
%global_routine('MX$DATA_VALIDATE', node, src_id, dst_id) =

!++
! FUNCTIONAL DESCRIPTION:
!       This routine tries to validate a node name based on the
!   algorithm contained in the Domain_Data_Block.  If the domain is
!   not known, then each domain is queried, starting with the local
!   domain, until either there are no more domains, or the node has
!   been validated according to the appropriate algorithm.
!
!       In general, a validation algorithm checks the domain TBLUK
!   table, and if no match was found, then (do nothing/ask the
!   monitor/ask an external process) depending on how the domain was
!   initialized.
!
! FORMAL PARAMETERS:
!
!	node:   The address of an ASCIZ node name.
!       domain: -1 if the domain is unknow, otherwise the domain id of
!   the domain to validate the node in.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE: The domain id if the domain is valid. (GEQ 0)
!                -2 otherwise.
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	If valid, the node name will be added to the TBLUK table if it
!   is not already there...
!
!--

    BEGIN
    LOCAL
        valu;

    $TRACE('Node Validation routine called');
    IF .dst_id LSS 0
    THEN
        BEGIN
        dst_id = -2;
        INCR j FROM 0 TO max_number_of_domains - 1 DO
            IF (valu = search_domain(.node, .j)) NEQ -2
            THEN
                BEGIN
                dst_id = .j;
                EXITLOOP;
                END;
        END
    ELSE
        IF (valu = search_domain(.node, .dst_id)) EQL -2
        THEN
            dst_id = -2;

    IF (.src_id EQL $local) OR (.dst_id EQL $local)
    THEN
        (IF NOT lclchk(.src_id, .dst_id)
        THEN
            RETURN -2)
    ELSE
        (IF NOT gatchk(.src_id, .dst_id)
        THEN
            RETURN -2);

    IF .valu LEQ 0
    THEN
        RETURN .dst_id
    ELSE
        RETURN .valu ^ 18 + .dst_id

!    RETURN .dst_id
    end;			!End of MX$DATA_VALIDATE

%routine('LCLCHK', src, dst) =
    BEGIN
    RETURN 1;
    END;

%routine('GATCHK', src, dst) =
    BEGIN
    RETURN .src EQL .dst
    END;
%global_routine ('MX$DATA_GET_SPACE') =	!

!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine attempts to garbage collect from the Node/Domain database.
!   It is not yet implemented.
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    $TRACE('Database GET_SPACE routine called');
    RETURN 1;
    END;			!End of MX$DATA_GET_SPACE
%routine('SEARCH_DOMAIN', node, domain_id) =

!++
! FUNCTIONAL DESCRIPTION:
!       This routine performs a table lookup on the node table.  If the node is
!   not in the table, then depending on the validation method it:
!
!       1 - Checks the monitor for CFS or ARPA nodes
!       2 - Checks the monitor for DECNET nodes
!       3 - Do nothing (table is absolute authority)
!       4 - Send IPCF packet requesting validation to DOM_SERVER_PID
!
! FORMAL PARAMETERS:
!
!	node:       The address of an ASCIZ node name string.
!       domain_id:  The domain id of the domain to check.
!
! IMPLICIT INPUTS:
!
!	nettab (the domain table)
!
! IMPLICIT OUTPUTS:
!
!	Nodes may be added to the TBLUK table.
!
! ROUTINE VALUE:
!
!       Value field of TBLUK table if valid, -2 otherwise.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    LOCAL
        dom:    REF domain_data_block,
        t:      REF tbl,
        nptr,
        ndex ;

    $TRACE('Database SEARCH_DOMAIN routine called');

    IF .node<18,18,0> EQL 0
    THEN
        IF CH$RCHAR(CH$PTR(.node,0,8)) EQL 0
        THEN
            nptr = CH$PLUS(CH$PTR(.node,0,8),3)
        ELSE
            nptr = CH$PTR(.node)
    ELSE
        nptr = .node;

    dom = .nettab[.domain_id];
    IF (.dom[DOM_VALIDATION] LSS min_valid OR
        .dom[DOM_VALIDATION] GTR max_valid)
    THEN
        RETURN -2;

    t = .dom[DOM_NODE_TABLE];
    IF tbl_lookup(.t, .nptr, ndex) EQL tbl_exactmatch
    THEN
        BEGIN
        IF .t[.ndex, TBL_DATA] EQL $invalid
        THEN
            RETURN -2;
        END
    ELSE
        BEGIN
        CASE .dom[DOM_VALIDATION] FROM min_valid TO max_valid OF
            SET
            [v_arpa]:   IF ask_monitor(ARPA, .nptr)
                        THEN
                            mx$data_add_node(t, .node, ndex, 0)
                        ELSE
                            RETURN -2;

            [v_decnet]: IF ask_monitor(DECNET, .nptr)
                        THEN
                            mx$data_add_node(t, .node, ndex, 0)
                        ELSE
                            RETURN -2;

            [v_file]:   RETURN -2;

            [v_pid]:    RETURN -2;!Not yet implemented...
            TES;
        END;

    !Here if node is valid - Return index into TBLUK table;
    RETURN .t[.ndex, TBL_DATA]
    END;			!End of SEARCH_DOMAIN
%routine('BUILD_TABLE', dom, id) =	!

!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine allocates space for a TBLUK node table, and if necessary,
!   parses the file as for DECNET-HOSTS.TXT, or some other format (not yet
!   defined).
!
! FORMAL PARAMETERS:
!
!       dom:    The address of the domain data block
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!       The address of the NODE TBLUK table if successful, 0 otherwise.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
    MAP
        dom: REF domain_data_block;

    LOCAL
        table: REF tbl,
        idx,
        tmp;

    $TRACE('Database BUILD_TABLE routine called');

    table = nmu$memory_get(def_table_size + 1);

    IF .table EQL 0 THEN RETURN 0;

    table[TBL_MAXIMUM_ENTRIES] = def_table_size;
    table[TBL_ACTUAL_ENTRIES] = 0;

    CASE .dom[dom_validation] FROM min_valid TO max_valid OF
        SET
        [v_arpa, v_pid]:    ;   !Do Nothing

        [v_decnet]:         IF mx$parse_host_file(
                                    CH$PTR(.dom[dom_init_file]),
                                    table, 1) LEQ 0
                            THEN
                                RETURN -2;

        [v_file]:           BEGIN
                            IF .id EQL 0    !File not required for local...
                            THEN
                                mx$data_add_node(table, nodnam, idx, 0);

                            IF NOT mx$parse_host_file(
                                CH$PTR(.dom[dom_init_file]),
                                table, 1)
                            THEN
                                RETURN -2;
                            END;
        TES;

    dom[dom_node_table] = .table;
    RETURN .table
    END;			!End of BUILD_TABLE
%global_routine ('MX$DATA_ADD_NODE', tab_, node_, ind_, data) =	!

!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine adds a node to a domain node table.  If the table is full,
!   then a new, 1/4 larger table is created to hold the domain names.  If no
!   memory is available, then the routine returns false.
!
! FORMAL PARAMETERS:
!
!	Tab:    Contains the address of the domain tbluk table
!       Node:   The asciz string to insert into the table
!       Ind:    The index of where the node was inserted
!       Data:   The value for the data field of the tbluk table
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!       0 if insufficient memory to expand table,
!       1 if successful,
!       2 if node already in table.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!       If the table is expanded, the value of TAB may be changed.
!
!--

    BEGIN
    BIND
        tab = .tab_: REF tbl,
        node = .node_,
        ind = .ind_;

    MAP
        data: REF list_blk;

    LOCAL
        done,
        list: REF LIST_BLK,
        ptr,
        adr,
        len;

    $TRACE('Database Routine DATA_ADD_NODE called');

    IF CH$RCHAR(CH$PTR(node,0,8)) EQL 0
    THEN
        BEGIN
        len = CH$RCHAR(CH$PLUS(CH$PTR(node,0,8),2));
        ptr = CH$PLUS(CH$PTR(node,0,8),3);
        END
    ELSE
        len = CH$LEN((ptr=CH$PTR(node))) + 1;

    adr = nmu$memory_get(CH$ALLOCATION(.len));
    CH$MOVE(.len, .ptr, CH$PTR(.adr));
    done = -1;
    WHILE .done LEQ 0 DO
        BEGIN
        CASE tbl_add(.tab, .adr, ind, .data) FROM 0 TO 2 OF
            SET
            [0]:    expand_table(tab, 25); !Table is full. Try one more time

            [1]:    RETURN 1;           !Ok

            [2]:    BEGIN
                    IF (list = .tab[.ind, TBL_DATA]) EQL 0
                    THEN
                        tab[.ind, TBL_DATA] = .data
                    ELSE
                        BEGIN
                        WHILE .list[lst_next] NEQ 0 DO list = .list[lst_next];
                        list[lst_next] = .data;
                        END;

                    nmu$memory_release(.adr, CH$ALLOCATION(.len));
                    RETURN 1;
                    END;
            TES;
        done = .done + 1;
        END;
    RETURN 0;
    END;			!End of TEMP_EXAMPLE
END				!End of module
ELUDOM