%TITLE 'NAME_CONVERSION'
MODULE NAME_CONVERSION (IDENT='V1.2', ADDRESSING_MODE (EXTERNAL=GENERAL)) =
BEGIN
!++
! FACILITY: 	    NAME_CONVERSION
!
! ABSTRACT: 	    MX name conversion routines
!
! MODULE DESCRIPTION:
!
!   This module contains name_conversion routines for MX that
!   handle
!
!   	- DECnet addresses:    NODE::USER -> user%node.dnet
!   	- MRGATE addresses:    NODE::MRGATE::"NODE::USER" -> user%node.mrgate
!
!   In conjunction with this module, you should add the following
!   rewrite rules to your MX configuration:
!
!   MCP> DEFINE REWRITE_RULE "<{user}@{node}.dnet>" "<""node::user""@local>"
!   MCP> DEFINE REWRITE_RULE "<{user}@{node}.mrgate>" -
!   	    "<""mrgate::\""{node}::{user}\""""@local>"
!
!   where "local" is your local host name.  Be sure to get all those
!   quotation marks in there correctly!
!
!   NOTE:
!
!   This module can be used in conjunction with other name_conversion
!   modules.  It will automaticaly merge and activate a name_conversion
!   module if the logical name MX_SITE_NAME_CONVERSION_LOCAL points to the
!   shareable image containing the name_conversion routines, and will
!   automatically call that module's CONVERT routine if its own CONVERT
!   routine does not recognize an address as originating from DECnet
!   or MRGATE.
!
! AUTHOR:   	    M. Madison
!
! Copyright (c) 2008, Matthew Madison.
! 
! All rights reserved.
! 
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 
!     * Redistributions of source code must retain the above
!       copyright notice, this list of conditions and the following
!       disclaimer.
!     * Redistributions in binary form must reproduce the above
!       copyright notice, this list of conditions and the following
!       disclaimer in the documentation and/or other materials provided
!       with the distribution.
!     * Neither the name of the copyright owner nor the names of any
!       other contributors may be used to endorse or promote products
!       derived from this software without specific prior written
!       permission.
! 
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! CREATION DATE:    09-MAR-1992
!
! MODIFICATION HISTORY:
!
!   09-MAR-1992	V1.0	Madison	    Initial coding.
!   06-JAN-1993	V1.1	Madison	    Handle MRGATE::"NODE1::NODE2::..." better.
!   02-SEP-1997	V1.2	Madison	    Eliminate references to MX sources.
!--
    LIBRARY 'SYS$LIBRARY:STARLET';
    LIBRARY 'SYS$LIBRARY:TPAMAC';

    FORWARD ROUTINE
    	INIT,
    	CONVERT,
    	CLEANUP,
    	DNA_PARSE,
    	DNA_STORE;

    EXTERNAL ROUTINE
    	LIB$FIND_IMAGE_SYMBOL, LIB$TPARSE, STR$COPY_DX, LIB$GET_VM,
    	LIB$FREE_VM, STR$CONCAT, STR$PREFIX, STR$FREE1_DX;

    LITERAL
    	CTX_S_LCLSTUFF	= 16,
    	CTX_S_NODE  	= 256,
    	CTX_S_CLUNODE	= 256,
    	CTX_S_CTXDEF	= CTX_S_LCLSTUFF+CTX_S_NODE+CTX_S_CLUNODE+4;

    FIELD
    	CTX_FIELDS =
        SET
    	CTX_L_LCLINIT	= [0,0,32,0],
    	CTX_L_LCLCONV	= [4,0,32,0],
    	CTX_L_LCLCLUP	= [8,0,32,0],
    	CTX_L_LCLCTX	= [12,0,32,0],
    	CTX_W_NODE  	= [16,0,16,0],
    	CTX_T_NODE  	= [18,0,0,0],
    	CTX_W_CLUNODE	= [20+CTX_S_NODE,0,16,0],
    	CTX_T_CLUNODE	= [22+CTX_S_NODE,0,0,0]
    	TES;

    MACRO
    	CTXDEF 	    	= BLOCK [CTX_S_CTXDEF,BYTE] FIELD (CTX_FIELDS)%;

    LITERAL
    	NICK_TO_ADDRESS	    = 1,
    	USERNAME_TO_NICK    = 2,

    	NC_K_LOW    	    = 1,
    	NC_K_IS_MRGATE	    = 1,
    	NC_K_DECNET_NODE    = 2,
    	NC_K_DECNET_USER    = 3,
    	NC_K_MRGATE_NODE    = 4,
    	NC_K_MRGATE_USER    = 5,
    	NC_K_HI	    	    = 5;

    MACRO
    	TPA_A_P1    	=   TPA$C_LENGTH0+00,0,32,0%,
    	TPA_A_P2    	=   TPA$C_LENGTH0+04,0,32,0%,
    	TPA_A_P3    	=   TPA$C_LENGTH0+08,0,32,0%,
    	TPA_A_P4    	=   TPA$C_LENGTH0+12,0,32,0%,
    	TPA_A_P5    	=   TPA$C_LENGTH0+16,0,32,0%,
    	TPA_A_P6    	=   TPA$C_LENGTH0+20,0,32,0%,
    	TPA_A_P7    	=   TPA$C_LENGTH0+24,0,32,0%,
    	TPA_A_P8    	=   TPA$C_LENGTH0+28,0,32,0%;

    $INIT_STATE (DNA_STATE, DNA_KEY);

    $STATE (DNA_START,
    	((MRGATE), DNA_MRGATE, DNA_STORE,,, NC_K_IS_MRGATE),
    	((NODE),, DNA_STORE,,, NC_K_DECNET_NODE));
    $STATE (DNA_NODE,
    	((MRGATE), DNA_MRGATE, DNA_STORE,,, NC_K_IS_MRGATE),
    	((NODE), DNA_NODE, DNA_STORE,,, NC_K_DECNET_NODE),
    	(TPA$_LAMBDA, DNA_USER));
    $STATE (DNA_USER,
    	(TPA$_EOS, TPA$_EXIT),
    	(TPA$_ANY, DNA_USER, DNA_STORE,,, NC_K_DECNET_USER));
    $STATE (DNA_MRGATE,
    	('"',));
    $STATE (DNA_MRGATE_NODE,
    	((NODE), DNA_MRGATE_NODE, DNA_STORE,,,NC_K_MRGATE_NODE),
    	(TPA$_LAMBDA,));
    $STATE (DNA_MRGATE_USER,
    	('"', TPA$_EXIT),
    	(TPA$_ANY, DNA_MRGATE_USER, DNA_STORE,,,NC_K_MRGATE_USER));
    $STATE (MRGATE,
    	('MRGATE',));
    $STATE (, (':',));
    $STATE (, (':', TPA$_EXIT));
    $STATE (NODE,
    	(TPA$_ALPHA, NODE),
    	(TPA$_DIGIT, NODE),
    	(':',));
    $STATE (, (':', TPA$_EXIT));

%SBTTL 'INIT'
GLOBAL ROUTINE INIT (CTX_A_A) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   Initialization routine for NAME_CONVERSION.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   INIT
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    BIND
    	CTX 	= .CTX_A_A  : REF CTXDEF;

    LOCAL
    	LNMLST	: $ITMLST_DECL (ITEMS=1),
    	STATUS;

    STATUS = LIB$GET_VM (%REF (CTX_S_CTXDEF), CTX);
    CH$FILL (%CHAR (0), CTX_S_CTXDEF, .CTX);
    IF NOT .STATUS THEN RETURN .STATUS;

    $ITMLST_INIT (ITMLST=LNMLST,
    	(ITMCOD=LNM$_STRING, BUFADR=CTX [CTX_T_NODE], BUFSIZ=CTX_S_NODE,
    	    RETLEN=CTX [CTX_W_NODE]));
    STATUS = $TRNLNM (TABNAM=%ASCID'LNM$SYSTEM',
    	    	LOGNAM=%ASCID'SYS$NODE', ITMLST=LNMLST);
    IF .STATUS AND .CTX [CTX_W_NODE] GTR 2 THEN
    	CTX [CTX_W_NODE] = .CTX [CTX_W_NODE] - 2;

    $ITMLST_INIT (ITMLST=LNMLST,
    	(ITMCOD=LNM$_STRING, BUFADR=CTX [CTX_T_CLUNODE], BUFSIZ=CTX_S_CLUNODE,
    	    RETLEN=CTX [CTX_W_CLUNODE]));
    STATUS = $TRNLNM (TABNAM=%ASCID'LNM$SYSTEM',
    	    	LOGNAM=%ASCID'SYS$CLUSTER_NODE', ITMLST=LNMLST);
    IF .STATUS AND .CTX [CTX_W_CLUNODE] GTR 2 THEN
    	CTX [CTX_W_CLUNODE] = .CTX [CTX_W_CLUNODE] - 2;

    IF $TRNLNM (TABNAM=%ASCID'LNM$SYSTEM',
    	    	LOGNAM=%ASCID'MX_SITE_NAME_CONVERSION_LOCAL') THEN
    BEGIN
    	STATUS = LIB$FIND_IMAGE_SYMBOL (%ASCID'MX_SITE_NAME_CONVERSION_LOCAL',
    	    	    %ASCID'INIT', CTX [CTX_L_LCLINIT]);
    	IF .STATUS THEN
    	BEGIN
    	    LIB$FIND_IMAGE_SYMBOL (%ASCID'MX_SITE_NAME_CONVERSION_LOCAL',
    	    	    %ASCID'CONVERT', CTX [CTX_L_LCLCONV]);
    	    LIB$FIND_IMAGE_SYMBOL (%ASCID'MX_SITE_NAME_CONVERSION_LOCAL',
    	    	    %ASCID'CLEANUP', CTX [CTX_L_LCLCLUP]);
    	    STATUS = (.CTX [CTX_L_LCLINIT]) (CTX [CTX_L_LCLCTX]);
    	    IF NOT .STATUS THEN CH$FILL (%CHAR (0), CTX_S_LCLSTUFF, .CTX);
    	END;
    END;

    SS$_NORMAL

END; ! INIT

%SBTTL 'CONVERT'
GLOBAL ROUTINE CONVERT (CTX_A_A, CODE_A, INSTR_A, OUTSTR_A) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   Performs a username->nickname conversion on DECnet-origin and
!   MRGATE-origin addresses.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   CONVERT
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    BIND
    	CTX 	= .CTX_A_A  	: REF CTXDEF,
    	CODE	= .CODE_A,
    	INSTR	= .INSTR_A  	: BLOCK [DSC$K_S_BLN,BYTE],
    	OUTSTR	= .OUTSTR_A 	: BLOCK [DSC$K_S_BLN,BYTE];

    LOCAL
    	NODE	    : BLOCK [DSC$K_S_BLN,BYTE],
    	USER	    : BLOCK [DSC$K_S_BLN,BYTE],
    	GWNODE	    : BLOCK [DSC$K_S_BLN,BYTE],
    	ADDR_TYPE,
    	STATUS;

    IF .CODE EQL NICK_TO_ADDRESS THEN
    	IF .CTX [CTX_L_LCLCONV] NEQA 0 THEN
    	    RETURN (.CTX [CTX_L_LCLCONV]) (CTX [CTX_L_LCLCTX], CODE,
    	    	    	    	    	    	INSTR, OUTSTR)
    	ELSE RETURN 0;

    IF .CODE NEQ USERNAME_TO_NICK THEN RETURN 0;  ! shouldn't happen, though

    $INIT_DYNDESC (NODE);
    $INIT_DYNDESC (GWNODE);
    STATUS = DNA_PARSE (INSTR, ADDR_TYPE, NODE, USER, GWNODE);
    IF NOT .STATUS THEN
    BEGIN
    	STR$FREE1_DX (NODE);
    	STR$FREE1_DX (GWNODE);
    	IF .CTX [CTX_L_LCLCONV] NEQA 0 THEN
    	    RETURN (.CTX [CTX_L_LCLCONV]) (CTX [CTX_L_LCLCTX], CODE,
    	    	    	    	    	    	INSTR, OUTSTR)
    	ELSE
    	BEGIN
    	    STR$COPY_DX (OUTSTR, INSTR);   ! for pre-V3.1 compatibility
    	    RETURN 0;
    	END;
    END;

    IF .ADDR_TYPE EQL 0 THEN
    	STR$CONCAT (OUTSTR, USER, %ASCID'%', NODE, %ASCID'.dnet')
    ELSE
    BEGIN
    	IF .GWNODE [DSC$W_LENGTH] EQL 0 OR
    	    CH$EQL (.GWNODE [DSC$W_LENGTH], .GWNODE [DSC$A_POINTER],
    	    	    	.CTX [CTX_W_NODE], CTX [CTX_T_NODE], %C' ') OR
    	    CH$EQL (.GWNODE [DSC$W_LENGTH], .GWNODE [DSC$A_POINTER],
    	    	    	.CTX [CTX_W_CLUNODE], CTX [CTX_T_CLUNODE], %C' ')
    	THEN STR$CONCAT (OUTSTR, USER, %ASCID'%', NODE, %ASCID'.mrgate')
    	ELSE STR$CONCAT (OUTSTR, USER, %ASCID'%', NODE,
    	    	    	%ASCID'.', GWNODE, %ASCID'.mrgate');
    END;

    STR$FREE1_DX (NODE);
    STR$FREE1_DX (GWNODE);

    SS$_NORMAL

END; ! CONVERT

%SBTTL 'CLEANUP'
GLOBAL ROUTINE CLEANUP (CTX_A_A) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   description
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   CLEANUP
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    BIND
    	CTX 	= .CTX_A_A  	: REF CTXDEF;

    IF .CTX [CTX_L_LCLCLUP] NEQA 0 THEN
    	(.CTX [CTX_L_LCLCLUP]) (CTX [CTX_L_LCLCTX]);
    LIB$FREE_VM (%REF (CTX_S_CTXDEF), CTX);
    SS$_NORMAL

END; ! CLEANUP

%SBTTL 'DNA_PARSE'
ROUTINE DNA_PARSE (INSTR_A, ADTYPE_A, NODE_A, USER_A, GWNODE_A) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   Uses LIB$TPARSE to parse what might be a DECnet or MRGATE-type address.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   DNA_PARSE
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    BIND
    	INSTR	= .INSTR_A  : BLOCK [DSC$K_S_BLN,BYTE],
    	ADTYPE	= .ADTYPE_A,
    	NODE	= .NODE_A   : BLOCK [DSC$K_S_BLN,BYTE],
    	USER	= .USER_A   : BLOCK [DSC$K_S_BLN,BYTE],
    	GWNODE	= .GWNODE_A : BLOCK [DSC$K_S_BLN,BYTE];

    LITERAL
    	TPA_C_LENGTH	= TPA$C_LENGTH0 + 16,
    	TPA_K_COUNT 	= TPA$K_COUNT0 + 4;

    LOCAL
    	TPABLK	: BLOCK [TPA_C_LENGTH,BYTE];

    USER [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    USER [DSC$B_CLASS] = DSC$K_CLASS_S;
    USER [DSC$W_LENGTH] = 0;
    USER [DSC$A_POINTER] = 0;

    ADTYPE = 0;
    TPABLK [TPA$L_COUNT] = TPA_K_COUNT;
    TPABLK [TPA$L_OPTIONS] = 0;
    TPABLK [TPA$L_STRINGCNT] = .INSTR [DSC$W_LENGTH];
    TPABLK [TPA$L_STRINGPTR] = .INSTR [DSC$A_POINTER];
    TPABLK [TPA_A_P1] = ADTYPE;
    TPABLK [TPA_A_P2] = NODE;
    TPABLK [TPA_A_P3] = USER;
    TPABLK [TPA_A_P4] = GWNODE;

    LIB$TPARSE (TPABLK, DNA_STATE, DNA_KEY)

END; ! DNA_PARSE

%SBTTL 'DNA_STORE'
ROUTINE DNA_STORE (OPTIONS, STRLEN, STRPTR, TOKLEN, TOKPTR, CHAR : BYTE,
    	    NUMBER, PARAM, ADTYPE_A, NODE_A, USER_A, GWNODE_A) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   description
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   DNA_STORE
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    BIND
    	ADTYPE	= .ADTYPE_A,
    	USER	= .USER_A   	: BLOCK [DSC$K_S_BLN,BYTE],
    	NODE	= .NODE_A   	: BLOCK [DSC$K_S_BLN,BYTE],
    	GWNODE	= .GWNODE_A   	: BLOCK [DSC$K_S_BLN,BYTE];

    CASE .PARAM FROM NC_K_LOW TO NC_K_HI OF
    SET
    	[NC_K_IS_MRGATE]    :
    	    	BEGIN
    	    	    ADTYPE = 1;
    	    	    CH$MOVE (DSC$K_S_BLN, NODE, GWNODE);
    	    	    $INIT_DYNDESC (NODE);
    	    	END;
    	[NC_K_DECNET_NODE] :
    	    	BEGIN
    	    	    LOCAL DSC : BLOCK [DSC$K_S_BLN,BYTE] PRESET (
    	    	    	[DSC$B_DTYPE] 	= DSC$K_DTYPE_T,
    	    	    	[DSC$B_CLASS] 	= DSC$K_CLASS_S,
    	    	    	[DSC$W_LENGTH]	= .TOKLEN-2,
    	    	    	[DSC$A_POINTER]	= .TOKPTR);
    	    	    STR$COPY_DX (NODE, DSC);
    	    	END;
    	[NC_K_MRGATE_NODE]  :
    	    	BEGIN
    	    	    LOCAL DSC : BLOCK [DSC$K_S_BLN,BYTE] PRESET (
    	    	    	[DSC$B_DTYPE] 	= DSC$K_DTYPE_T,
    	    	    	[DSC$B_CLASS] 	= DSC$K_CLASS_S,
    	    	    	[DSC$W_LENGTH]	= .TOKLEN-2,
    	    	    	[DSC$A_POINTER]	= .TOKPTR);
    	    	    IF .NODE [DSC$W_LENGTH] EQL 0 THEN
    	    	    	STR$COPY_DX (NODE, DSC)
    	    	    ELSE
    	    	    BEGIN
    	    	    	STR$PREFIX (NODE, %ASCID'.');
    	    	    	STR$PREFIX (NODE, DSC);
    	    	    END;
    	    	END;
    	[NC_K_DECNET_USER,NC_K_MRGATE_USER] :
    	    	BEGIN
    	    	    IF .USER [DSC$A_POINTER] EQLA 0 THEN
    	    	    	USER [DSC$A_POINTER] = .TOKPTR;
    	    	    USER [DSC$W_LENGTH] = .USER [DSC$W_LENGTH] + .TOKLEN;
    	    	END;
    TES;

    SS$_NORMAL

END; ! DNA_STORE

END
ELUDOM