1---------------------------------------------------------------- 2-- IRONSIDES - DNS SERVER 3-- 4-- By: Martin C. Carlisle and Barry S. Fagin 5-- Department of Computer Science 6-- United States Air Force Academy 7-- 8-- This is free software; you can redistribute it and/or 9-- modify without restriction. We do ask that you please keep 10-- the original author information, and clearly indicate if the 11-- software has been modified. 12-- 13-- This software is distributed in the hope that it will be useful, 14-- but WITHOUT ANY WARRANTY; without even the implied warranty 15-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 16---------------------------------------------------------------- 17 18with Ada.Streams; 19with System; 20use type System.Bit_Order; 21with Socket_Timeout; 22with Ada.Unchecked_Conversion; 23--with Ada.Text_Io; 24--use ada.text_io; 25package body DNS_Network is 26--# hide DNS_Network; 27 Server : Gnat.Sockets.Socket_Type; 28 Address : Gnat.Sockets.Sock_Addr_Type; 29 UDP_Socket : Gnat.Sockets.Socket_Type; 30 UDP_Address : Gnat.Sockets.Sock_Addr_Type; 31 32 procedure Initialize_UDP is 33 begin 34 35 -- create the socket which will listen for the UDP DNS query 36 Gnat.Sockets.Create_Socket( 37 Socket => UDP_Socket, 38 Family => Gnat.Sockets.Family_Inet, 39 Mode => Gnat.Sockets.Socket_Datagram); 40 41 -- Allow socket to be bound to address already in use 42 Gnat.Sockets.Set_Socket_Option(UDP_Socket, 43 Gnat.Sockets.Socket_Level, (Gnat.Sockets.Reuse_Address, True)); 44 45 -- bind the socket to the first IP address on localhost, port 53 46 --Address.Addr := Gnat.Sockets.Addresses( 47 -- Gnat.Sockets.Get_Host_By_Name(Gnat.Sockets.Host_Name), 1); 48 -- bind to any IP address available 49 UDP_Address.Addr := Gnat.Sockets.ANY_INET_ADDR; 50 UDP_Address.Port := 53; 51 Gnat.Sockets.Bind_Socket(UDP_Socket,UDP_Address); 52 53 54 end Initialize_UDP; 55 56 procedure Initialize_TCP is 57 begin 58 59 60 -- create the socket which will listen for the TCP query 61 Gnat.Sockets.Create_Socket( 62 Socket => Server, 63 Family => Gnat.Sockets.Family_Inet, 64 Mode => Gnat.Sockets.Socket_Stream); 65 66-- -- Allow socket to be bound to address already in use 67 --Gnat.Sockets.Set_Socket_Option(Server, 68 -- Gnat.Sockets.Socket_Level, (Gnat.Sockets.Reuse_Address, True)); 69 Address.Addr := Gnat.Sockets.ANY_INET_ADDR; 70 71 -- bind the socket to the first IP address on localhost, port 53 72 -- below doesn't work on Linux, as it doesn't resolve host_name correctly 73-- Address.Addr := Gnat.Sockets.Addresses( 74-- Gnat.Sockets.Get_Host_By_Name(Gnat.Sockets.Host_Name), 1); 75 Address.Port := 53; 76 Gnat.Sockets.Bind_Socket(Server,Address); 77 Gnat.Sockets.Listen_Socket(Socket => Server); 78 end Initialize_TCP; 79 80 procedure Get_Connection_TCP( 81 Socket : out DNS_Socket) 82 is 83 function Convert is new Ada.Unchecked_Conversion(DNS_Socket, 84 Socket_Timeout.Socket_Type); 85 begin 86 Gnat.Sockets.Accept_Socket(Server => Server, 87 Socket => Gnat.Sockets.Socket_Type(Socket), 88 Address => Address); 89 Socket_Timeout.Set_Socket_Timeout( 90 Socket => Convert(Socket), 91 Milliseconds => Socket_Timeout_Milliseconds); 92 end Get_Connection_TCP; 93 94 procedure Receive_DNS_Packet_TCP 95 (Packet : out DNS_Types.DNS_Tcp_Packet; 96 Number_Bytes : out DNS_Types.Packet_Length_Range; 97 Socket : in DNS_Socket; 98 Failure : out Boolean) 99 is 100 USE TYPE Dns_Types.Packet_Length_Range; 101 use type ada.streams.Stream_Element_Offset; 102 Last_Value : Ada.Streams.Stream_Element_Offset; 103 Item : Ada.Streams.Stream_Element_Array (1 .. DNS_Types.DNS_Packet'Size/8); 104 for Item'Address use Packet'Address; 105 begin 106 Gnat.Sockets.Receive_Socket( 107 Socket => Gnat.Sockets.Socket_Type(Socket), 108 Item => Item, 109 Last => Last_Value); 110 Number_Bytes := DNS_Types.Packet_Length_Range(Last_Value)-2; 111 if System.Default_Bit_Order=System.Low_Order_First then 112 DNS_Types.Byte_Swap(Packet.Rest.Header); 113 end if; 114 Failure := (Number_Bytes < DNS_Types.Packet_Length_Range(1+DNS_Types.Header_Bits/8)) 115 OR (Number_Bytes > MAX_QUERY_SIZE); 116 exception when others => 117 --ada.text_io.put_line("failure!"); 118 Failure := True; 119 end Receive_DNS_Packet_Tcp; 120 121 ------------------------- 122 -- Send_DNS_Packet_Tcp -- 123 ------------------------- 124 125 procedure Send_DNS_Packet_Tcp 126 (Packet : in out DNS_Types.DNS_Tcp_Packet; 127 Number_Bytes : in DNS_Types.Packet_Length_Range; 128 Socket : in DNS_Socket; 129 Failure : out Boolean) 130 is 131 USE TYPE Dns_Types.Packet_Length_Range; 132 use type ada.streams.Stream_Element_Offset; 133 Response_Stream : Ada.Streams.Stream_Element_Array (1 .. DNS_Types.DNS_Packet'Size/8); 134 for Response_Stream'Address use Packet'Address; 135 Result_Last : Ada.Streams.Stream_Element_Offset; 136 begin 137 if System.Default_Bit_Order=System.Low_Order_First then 138 DNS_Types.Byte_Swap(Packet.Rest.Header); 139 end if; 140 141 Gnat.Sockets.Send_Socket( 142 Socket => Gnat.Sockets.Socket_Type(Socket), 143 Item => Response_Stream (1 .. Ada.Streams.Stream_Element_Offset(Number_Bytes+2)), 144 Last => Result_Last); 145-- put_line("Num bytes sent" & Ada.Streams.Stream_Element_Offset'image(result_last)); 146 if Result_Last /= Ada.Streams.Stream_Element_Offset(Number_Bytes+2) then 147 Failure := True; 148 else 149 Failure := False; 150 end if; 151 Gnat.Sockets.Close_Socket(Gnat.Sockets.Socket_Type(Socket)); 152 153 exception when others => 154 Failure := True; 155 end Send_DNS_Packet_Tcp; 156 157 procedure Discard_Socket(Socket : in DNS_Socket) is 158 begin 159 Gnat.Sockets.Close_Socket(Gnat.Sockets.Socket_Type(Socket)); 160 exception when others => 161 null; 162 end Discard_Socket; 163 164 --# global in out Network; 165 --# derives Network from *; 166 ------------------------ 167 -- Receive_DNS_Packet -- 168 ------------------------ 169 170 PROCEDURE Receive_DNS_Packet( 171 Packet : out DNS_Types.DNS_Packet; 172 Number_Bytes : out DNS_Types.Packet_Length_Range; 173 Reply_Address : out Network_Address_and_Port; 174 Failure : out Boolean) 175 is 176 USE TYPE Dns_Types.Packet_Length_Range; 177 use type ada.streams.Stream_Element_Offset; 178 Last_Value : Ada.Streams.Stream_Element_Offset; 179 Item : Ada.Streams.Stream_Element_Array (1 .. DNS_Types.DNS_Packet'Size/8); 180 for Item'Address use Packet'Address; 181 begin 182 Gnat.Sockets.Receive_Socket( 183 Socket => UDP_Socket, 184 Item => Item, 185 Last => Last_Value, 186 From => Gnat.Sockets.Sock_Addr_Type(Reply_Address)); 187 Number_Bytes := DNS_Types.Packet_Length_Range(Last_Value); 188-- put_line("Num bytes" & dns_types.packet_length_range'image(number_bytes)); 189 if System.Default_Bit_Order=System.Low_Order_First then 190 DNS_Types.Byte_Swap(Packet.Header); 191 end if; 192 --Gnat.Sockets.Close_Socket(Socket); 193 Failure := False; 194 exception when others => 195 Failure := True; 196 end Receive_DNS_Packet; 197 198 --------------------- 199 -- Send_DNS_Packet -- 200 --------------------- 201 202 procedure Send_DNS_Packet 203 (Packet : in out DNS_Types.DNS_Packet; 204 Number_Bytes : in DNS_Types.Packet_Length_Range; 205 To_Address : in Network_Address_and_Port; 206 Failure : out Boolean) 207 is 208 USE TYPE Dns_Types.Packet_Length_Range; 209 use type ada.streams.Stream_Element_Offset; 210 Response_Stream : Ada.Streams.Stream_Element_Array (1 .. DNS_Types.DNS_Packet'Size/8); 211 for Response_Stream'Address use Packet'Address; 212 Result_Last : Ada.Streams.Stream_Element_Offset; 213 begin 214 if System.Default_Bit_Order=System.Low_Order_First then 215 DNS_Types.Byte_Swap(Packet.Header); 216 end if; 217 -- connect back to client 218-- Gnat.Sockets.Connect_Socket( 219-- Socket => Reply_UDP_Socket, 220-- Server => Gnat.Sockets.Sock_Addr_Type(To_Address)); 221 222 Gnat.Sockets.Send_Socket( 223 Socket => UDP_Socket, 224 Item => Response_Stream (1 .. Ada.Streams.Stream_Element_Offset(Number_Bytes)), 225 Last => Result_Last, 226 To => Gnat.Sockets.Sock_Addr_Type(To_Address)); 227-- put_line("Num bytes" & Ada.Streams.Stream_Element_Offset'image(result_last)); 228 229 if Result_Last /= Ada.Streams.Stream_Element_Offset(Number_Bytes) then 230 Failure := True; 231 else 232 Failure := False; 233 end if; 234 235 exception when others => 236 Failure := True; 237 end Send_DNS_Packet; 238 239end DNS_Network; 240