[inherit('SYS$LIBRARY:STARLET','SYS$DISK:[]TCPIP$INETDEF')]
Program DNS_TO_ADDR (input, output);
{

  Look up the IP address for a given host name

}

type
    IO_Status_Block	= [quad] packed record
				sts	: [word] 0..65535;
				count	: [word] 0..65535;
				bufaddr	: [unsafe] unsigned;
			  end;

    integer_array	= array [1..100] of integer;

var
    ret_status, n	: integer;
    chan		: [word] 0..65535;
    IOSB		: IO_Status_Block;
    ip_address		: varying [40] of char;
    name, host_names	: varying [1024] of char;
    aliases		: [unsafe] integer;
    hostent_len		: [word] 0..65535;
    hostent		: record case integer of
			  1 : (h_name		: integer;	{ Offset to host name string }
			       h_aliases	: integer;	{ Offset to list of alias names }
			       h_addrtype	: integer;	{ Address type, e.g. AF_INET }
			       h_length		: integer;	{ Length of binary addresses of this type }
			       h_addr_list	: integer);	{ Offset to list of addresses }
			  2 : (buffer  : packed array [1..1024] of char);
			  end;
    trans		: [long] packed array [1..4] of 0..255;
    trans_descr		: [quad] packed record
			      dsc$w_length	: [word] 0..65535;
			      dsc$b_dtype	: [byte] 0..255;
			      dsc$b_class	: [byte] 0..255;	
			      dsc$a_pointer	: [unsafe] pointer;
			  end value ZERO;
    io_subfunc_hostent	: unsigned value INETACP_FUNC$C_GETHOSTBYNAME + (INETACP$C_HOSTENT_OFFSET*256);
    io_subfunc_trans	: unsigned value INETACP_FUNC$C_GETHOSTBYNAME + (INETACP$C_TRANS*256);
    subfunc_descr	: [quad] packed record
			      dsc$w_length	: [word] 0..65535;
			      dsc$b_dtype	: [byte] 0..255;
			      dsc$b_class	: [byte] 0..255;	
			      dsc$a_pointer	: [unsafe] pointer;
			  end;

    procedure display_name (var name : char);
    var c : [unsafe] c_str_t;
    begin
    c := iaddress(name);
    writeln(pas_str(c));
    end;

begin

subfunc_descr.dsc$w_length := 4;
subfunc_descr.dsc$b_dtype  := DSC$K_DTYPE_T;
subfunc_descr.dsc$b_class  := DSC$K_CLASS_S;
subfunc_descr.dsc$a_pointer := iaddress(io_subfunc_trans);

trans_descr.dsc$w_length   := 4;
trans_descr.dsc$a_pointer  := iaddress(trans);

ret_status := $ASSIGN ('TCPIP$DEVICE:', chan);
if not odd(ret_status) then $EXIT (ret_status);

write ('Enter host name: ');
while not eof do
    begin
    readln (name);
    ret_status := $QIOW (0
			,chan
			,IO$_ACPCONTROL
			,IOSB
			, { astaddr }
			, { astparam }
			, %ref subfunc_descr
			, %stdescr name
			, %ref hostent_len
			, %ref trans_descr
			);
    writeln('$QIOW status = ', ret_status:1);
    writeln('IOSB status  = ', IOSB.sts:1);
    if odd(ret_status) then ret_status := IOSB.sts;
    if odd(ret_status) then
	writeln  ('   IP Address : ', trans[1]:1, '.', trans[2]:1, '.', trans[3]:1, '.', trans[4]:1);
    write('Enter host name: ');
    end;

end.