diff --git a/Makefile b/Makefile index 8f8c804..130ec1a 100644 --- a/Makefile +++ b/Makefile @@ -348,10 +348,12 @@ CFLAGS += -ffunction-sections -fdata-sections -Wl,--gc-sections CFLAGS += $(DEFINES) CFLAGS += $(INCLUDES) + ADAFLAGS += --RTS=/opt/GNAT/2019-arm-elf/arm-eabi/lib/gnat/ravenscar-sfp-stm32f429disco/ ADAFLAGS += -fno-common -Wall -Os -g3 ADAFLAGS += -mcpu=cortex-m7 -mthumb -mfpu=fpv5-d16 -mfloat-abi=hard ADAFLAGS += -ffunction-sections -fdata-sections -Wl,--gc-sections +ADAFLAGS += -gnatA -gnatwa -gnatw_A -gnatQ -gnatw.X ADA_COMPILER = arm-eabi-gcc diff --git a/src/ada/ada_main.adb b/src/ada/ada_main.adb index b2604f1..97d5f4b 100644 --- a/src/ada/ada_main.adb +++ b/src/ada/ada_main.adb @@ -1,12 +1,28 @@ -with Ada_Socket; use Ada_Socket; +with Socket_interface; use Socket_interface; +with socket_binding; use socket_binding; +with Ip; use Ip; +with Interfaces.C; use Interfaces.C; package body Ada_Main is - function Ada_Open_Socket (S_Type: Sock_Type; protocol: Sock_Protocol) - return Socket - is + procedure HTTP_Client_Test is + Sock : Socket_Struct; + ServerAddr : IpAddr; + Request : constant char_array := "GET /anything HTTP/1.1\r\nHost: httpbin.org\r\nConnection: close\r\n\r\n"; + Buf : char_array (1 .. 128); + Ret : Integer; begin - return socketOpen(S_Type, protocol); - end Ada_Open_Socket; + Get_Host_By_Name("httpbin.org", ServerAddr); + Socket_Open (Sock, SOCKET_TYPE_STREAM, SOCKET_IP_PROTO_TCP); + Socket_Set_Timeout(Sock, 30000); + Socket_Connect(Sock, ServerAddr, 80); + Socket_Send(Sock, Request); + loop + Ret := Socket_Receive (Sock, Buf); + exit when Ret /= 0; + end loop; + Socket_Shutdown(Sock); + Socket_Close(Sock); + end HTTP_Client_Test; end Ada_Main; diff --git a/src/ada/ada_main.ads b/src/ada/ada_main.ads index 074d242..36a0f31 100644 --- a/src/ada/ada_main.ads +++ b/src/ada/ada_main.ads @@ -1,12 +1,9 @@ -with Ada_Socket; use Ada_Socket; - package Ada_Main is - function Ada_Open_Socket (S_Type: Sock_Type; protocol: Sock_Protocol) - return Socket + procedure HTTP_Client_Test with Export => True, Convention => C, - External_Name => "ada_open_socket"; + External_Name => "http_client_test"; end Ada_Main; diff --git a/src/ada/ada_socket.ads b/src/ada/ada_socket.ads index 7aeabc1..4a4c09d 100644 --- a/src/ada/ada_socket.ads +++ b/src/ada/ada_socket.ads @@ -2,15 +2,21 @@ with Interfaces.C; use Interfaces.C; with Net; use Net; with Compiler_Port; use Compiler_Port; with Tcp; use Tcp; -with Ip; use Ip; +with Error_H; use Error_H; +with Systeme; -package Ada_Socket is +package Socket_Binding is + + MAX_BYTES : constant := 128 type Sock_Descriptor is new unsigned; type Sock_Type is new unsigned; type Sock_Protocol is new unsigned; type Sock_Port is new unsigned_short; type SackBlockArray is array (0 .. 3) of Tcp_Sack_Block; + type uint8 is mod 2 ** 8; + subtype Index is unsigned range 0 .. MAX_BYTES; + type Block8 is array (Index range <>) of uint8; type OsEvent is record @@ -18,98 +24,142 @@ package Ada_Socket is end record with Convention => C; - type Socket is - record - S_Descriptor: Sock_Descriptor; - S_Type: Sock_Type; - S_Protocol: Sock_Protocol; - S_NetInterface: access Net_Interface; - S_localIpAddr: IpAddr; - S_Local_Port: Sock_Port; - S_remoteIpAddr: IpAddr; - S_Remote_Port: Sock_Port; - S_Timeout: Compiler_Port.Systime; - S_TTL: unsigned_char; - S_Multicast_TTL: unsigned_char; - S_errnoCode: int; - S_event: OsEvent; - S_Event_Mask: unsigned; - S_Event_Flags: unsigned; - userEvent: access OsEvent; + -- type Socket is + -- record + -- S_Descriptor: Sock_Descriptor; + -- S_Type: Sock_Type; + -- S_Protocol: Sock_Protocol; + -- S_NetInterface: access Net_Interface; + -- S_localIpAddr: IpAddr; + -- S_Local_Port: Sock_Port; + -- S_remoteIpAddr: IpAddr; + -- S_Remote_Port: Sock_Port; + -- S_Timeout: Compiler_Port.Systime; + -- S_TTL: unsigned_char; + -- S_Multicast_TTL: unsigned_char; + -- S_errnoCode: int; + -- S_event: OsEvent; + -- S_Event_Mask: unsigned; + -- S_Event_Flags: unsigned; + -- userEvent: access OsEvent; - -- TCP specific variables - State: Tcp_State; - owned_Flag: Bool; - closed_Flag: Bool; - reset_Flag: Bool; + -- -- TCP specific variables + -- State: Tcp_State; + -- owned_Flag: Bool; + -- closed_Flag: Bool; + -- reset_Flag: Bool; - smss: unsigned_short; - rmss: unsigned_short; - iss: unsigned_long; - irs: unsigned_long; + -- smss: unsigned_short; + -- rmss: unsigned_short; + -- iss: unsigned_long; + -- irs: unsigned_long; - sndUna: unsigned_long; - sndNxt: unsigned_long; - sndUser: unsigned_short; - sndWnd: unsigned_short; - maxSndWnd: unsigned_short; - sndWl1: unsigned_long; - sndWl2: unsigned_long; + -- sndUna: unsigned_long; + -- sndNxt: unsigned_long; + -- sndUser: unsigned_short; + -- sndWnd: unsigned_short; + -- maxSndWnd: unsigned_short; + -- sndWl1: unsigned_long; + -- sndWl2: unsigned_long; - rcvNxt: unsigned_long; - rcvUser: unsigned_short; - rcvWnd: unsigned_short; + -- rcvNxt: unsigned_long; + -- rcvUser: unsigned_short; + -- rcvWnd: unsigned_short; - rttBusy: Bool; - rttSeqNum: unsigned_long; - rettStartTime: Systime; - srtt: Systime; - rttvar: Systime; - rto: Systime; + -- rttBusy: Bool; + -- rttSeqNum: unsigned_long; + -- rettStartTime: Systime; + -- srtt: Systime; + -- rttvar: Systime; + -- rto: Systime; - congestState: TCP_Congest_State; - cwnd: unsigned_short; - ssthresh: unsigned_short; - dupAckCount: unsigned; - n: unsigned; - recover: unsigned_long; + -- congestState: TCP_Congest_State; + -- cwnd: unsigned_short; + -- ssthresh: unsigned_short; + -- dupAckCount: unsigned; + -- n: unsigned; + -- recover: unsigned_long; - txBuffer: Tcp_Tx_Buffer; - txBufferSize: unsigned_long; - rxBuffer: Tcp_Rx_Buffer; - rxBufferSize: unsigned_long; + -- txBuffer: Tcp_Tx_Buffer; + -- txBufferSize: unsigned_long; + -- rxBuffer: Tcp_Rx_Buffer; + -- rxBufferSize: unsigned_long; - retransmitQueue: access TcpQueueItem; - retransmitTimer: Tcp_Timer; - retransmitCount: unsigned; + -- retransmitQueue: access TcpQueueItem; + -- retransmitTimer: Tcp_Timer; + -- retransmitCount: unsigned; - -- Not good type. Just used to denote a pointer - synQueue: access TcpQueueItem; - synQueueSize: unsigned; + -- -- TODO: Not good type. Just used to denote a pointer + -- synQueue: access TcpQueueItem; + -- synQueueSize: unsigned; - wndProbeCount: unsigned; - wndProbeInterval: Systime; + -- wndProbeCount: unsigned; + -- wndProbeInterval: Systime; - persistTimer: Tcp_Timer; - overrideTimer: Tcp_Timer; - finWait2Timer: Tcp_Timer; - timeWaitTimer: Tcp_Timer; + -- persistTimer: Tcp_Timer; + -- overrideTimer: Tcp_Timer; + -- finWait2Timer: Tcp_Timer; + -- timeWaitTimer: Tcp_Timer; - sackPermitted: Bool; - sackBlock: SackBlockArray; - sackBlockCount: unsigned; + -- sackPermitted: Bool; + -- sackBlock: SackBlockArray; + -- sackBlockCount: unsigned; - -- should be socketQueueItem here - receiveQueue: access TcpQueueItem; + -- -- TODO: should be socketQueueItem here + -- receiveQueue: access TcpQueueItem; - end record - with Convention => C; - + -- end record + -- with Convention => C; + + type Socket is new Systeme.Address; + type IpAddr is new Systeme.Address; + function socketOpen (S_Type: Sock_Type; protocol: Sock_Protocol) return Socket with Import => True, Convention => C, External_Name => "socketOpen"; + + function socketSetTimeout (sock: Socket; timeout: Systime) return Error_T + with + Import => True, + Convention => C, + External_Name => "socketSetTimeout"; + function socketConnect (sock: Socket; remoteIpAddr: IpAddr; remotePort: Sock_Port) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketConnect"; + + function socketSend (sock: Socket; data: Block8; length: unsigned; written: out unsigned; flags: unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketSend"; + + function socketReceive(sock: Socket; data: out Block8; size: unsigned; received: out unsigned; flags: unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketReceive"; + + function socketShutdown (sock: Socket; how: unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketShutdown"; + + procedure socketClose (sock: Socket) + with + Import => True, + Convention => C, + External_Name => "socketClose"; + + -end Ada_Socket; +end Socket_Binding; diff --git a/src/ada/error_h.ads b/src/ada/error_h.ads new file mode 100644 index 0000000..a2f6060 --- /dev/null +++ b/src/ada/error_h.ads @@ -0,0 +1,207 @@ +pragma Ada_2012; +pragma Style_Checks (Off); + +with Interfaces.C; use Interfaces.C; + +package Error_H is + + subtype error_t is unsigned; + NO_ERROR : constant unsigned := 0; + ERROR_FAILURE : constant unsigned := 1; + ERROR_INVALID_PARAMETER : constant unsigned := 2; + ERROR_PARAMETER_OUT_OF_RANGE : constant unsigned := 3; + ERROR_BAD_CRC : constant unsigned := 4; + ERROR_BAD_BLOCK : constant unsigned := 5; + ERROR_INVALID_RECIPIENT : constant unsigned := 6; + ERROR_INVALID_INTERFACE : constant unsigned := 7; + ERROR_INVALID_ENDPOINT : constant unsigned := 8; + ERROR_INVALID_ALT_SETTING : constant unsigned := 9; + ERROR_UNSUPPORTED_REQUEST : constant unsigned := 10; + ERROR_UNSUPPORTED_CONFIGURATION : constant unsigned := 11; + ERROR_UNSUPPORTED_FEATURE : constant unsigned := 12; + ERROR_ENDPOINT_BUSY : constant unsigned := 13; + ERROR_USB_RESET : constant unsigned := 14; + ERROR_ABORTED : constant unsigned := 15; + ERROR_OUT_OF_MEMORY : constant unsigned := 100; + ERROR_OUT_OF_RESOURCES : constant unsigned := 101; + ERROR_INVALID_REQUEST : constant unsigned := 102; + ERROR_NOT_IMPLEMENTED : constant unsigned := 103; + ERROR_VERSION_NOT_SUPPORTED : constant unsigned := 104; + ERROR_INVALID_SYNTAX : constant unsigned := 105; + ERROR_AUTHENTICATION_FAILED : constant unsigned := 106; + ERROR_UNEXPECTED_RESPONSE : constant unsigned := 107; + ERROR_INVALID_RESPONSE : constant unsigned := 108; + ERROR_UNEXPECTED_VALUE : constant unsigned := 109; + ERROR_OPEN_FAILED : constant unsigned := 200; + ERROR_CONNECTION_FAILED : constant unsigned := 201; + ERROR_CONNECTION_REFUSED : constant unsigned := 202; + ERROR_CONNECTION_CLOSING : constant unsigned := 203; + ERROR_CONNECTION_RESET : constant unsigned := 204; + ERROR_NOT_CONNECTED : constant unsigned := 205; + ERROR_ALREADY_CLOSED : constant unsigned := 206; + ERROR_ALREADY_CONNECTED : constant unsigned := 207; + ERROR_INVALID_SOCKET : constant unsigned := 208; + ERROR_PROTOCOL_UNREACHABLE : constant unsigned := 209; + ERROR_PORT_UNREACHABLE : constant unsigned := 210; + ERROR_INVALID_FRAME : constant unsigned := 211; + ERROR_INVALID_HEADER : constant unsigned := 212; + ERROR_WRONG_CHECKSUM : constant unsigned := 213; + ERROR_WRONG_IDENTIFIER : constant unsigned := 214; + ERROR_WRONG_CLIENT_ID : constant unsigned := 215; + ERROR_WRONG_SERVER_ID : constant unsigned := 216; + ERROR_WRONG_COOKIE : constant unsigned := 217; + ERROR_NO_RESPONSE : constant unsigned := 218; + ERROR_RECEIVE_QUEUE_FULL : constant unsigned := 219; + ERROR_TIMEOUT : constant unsigned := 220; + ERROR_WOULD_BLOCK : constant unsigned := 221; + ERROR_INVALID_NAME : constant unsigned := 222; + ERROR_INVALID_OPTION : constant unsigned := 223; + ERROR_UNEXPECTED_STATE : constant unsigned := 224; + ERROR_INVALID_COMMAND : constant unsigned := 225; + ERROR_INVALID_PROTOCOL : constant unsigned := 226; + ERROR_INVALID_STATUS : constant unsigned := 227; + ERROR_INVALID_ADDRESS : constant unsigned := 228; + ERROR_INVALID_MESSAGE : constant unsigned := 229; + ERROR_INVALID_KEY : constant unsigned := 230; + ERROR_INVALID_KEY_LENGTH : constant unsigned := 231; + ERROR_INVALID_EPOCH : constant unsigned := 232; + ERROR_INVALID_SEQUENCE_NUMBER : constant unsigned := 233; + ERROR_INVALID_CHARACTER : constant unsigned := 234; + ERROR_INVALID_LENGTH : constant unsigned := 235; + ERROR_INVALID_PADDING : constant unsigned := 236; + ERROR_INVALID_MAC : constant unsigned := 237; + ERROR_INVALID_TAG : constant unsigned := 238; + ERROR_INVALID_TYPE : constant unsigned := 239; + ERROR_INVALID_VALUE : constant unsigned := 240; + hERROR_UNSUPPORTED_CIPHER_SUITE : constant unsigned := 251; + ERROR_UNSUPPORTED_CIPHER_MODE : constant unsigned := 252; + ERROR_UNSUPPORTED_CIPHER_ALGO : constant unsigned := 253; + ERROR_UNSUPPORTED_HASH_ALGO : constant unsigned := 254; + ERROR_UNSUPPORTED_KEY_EXCH_METHOD : constant unsigned := 255; + ERROR_UNSUPPORTED_SIGNATURE_ALGO : constant unsigned := 256; + ERROR_UNSUPPORTED_ELLIPTIC_CURVE : constant unsigned := 257; + ERROR_INVALID_SIGNATURE_ALGO : constant unsigned := 258; + ERROR_CERTIFICATE_REQUIRED : constant unsigned := 259; + ERROR_MESSAGE_TOO_LONG : constant unsigned := 260; + ERROR_OUT_OF_RANGE : constant unsigned := 261; + ERROR_MESSAGE_DISCARDED : constant unsigned := 262; + ERROR_INVALID_PACKET : constant unsigned := 263; + ERROR_BUFFER_EMPTY : constant unsigned := 264; + ERROR_BUFFER_OVERFLOW : constant unsigned := 265; + ERROR_BUFFER_UNDERFLOW : constant unsigned := 266; + ERROR_INVALID_RESOURCE : constant unsigned := 267; + ERROR_INVALID_PATH : constant unsigned := 268; + ERROR_NOT_FOUND : constant unsigned := 269; + ERROR_ACCESS_DENIED : constant unsigned := 270; + ERROR_NOT_WRITABLE : constant unsigned := 271; + ERROR_AUTH_REQUIRED : constant unsigned := 272; + ERROR_TRANSMITTER_BUSY : constant unsigned := 273; + ERROR_NO_RUNNING : constant unsigned := 274; + ERROR_INVALID_FILE : constant unsigned := 300; + ERROR_FILE_NOT_FOUND : constant unsigned := 301; + ERhROR_INVALID_DIRECTORY : constant unsigned := 307; + ERROR_DIRECTORY_NOT_FOUND : constant unsigned := 308; + ERROR_FILE_SYSTEM_NOT_SUPPORTED : constant unsigned := 400; + ERROR_UNKNOWN_FILE_SYSTEM : constant unsigned := 401; + ERROR_INVALID_FILE_SYSTEM : constant unsigned := 402; + ERROR_INVALID_BOOT_SECTOR_SIGNATURE : constant unsigned := 403; + ERROR_INVALID_SECTOR_SIZE : constant unsigned := 404; + ERROR_INVALID_CLUSTER_SIZE : constant unsigned := 405; + ERROR_INVALID_FILE_RECORD_SIZE : constant unsigned := 406; + ERROR_INVALID_INDEX_BUFFER_SIZE : constant unsigned := 407; + ERROR_INVALID_VOLUME_DESCRIPTOR_SIGNATURE : constant unsigned := 408; + ERROR_INVALID_VOLUME_DESCRIPTOR : constant unsigned := 409; + ERROR_INVALID_FILE_RECORD : constant unsigned := 410; + ERROR_INVALID_INDEX_BUFFER : constant unsigned := 411; + ERROR_INVALID_DATA_RUNS : constant unsigned := 412; + ERROR_WRONG_TAG_IDENTIFIER : constant unsigned := 413; + ERROR_WRONG_TAG_CHECKSUM : constant unsigned := 414; + ERROR_WRONG_MAGIC_NUMBER : constant unsigned := 415; + ERROR_WRONG_SEQUENCE_NUMBER : constant unsigned := 416; + ERROR_DESCRIPTOR_NOT_FOUND : constant unsigned := 417; + ERROR_ATTRIBUTE_NOT_FOUND : constant unsigned := 418; + ERROR_RESIDENT_ATTRIBUTE : constant unsigned := 419; + ERROR_NOT_RESIDENT_ATTRIBUTE : constant unsigned := 420; + ERROR_INVALID_SUPER_BLOCK : constant unsigned := 421; + ERROR_INVALID_SUPER_BLOCK_SIGNATURE : constant unsigned := 422; + ERROR_INVALID_BLOCK_SIZE : constant unsigned := 423; + ERROR_UNSUPPORTED_REVISION_LEVEL : constant unsigned := 424; + ERROR_INVALID_INODE_SIZE : constant unsigned := 425; + ERROR_INODE_NOT_FOUND : constant unsigned := 426; + ERROR_UNEXPECTED_MESSAGE : constant unsigned := 500; + ERROR_URL_TOO_LONG : constant unsigned := 501; + ERROR_QUERY_STRING_TOO_LONG : constant unsigned := 502; + ERROR_NO_ADDRESS : constant unsigned := 503; + ERROR_NO_BINDING : constant unsigned := 504; + ERROR_NOT_ON_LINK : constant unsigned := 505; + ERROR_USE_MULTICAST : constant unsigned := 506; + ERROR_NAK_RECEIVED : constant unsigned := 507; + ERROR_EXCEPTION_RECEIVED : constant unsigned := 508; + ERROR_NO_CARRIER : constant unsigned := 509; + ERROR_INVALID_LEVEL : constant unsigned := 510; + ERROR_WRONG_STATE : constant unsigned := 511; + ERROR_END_OF_STREAM : constant unsigned := 512; + ERROR_LINK_DOWN : constant unsigned := 513; + ERROR_INVALID_OPTION_LENGTH : constant unsigned := 514; + ERROR_IN_PROGRESS : constant unsigned := 515; + ERROR_NO_ACK : constant unsigned := 516; + ERROR_INVALID_METADATA : constant unsigned := 517; + ERROR_NOT_CONFIGURED : constant unsigned := 518; + ERROR_NAME_RESOLUTION_FAILED : constant unsigned := 519; + ERROR_NO_ROUTE : constant unsigned := 520; + ERROR_WRITE_FAILED : constant unsigned := 521; + ERROR_READ_FAILED : constant unsigned := 522; + ERROR_UPLOAD_FAILED : constant unsigned := 523; + ERROR_READ_ONLY_ACCESS : constant unsigned := 524; + ERROR_INVALID_SIGNATURE : constant unsigned := 525; + ERROR_INVALID_TICKET : constant unsigned := 526; + ERROR_BAD_RECORD_MAC : constant unsigned := 527; + ERROR_RECORD_OVERFLOW : constant unsigned := 528; + ERROR_HANDSHAKE_FAILED : constant unsigned := 529; + ERROR_NO_CERTIFICATE : constant unsigned := 530; + ERROR_BAD_CERTIFICATE : constant unsigned := 531; + ERROR_UNSUPPORTED_CERTIFICATE : constant unsigned := 532; + ERROR_CERTIFICATE_EXPIRED : constant unsigned := 533; + ERROR_CERTIFICATE_REVOKED : constant unsigned := 534; + ERROR_UNKNOWN_CA : constant unsigned := 535; + ERROR_DECODING_FAILED : constant unsigned := 536; + ERROR_DECRYPTION_FAILED : constant unsigned := 537; + ERROR_ILLEGAL_PARAMETER : constant unsigned := 538; + ERROR_MISSING_EXTENSION : constant unsigned := 539; + ERROR_UNSUPPORTED_EXTENSION : constant unsigned := 540; + ERROR_INAPPROPRIATE_FALLBACK : constant unsigned := 541; + ERROR_NO_APPLICATION_PROTOCOL : constant unsigned := 542; + ERROR_MORE_DATA_REQUIRED : constant unsigned := 543; + ERROR_TLS_NOT_SUPPORTED : constant unsigned := 544; + ERROR_PRNG_NOT_READY : constant unsigned := 545; + ERROR_SERVICE_CLOSING : constant unsigned := 546; + ERROR_INVALID_TIMESTAMP : constant unsigned := 547; + ERROR_NO_DNS_SERVER : constant unsigned := 548; + ERROR_OBJECT_NOT_FOUND : constant unsigned := 549; + ERROR_INSTANCE_NOT_FOUND : constant unsigned := 550; + ERROR_ADDRESS_NOT_FOUND : constant unsigned := 551; + ERROR_UNKNOWN_IDENTITY : constant unsigned := 552; + ERROR_UNKNOWN_ENGINE_ID : constant unsigned := 553; + ERROR_UNKNOWN_USER_NAME : constant unsigned := 554; + ERROR_UNKNOWN_CONTEXT : constant unsigned := 555; + ERROR_UNAVAILABLE_CONTEXT : constant unsigned := 556; + ERROR_UNSUPPORTED_SECURITY_LEVEL : constant unsigned := 557; + ERROR_NOT_IN_TIME_WINDOW : constant unsigned := 558; + ERROR_AUTHORIZATION_FAILED : constant unsigned := 559; + ERROR_INVALID_FUNCTION_CODE : constant unsigned := 560; + ERROR_DEVICE_BUSY : constant unsigned := 561; + ERROR_REQUEST_REJECTED : constant unsigned := 562; + ERROR_INVALID_CHANNEL : constant unsigned := 563; + ERROR_UNKNOWN_SERVICE : constant unsigned := 564; + ERROR_UNKNOWN_REQUEST : constant unsigned := 565; + ERROR_FLOW_CONTROL : constant unsigned := 566; + ERROR_INVALID_PASSWORD : constant unsigned := 567; + ERROR_INVALID_HANDLE : constant unsigned := 568; + ERROR_BAD_NONCE : constant unsigned := 569; + ERROR_UNEXPECTED_STATUS : constant unsigned := 570; + ERROR_RESPONSE_TOO_LARGE : constant unsigned := 571; + ERROR_NO_MATCH : constant unsigned := 572; + ERROR_PARTIAL_MATCH : constant unsigned := 573; -- ./src/common/error.h:282 + + +end Error_H; diff --git a/src/ada/socket_binding.ads b/src/ada/socket_binding.ads new file mode 100644 index 0000000..0764558 --- /dev/null +++ b/src/ada/socket_binding.ads @@ -0,0 +1,176 @@ +with Interfaces.C; use Interfaces.C; +with Net; use Net; +-- with Compiler_Port; use Compiler_Port; +with Tcp; use Tcp; +with Error_H; use Error_H; +with System; +with Ip; use Ip; + +package Socket_Binding is + + MAX_BYTES : constant := 128; + + -- type IpAddr is new System.Address; + + type Bool is new int; + type Systime is new unsigned_long; + + type Sock_Descriptor is new unsigned; + type Sock_Type is new unsigned; + type Sock_Protocol is new unsigned; + type Sock_Port is new unsigned_short; + type SackBlockArray is array (0 .. 3) of Tcp_Sack_Block; + type uint8 is mod 2 ** 8; + subtype Index is unsigned range 0 .. MAX_BYTES; + type Block8 is array (Index range <>) of uint8; + + type OsEvent is + record + handle: access TcpQueueItem; + end record + with Convention => C; + + type Socket is + record + S_Descriptor: Sock_Descriptor; + S_Type: Sock_Type; + S_Protocol: Sock_Protocol; + S_NetInterface: access Net_Interface; + S_localIpAddr: IpAddr; + S_Local_Port: Sock_Port; + S_remoteIpAddr: IpAddr; + S_Remote_Port: Sock_Port; + S_Timeout: Systime; + S_TTL: unsigned_char; + S_Multicast_TTL: unsigned_char; + S_errnoCode: int; + S_event: OsEvent; + S_Event_Mask: unsigned; + S_Event_Flags: unsigned; + userEvent: access OsEvent; + + -- TCP specific variables + State: Tcp_State; + owned_Flag: Bool; + closed_Flag: Bool; + reset_Flag: Bool; + + smss: unsigned_short; + rmss: unsigned_short; + iss: unsigned_long; + irs: unsigned_long; + + sndUna: unsigned_long; + sndNxt: unsigned_long; + sndUser: unsigned_short; + sndWnd: unsigned_short; + maxSndWnd: unsigned_short; + sndWl1: unsigned_long; + sndWl2: unsigned_long; + + rcvNxt: unsigned_long; + rcvUser: unsigned_short; + rcvWnd: unsigned_short; + + rttBusy: Bool; + rttSeqNum: unsigned_long; + rettStartTime: Systime; + srtt: Systime; + rttvar: Systime; + rto: Systime; + + congestState: TCP_Congest_State; + cwnd: unsigned_short; + ssthresh: unsigned_short; + dupAckCount: unsigned; + n: unsigned; + recover: unsigned_long; + + txBuffer: Tcp_Tx_Buffer; + txBufferSize: unsigned_long; + rxBuffer: Tcp_Rx_Buffer; + rxBufferSize: unsigned_long; + + retransmitQueue: access TcpQueueItem; + retransmitTimer: Tcp_Timer; + retransmitCount: unsigned; + + synQueue: System.Address; + synQueueSize: unsigned; + + wndProbeCount: unsigned; + wndProbeInterval: Systime; + + persistTimer: Tcp_Timer; + overrideTimer: Tcp_Timer; + finWait2Timer: Tcp_Timer; + timeWaitTimer: Tcp_Timer; + + sackPermitted: Bool; + sackBlock: SackBlockArray; + sackBlockCount: unsigned; + + receiveQueue: System.Address; + + end record + with Convention => C; + + type Socket_Struct is access Socket; + -- + + function getHostByName(Net_Interface : System.Address; Server_Name : char_array; Serveur_Ip_Addr: out IpAddr; Flags : unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "getHostByName"; + + function socketOpen (S_Type: Sock_Type; protocol: Sock_Protocol) return Socket_Struct + with + Import => True, + Convention => C, + External_Name => "socketOpen"; + + function socketSetTimeout (sock: Socket_Struct; timeout: Systime) return Error_T + with + Import => True, + Convention => C, + External_Name => "socketSetTimeout"; + + function socketConnect (sock: Socket_Struct; remoteIpAddr: IpAddr; remotePort: Sock_Port) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketConnect"; + + function socketSend (sock: Socket_Struct; data: char_array; length: unsigned; written: out unsigned; flags: unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketSend"; + + function socketReceive(sock: Socket_Struct; data: out char_array; size: unsigned; received: out unsigned; flags: unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketReceive"; + + function socketShutdown (sock: Socket_Struct; how: unsigned) + return Error_T + with + Import => True, + Convention => C, + External_Name => "socketShutdown"; + + procedure socketClose (sock: Socket_Struct) + with + Import => True, + Convention => C, + External_Name => "socketClose"; + + + +end Socket_Binding; diff --git a/src/ada/socket_interface.adb b/src/ada/socket_interface.adb new file mode 100644 index 0000000..042c0c9 --- /dev/null +++ b/src/ada/socket_interface.adb @@ -0,0 +1,80 @@ +with System; + +package body Socket_interface is + + + procedure Get_Host_By_Name ( + Server_Name : char_array; + Server_Ip_Addr : out IpAddr) + is + Ret : unsigned; + Null_pointer : System.Address; + begin + Ret := getHostByName(Null_pointer, (Server_Name), Server_Ip_Addr, 0); + end; + + + procedure Socket_Open ( + Sock: in out Socket_Struct; + S_Type: Socket_Type; + S_Protocol: Socket_Protocol) + is + begin + Sock := socketOpen(1, 6); + end Socket_Open; + + + procedure Socket_Set_Timeout ( + sock : Socket_Struct; + timeout : Systime) + is + Ret : unsigned; + begin + Ret := socketSetTimeout(Sock, timeout); + end Socket_Set_Timeout; + + procedure Socket_Connect ( + Sock: Socket_Struct; + Remote_Ip_Addr : IpAddr; + Remote_Port : Sock_Port) + is + Ret : unsigned; + begin + Ret := socketConnect (Sock, Remote_Ip_Addr, Remote_Port); + end Socket_Connect; + + procedure Socket_Send ( + Sock: Socket_Struct; + Data: char_array) + is + Ret, Written : unsigned; + begin + Ret := socketSend(Sock, Data, Data'Length, Written, 0); + end Socket_Send; + + function Socket_Receive( + Sock: Socket_Struct; + Buf: out char_array) + return Integer + is + Ret, Received : unsigned; + begin + return Integer(socketReceive(Sock, Buf, Buf'Length - 1, Received, 0)); + end Socket_Receive; + + procedure Socket_Shutdown ( + Sock: Socket_Struct) + is + Ret : unsigned; + begin + Ret := socketShutdown(Sock, 2); + end Socket_Shutdown; + + procedure Socket_Close (Sock : Socket_Struct) + is + begin + socketClose (Sock); + end Socket_Close; + + +end Socket_interface; \ No newline at end of file diff --git a/src/ada/socket_interface.ads b/src/ada/socket_interface.ads new file mode 100644 index 0000000..dc8bbd8 --- /dev/null +++ b/src/ada/socket_interface.ads @@ -0,0 +1,166 @@ +with Interfaces.C; use Interfaces.C; +with Socket_Binding; use Socket_Binding; +with Ip; use Ip; + +package Socket_Interface +with Spark_Mode +is + + Socket_error : exception; + + type Port is range 0 .. 2 ** 16; + +-- type Socket is +-- record +-- S_Descriptor: Sock_Descriptor; +-- S_Type: Sock_Type; +-- S_Protocol: Sock_Protocol; +-- S_NetInterface: access Net_Interface; +-- S_localIpAddr: IpAddr; +-- S_Local_Port: Sock_Port; +-- S_remoteIpAddr: IpAddr; +-- S_Remote_Port: Sock_Port; +-- S_Timeout: Compiler_Port.Systime; +-- S_TTL: unsigned_char; +-- S_Multicast_TTL: unsigned_char; +-- S_errnoCode: int; +-- S_event: OsEvent; +-- S_Event_Mask: unsigned; +-- S_Event_Flags: unsigned; +-- userEvent: access OsEvent; + +-- -- TCP specific variables +-- State: Tcp_State; +-- owned_Flag: Bool; +-- closed_Flag: Bool; +-- reset_Flag: Bool; + +-- smss: unsigned_short; +-- rmss: unsigned_short; +-- iss: unsigned_long; +-- irs: unsigned_long; + +-- sndUna: unsigned_long; +-- sndNxt: unsigned_long; +-- sndUser: unsigned_short; +-- sndWnd: unsigned_short; +-- maxSndWnd: unsigned_short; +-- sndWl1: unsigned_long; +-- sndWl2: unsigned_long; + +-- rcvNxt: unsigned_long; +-- rcvUser: unsigned_short; +-- rcvWnd: unsigned_short; + +-- rttBusy: Bool; +-- rttSeqNum: unsigned_long; +-- rettStartTime: Systime; +-- srtt: Systime; +-- rttvar: Systime; +-- rto: Systime; + +-- congestState: TCP_Congest_State; +-- cwnd: unsigned_short; +-- ssthresh: unsigned_short; +-- dupAckCount: unsigned; +-- n: unsigned; +-- recover: unsigned_long; + +-- txBuffer: Tcp_Tx_Buffer; +-- txBufferSize: unsigned_long; +-- rxBuffer: Tcp_Rx_Buffer; +-- rxBufferSize: unsigned_long; + +-- retransmitQueue: access TcpQueueItem; +-- retransmitTimer: Tcp_Timer; +-- retransmitCount: unsigned; + +-- -- TODO: Not good type. Just used to denote a pointer +-- synQueue: access TcpQueueItem; +-- synQueueSize: unsigned; + +-- wndProbeCount: unsigned; +-- wndProbeInterval: Systime; + +-- persistTimer: Tcp_Timer; +-- overrideTimer: Tcp_Timer; +-- finWait2Timer: Tcp_Timer; +-- timeWaitTimer: Tcp_Timer; + +-- sackPermitted: Bool; +-- sackBlock: SackBlockArray; +-- sackBlockCount: unsigned; + +-- -- TODO: should be socketQueueItem here +-- receiveQueue: access TcpQueueItem; + +-- end record; + + type Socket_Type is ( + SOCKET_TYPE_UNUSED, + SOCKET_TYPE_STREAM, + SOCKET_TYPE_DGRAM, + SOCKET_TYPE_RAW_IP, + SOCKET_TYPE_RAW_ETH + ); + + for Socket_Type use ( + SOCKET_TYPE_UNUSED => 0, + SOCKET_TYPE_STREAM => 1, + SOCKET_TYPE_DGRAM => 2, + SOCKET_TYPE_RAW_IP => 3, + SOCKET_TYPE_RAW_ETH => 4 + ); + + type Socket_Protocol is ( + SOCKET_IP_PROTO_ICMP, + SOCKET_IP_PROTO_IGMP, + SOCKET_IP_PROTO_TCP, + SOCKET_IP_PROTO_UDP, + SOCKET_IP_PROTO_ICMPV6 + ); + + for Socket_Protocol use ( + SOCKET_IP_PROTO_ICMP => 1, + SOCKET_IP_PROTO_IGMP => 2, + SOCKET_IP_PROTO_TCP => 6, + SOCKET_IP_PROTO_UDP => 17, + SOCKET_IP_PROTO_ICMPV6 => 58 + ); + + procedure Get_Host_By_Name ( + Server_Name : char_array; + Server_Ip_Addr : out IpAddr); + + procedure Socket_Open ( + Sock: in out Socket_Struct; + S_Type: Socket_Type; + S_Protocol: Socket_Protocol); + + procedure Socket_Set_Timeout ( + sock: Socket_Struct; + timeout: Systime); + + procedure Socket_Connect ( + Sock : Socket_Struct; + Remote_Ip_Addr : IpAddr; + Remote_Port : Sock_Port); + + procedure Socket_Send ( + Sock: Socket_Struct; + Data : char_array); + + function Socket_Receive ( + Sock: Socket_Struct; + Buf : out char_array) + return Integer + with + Pre => Buf'Length > 0; + + procedure Socket_Shutdown ( + Sock: Socket_Struct); + + procedure Socket_Close ( + Sock: Socket_Struct); + +end Socket_Interface; \ No newline at end of file