%(
	****************************************************************

		Copyright (c) 1992, Carnegie Mellon University

		All Rights Reserved

	Permission  is  hereby  granted   to  use,  copy,  modify,  and
	distribute  this software  provided  that the  above  copyright
	notice appears in  all copies and that  any distribution be for
	noncommercial purposes.

	Carnegie Mellon University disclaims all warranties with regard
	to this software.  In no event shall Carnegie Mellon University
	be liable for  any special, indirect,  or consequential damages
	or any damages whatsoever  resulting from loss of use, data, or
	profits  arising  out of  or in  connection  with  the  use  or
	performance of this software.

	****************************************************************
)%
MODULE 
    Host_Name (
	LANGUAGE (BLISS32),
	ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
			NONEXTERNAL=LONG_RELATIVE),
	LIST (ASSEMBLY, BINARY, NOEXPAND)) =

BEGIN

!++
! Host_Name.B32
!
! Description:
!
!	Routines to deal with domain internet host names
!
! Written By:	Dale Moore	21-OCT-1986	Dale Moore
!
! Modifications:
!--

LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'CMUIP_SRC:[central]NETWORK';
LIBRARY 'CMUIP_SRC:[central]NETCOMMON';
LIBRARY 'CMUIP_SRC:[central]NETERROR';

COMPILETIME
    Debug	= 0;



GLOBAL ROUTINE Uncompact_Domain_Name (RData_A, RDLen, DN_Desc_A) =
    BEGIN
    EXTERNAL ROUTINE
	STR$CONCAT	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	Label_Desc	: $BBLOCK [DSC$K_S_BLN] PRESET (
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$B_CLASS]	= DSC$K_CLASS_D),
	index : INITIAL(0),
	Label_Size;
    BIND
	DN_Desc = .DN_Desc_A,
	RData  = .RData_A : VECTOR[,BYTE];

    Label_Size = .RData[.index] ;
    WHILE (.Label_Size GTR 0) AND ((.index + .Label_Size) LSS .RDLen) DO
	BEGIN
	Label_Desc[DSC$W_LENGTH] = .Label_Size;
	Label_Desc[DSC$A_POINTER] = RData[.index+1];
	STR$CONCAT (DN_Desc, DN_Desc, Label_Desc);
	index = .index + .Label_Size + 1;
	IF (Label_Size = .Rdata[.index]) GTR 0 THEN
	    STR$CONCAT (DN_Desc, DN_Desc, %ASCID'.')
	END;

    .Index
    END;


%SBTTL 'GTHST routines'

GLOBAL ROUTINE ADDR_2_NAME (IPADDR, Name_Desc_A) =
!++
! Functional Description:
!
!	Given the address of a host, return the full name of the host.
!--
    BEGIN
    BIND
	Name_Desc	= .Name_Desc_A	: $BBLOCK;
    EXTERNAL ROUTINE
	STR$COPY_R	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	ADLBLK	: GTHST_ADLOOK_BLOCK,
	NETIOSB : NetIO_Status_Block,
	NETCHAN	: WORD UNSIGNED,
	STATUS;

    Status = $ASSIGN (DEVNAM = %ASCID 'INET$DEVICE', CHAN=NETCHAN);
    IF NOT .Status THEN RETURN (.Status);

    STATUS = NET$GTHST(
		    BUFADRS	= ADLBLK,
		    BUFSIZE	= %ALLOCATION (ADLBLK),
		    GTHFUNCT	= GTH_ADRNAM,
		    GTHP1	= .IPADDR,
		    IOMODE	= SYNCH,
		    IOCHAN	= .NETCHAN,
		    IO$SB	= NETIOSB);

    $DASSGN (CHAN = .NETCHAN);

! Make sure it worked

    IF NOT .STATUS THEN
	BEGIN
	RETURN .Status;
	END;

    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	IF .Status EQL SS$_ABORT
	    THEN Return (.NETIOSB [NSB$XStatus])
	    ELSE Return (.Status);
	END;

    Status = STR$COPY_R (
		Name_Desc,
		%REF(.ADLBLK[AL$NAMLEN]),		! Length by ref
		ADLBLK [AL$NAMSTR]);			! Source Addr
    IF NOT .Status THEN RETURN (.Status);

    SS$_NORMAL
    END;


GLOBAL ROUTINE Host_Full_Name (In_Name_A, Out_Name_A) =
    BEGIN
    BIND
	In_Name		= .In_Name_A		: $BBLOCK,
	Out_Name	= .Out_Name_A		: $BBLOCK;
    EXTERNAL ROUTINE
	STR$CONCAT	: BLISS ADDRESSING_MODE (GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE (GENERAL),
	STR$TRIM	: BLISS ADDRESSING_MODE (GENERAL),
	STR$COPY_R	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	Nam_Look	: GTHST_NMLOOK_BLOCK;
    LOCAL
	Temp_Desc	: $BBLOCK [DSC$K_S_BLN],
	NETIOSB		: NetIO_Status_Block,
	NetChan		: WORD UNSIGNED,
	Status;

    !++
    ! Make Temp_Desc be the ASCIZ name
    !--
    $Init_DynDesc (Temp_Desc);
    Status = STR$CONCAT (Temp_Desc, In_Name,
		$DESCRIPTOR (%STRING(%CHAR(0))));

    !++
    ! Do the network I/O
    !-
    Status = $ASSIGN (DEVNAM = %ASCID 'INET$DEVICE', CHAN = NetChan);
    IF NOT .Status THEN Signal_Stop (.Status);

    Status = NET$GTHST (
		BUFADRS		= Nam_Look,
		BUFSIZE		= %ALLOCATION (Nam_Look),
		GTHFUNCT	= GTH_NAMADR,
		GTHP1		= .Temp_Desc [DSC$A_POINTER],
		IOCHAN		= .NetChan,
		IO$SB		= NETIOSB);

    $DASSGN (CHAN = .NetChan);

    !++
    ! Check the status(s)
    !--
    IF NOT .Status THEN Signal_Stop (.Status);
    Status = .NetIOSB [NSB$Status];
    IF NOT .Status
	THEN BEGIN
	IF .Status EQL SS$_ABORT
	    THEN RETURN Signal (.NetIOSB [NSB$XStatus], 0)
	    ELSE RETURN Signal (.Status);
	END;

    !++
    ! Copy the out param
    !--
    Status = STR$COPY_R (
		Out_Name,				! Result Desc
		%REF (.Nam_Look [GH$NL_NAMLEN]),	! Len (By ref)
		Nam_Look [GH$NL_NAMSTR]);		! Source Addr
    IF NOT .Status THEN RETURN Signal (.Status);

    Status = STR$TRIM (Out_Name, Out_Name);
    IF NOT .Status THEN RETURN Signal (.Status);

    !++
    ! Clean up
    !--
    Status = STR$FREE1_DX (Temp_Desc);
    IF NOT .Status THEN RETURN Signal (.Status);

    SS$_NORMAL
    END;

GLOBAL ROUTINE This_Host_Name (Out_Desc_A) =
!++
! Functional Description:
!
!	Return the name of the host that we are currently on.
!--
    BEGIN
    BIND
	Out_Desc	= .Out_Desc_A		: $BBLOCK;
    EXTERNAL ROUTINE
	STR$COPY_R	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	Item_List	: $ITMLST_DECL (ITEMS=2),
	Name_Buffer	: VECTOR [255, BYTE],
	Name_Length,
	Status;

    $ITMLST_INIT (ITMLST = Item_List,
	(   ITMCOD = LNM$_STRING,
	    BUFADR = Name_Buffer,
	    BUFSIZ = %ALLOCATION (Name_Buffer),
	    RETLEN = Name_Length),
	(   ITMCOD = 0,
	    BUFADR = 0,
	    BUFSIZ = 0,
	    RETLEN = 0));

    Status = $TRNLNM (
		TABNAM	= %ASCID 'LNM$SYSTEM_TABLE',
		LOGNAM	= %ASCID 'INTERNET_HOST_NAME',
		ITMLST	= Item_List);
    IF NOT .Status THEN RETURN (.Status);

    Status = STR$COPY_R ( Out_Desc, %REF (.Name_Length), Name_Buffer);
    IF NOT .Status THEN RETURN Signal (.Status);

    SS$_NORMAL
    END;

GLOBAL ROUTINE Domain_Is_Local (Domain_A) =
!++
! Functional Description:
!
!	Is the domain the local domain?  Is the parameter passed
!	This host?
!--
    BEGIN
    BIND
	Domain	= .Domain_A		: $BBLOCK;
    EXTERNAL ROUTINE
	This_Host_Name,
	Host_Full_Name,
	STR$CASE_BLIND_COMPARE
			: BLISS ADDRESSING_MODE (GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE (GENERAL);	
    LOCAL
	Expanded_Domain	: $BBLOCK [DSC$K_S_BLN],
	My_Name		: $BBLOCK [DSC$K_S_BLN],
	Return_Status,
	Status;

    $Init_DynDesc (Expanded_Domain);
    $Init_DynDesc (My_Name);

    Return_Status = SS$_NORMAL;

    %IF Debug
	%THEN
	PrintTT('Domain Is Local: Debug Domain = ''!AS''!/', Domain);
	%FI

    Status = Host_Full_Name (Domain, Expanded_Domain);
    IF NOT .Status THEN RETURN (.Status);

    %IF Debug
	%THEN
	PrintTT('Domain_Is_Local: Debug Expand = ''!AS''!/', Expanded_Domain);
	%FI

    Status = This_Host_Name (My_Name);
    IF NOT .Status THEN RETURN Signal (.Status);

    %IF Debug
	%THEN
	PrintTT('Domain_Is_Local: Debug Expand = ''!AS'', My_Name = ''!AS''!/',
		Expanded_Domain, My_Name);
	PrintTT('Domain_Is_Local: Debug Expand Length = !UL!/',
		.Expanded_Domain [DSC$W_LENGTH]);
	PrintTT('Domain_Is_Local: Debug My_Name Length = !UL!/',
		.My_Name [DSC$W_LENGTH]);
	%FI

    Status = STR$CASE_BLIND_COMPARE (Expanded_Domain, My_Name);
    IF .Status NEQ 0
	THEN Return_Status = 0;

    Status = STR$FREE1_DX (My_Name);
    IF NOT .Status THEN RETURN Signal (.Status);

    Status = STR$FREE1_DX (Expanded_Domain);
    IF NOT .Status THEN RETURN Signal (.Status);

    RETURN (.Return_Status)
    END;
END
ELUDOM