ada/Http_Cyclone
0
0
Fork 0
mirror of https://github.com/AdaCore/Http_Cyclone.git synced 2026-02-12 13:07:39 -08:00
Code Issues Packages Projects Releases Wiki Activity

Ada binding

Browse Source
This commit is contained in:
Guillaume Cluzel
2020-04-03 16:07:30 +02:00
parent 8632177f55
commit ade629ecdc
8 changed files with 781 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@@ -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

28
src/ada/ada_main.adb
View File

@@ -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;

7
src/ada/ada_main.ads
View File

@@ -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;

202
src/ada/ada_socket.ads
View File

@@ -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;

207
src/ada/error_h.ads Normal file
View File

@@ -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;

176
src/ada/socket_binding.ads Normal file
View File

@@ -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;

80
src/ada/socket_interface.adb Normal file
View File

@@ -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;

166
src/ada/socket_interface.ads Normal file
View File

@@ -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;