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

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;
    io_subfunction	: unsigned value INETACP_FUNC$C_GETHOSTBYADDR + (INETACP$C_HOSTENT_OFFSET*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_subfunction);

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

write ('Enter IP address: ');
while not eof do
    begin
    readln (ip_address);
    ret_status := $QIOW (0
			,chan
			,IO$_ACPCONTROL
			,IOSB
			, { astaddr }
			, { astparam }
			, %ref subfunc_descr
			, %stdescr ip_address
			, %ref hostent_len
			, %stdescr hostent.buffer
			);
    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
	begin
	{ Display the "official" host name }
	write  ('   Host name : ');
	display_name(hostent.buffer[hostent.h_name+1]);
	{ Display any alias names }
	aliases := hostent.h_aliases+1;
	while (hostent.buffer[aliases])::integer <> 0 do
	    begin
	    write  ('  Alias name : ');
	    display_name(hostent.buffer[((hostent.buffer[aliases])::integer)+1]);
	    aliases := aliases + 4;
	    end
	end;
    writeln;
    write('Enter IP address: ');
    end;

end.