mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 01:19:17 +00:00
652 lines
14 KiB
Plaintext
652 lines
14 KiB
Plaintext
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
|