Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
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