Hi,
Post by t***@acm.orgPost by Yannick Duchêne (Hibou57)Except (I just looked at the source) I personally don't enjoy bindings
which end to introduce C like namings [*] in Ada. Things like PF_INET,
IPPROTO_IP or SOL_SOCKET looks really strange for an Ada source;
A thicker binding is NC sockets ("Not Claw", derived from Claw.Sockets).
It's nc.zip at www.adaworld.com, look there under
Ada Projects/Ada Internet Projects/Internet Protocols
It's for Windows but IIRC the WSAStartup and WSACleanup should be
the only Windows specific things.
Here is a diff which allows the package to compile on OpenBSD/amd64.
(It includes also some filename upper/lower case corrections, so
the diff is pretty big.)
The example programs still segfault. I guess the datastructure
definitions are incorrect.
diff -r f734a2862510 -r 2cca25a3f5f4 GETJPG.ADB
--- a/GETJPG.ADB Tue Dec 21 19:45:44 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,75 +0,0 @@
--- Sample program using NC.Sockets
--- It goes to the San Jose State weathercam and downloads to pic.jpg
--- a picture of the current skyline in San Jose, California
--- Copyright 2003 ***@acm.org anyone may use for any purpose
-with Ada.Streams,
- Ada.Streams.Stream_IO,
- Ada.Text_IO,
- Nc.Sockets;
-procedure Getjpg is
- use type Ada.Streams.Stream_Element_Offset;
-
- Buffer : Ada.Streams.Stream_Element_Array(1 .. 5000);
- Last : Ada.Streams.Stream_Element_Offset;
- F : Ada.Streams.Stream_IO.File_Type;
- Socket : Nc.Sockets.Socket_Type;
- Length : Ada.Streams.Stream_Element_Offset := 0;
- type States is (Start, Seen_CR1, Seen_LF1, Seen_CR2, In_Data);
- subtype Header is States range Start .. Seen_Cr2;
- State : States := Start;
-
- procedure Write is
- use Ada.Streams;
- C : Character;
- Watch_For : constant array(Header) of Character
- := (Start => Ascii.CR, Seen_CR1 => Ascii.LF, Seen_LF1 => Ascii.CR,
- Seen_CR2 => Ascii.LF);
- begin
- if State = In_Data then
- Stream_IO.Write(F, Buffer(1 .. Last));
- Length := Length + Last;
- return;
- end if;
- for I in 1 .. Last loop
- C := Character'Val(Stream_Element'Pos(Buffer(I)));
- Ada.Text_IO.Put(C);
- if C = Watch_For(State) then
- State := States'succ(State);
- if State = In_Data then
- Stream_Io.Create(F, Stream_Io.Out_File, "pic.jpg");
- if I < Last then
- Stream_Io.Write(F, Buffer(I + 1 .. Last));
- Length := Last - I;
- end if;
- exit;
- end if;
- else
- State := Start;
- end if;
- end loop;
- end Write;
-
- procedure Stop is
- begin
- Ada.Text_IO.Put_Line(Ada.Streams.Stream_Element_Offset'Image(Length)
- & " file pic.jpg written");
- if Ada.Streams.Stream_IO.Is_Open(F) then
- Ada.Streams.Stream_IO.Close(F);
- end if;
- end Stop;
-
-begin
- Nc.Sockets.Open(Socket, "metsun1.met.sjsu.edu", 80, Timeout => 20.0);
- Nc.Sockets.Put_Line(Socket, "GET /cam_directory/latest.jpg HTTP/1.0");
- Nc.Sockets.Put_Line(Socket, "");
- loop
- Nc.Sockets.Input(Socket, Timeout => 10.0, Item => Buffer, Last => Last);
- exit when Last < Buffer'First;
- Write;
- end loop;
- Nc.Sockets.Close(Socket);
- Stop;
-exception
- when Nc.Not_Found_Error =>
- Stop;
-end Getjpg;
diff -r f734a2862510 -r 2cca25a3f5f4 NC.ADS
--- a/NC.ADS Tue Dec 21 19:45:44 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,19 +0,0 @@
-with Interfaces.C;
-package NC is
- type Short is new Interfaces.C.Short;
- type Int is new Interfaces.C.Int;
- subtype Natural_Int is Int range 0 .. Int'last;
- type UInt is new Interfaces.C.Unsigned;
- type DWord is new Interfaces.C.Unsigned_Long;
-
- type Byte is range 0 .. 255;
- for Byte'size use 8;
- type Word is mod 2**16;
- for Word'size use 16;
-
- Windows_Error,
- Not_Valid_Error,
- Already_Valid_Error,
- Not_Found_Error : Exception;
- type Lpcstr is access all Interfaces.C.Char;
-end NC;
diff -r f734a2862510 -r 2cca25a3f5f4 getjpg.adb
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/getjpg.adb Wed Dec 22 18:05:52 2010 +0200
@@ -0,0 +1,75 @@
+-- Sample program using NC.Sockets
+-- It goes to the San Jose State weathercam and downloads to pic.jpg
+-- a picture of the current skyline in San Jose, California
+-- Copyright 2003 ***@acm.org anyone may use for any purpose
+with Ada.Streams,
+ Ada.Streams.Stream_IO,
+ Ada.Text_IO,
+ Nc.Sockets;
+procedure Getjpg is
+ use type Ada.Streams.Stream_Element_Offset;
+
+ Buffer : Ada.Streams.Stream_Element_Array(1 .. 5000);
+ Last : Ada.Streams.Stream_Element_Offset;
+ F : Ada.Streams.Stream_IO.File_Type;
+ Socket : Nc.Sockets.Socket_Type;
+ Length : Ada.Streams.Stream_Element_Offset := 0;
+ type States is (Start, Seen_CR1, Seen_LF1, Seen_CR2, In_Data);
+ subtype Header is States range Start .. Seen_Cr2;
+ State : States := Start;
+
+ procedure Write is
+ use Ada.Streams;
+ C : Character;
+ Watch_For : constant array(Header) of Character
+ := (Start => Ascii.CR, Seen_CR1 => Ascii.LF, Seen_LF1 => Ascii.CR,
+ Seen_CR2 => Ascii.LF);
+ begin
+ if State = In_Data then
+ Stream_IO.Write(F, Buffer(1 .. Last));
+ Length := Length + Last;
+ return;
+ end if;
+ for I in 1 .. Last loop
+ C := Character'Val(Stream_Element'Pos(Buffer(I)));
+ Ada.Text_IO.Put(C);
+ if C = Watch_For(State) then
+ State := States'succ(State);
+ if State = In_Data then
+ Stream_Io.Create(F, Stream_Io.Out_File, "pic.jpg");
+ if I < Last then
+ Stream_Io.Write(F, Buffer(I + 1 .. Last));
+ Length := Last - I;
+ end if;
+ exit;
+ end if;
+ else
+ State := Start;
+ end if;
+ end loop;
+ end Write;
+
+ procedure Stop is
+ begin
+ Ada.Text_IO.Put_Line(Ada.Streams.Stream_Element_Offset'Image(Length)
+ & " file pic.jpg written");
+ if Ada.Streams.Stream_IO.Is_Open(F) then
+ Ada.Streams.Stream_IO.Close(F);
+ end if;
+ end Stop;
+
+begin
+ Nc.Sockets.Open(Socket, "metsun1.met.sjsu.edu", 80, Timeout => 20.0);
+ Nc.Sockets.Put_Line(Socket, "GET /cam_directory/latest.jpg HTTP/1.0");
+ Nc.Sockets.Put_Line(Socket, "");
+ loop
+ Nc.Sockets.Input(Socket, Timeout => 10.0, Item => Buffer, Last => Last);
+ exit when Last < Buffer'First;
+ Write;
+ end loop;
+ Nc.Sockets.Close(Socket);
+ Stop;
+exception
+ when Nc.Not_Found_Error =>
+ Stop;
+end Getjpg;
diff -r f734a2862510 -r 2cca25a3f5f4 nc-sockets-alt_gethostbyname.adb
--- a/nc-sockets-alt_gethostbyname.adb Tue Dec 21 19:45:44 2010 +0200
+++ b/nc-sockets-alt_gethostbyname.adb Wed Dec 22 18:05:52 2010 +0200
@@ -10,7 +10,7 @@
end loop;
Result.P_Hostent := NC.Sockets.B_Helper.gethostbyname(Result.C_Name(0)'unchecked_access);
if Result.P_Hostent = null then
- Result.Error := NC.Sockets.B_Helper.WSAGetLastError;
+ Result.Error := 0;
end if;
Result.Output_Ready:=True;
while not Result.Fini loop
diff -r f734a2862510 -r 2cca25a3f5f4 nc-sockets.adb
--- a/nc-sockets.adb Tue Dec 21 19:45:44 2010 +0200
+++ b/nc-sockets.adb Wed Dec 22 18:05:52 2010 +0200
@@ -32,6 +32,10 @@
use Claw.Sockets.Low_Level;
System_Control : System_Controls;
+ function WSAGetLastError return Error_Codes is
+ begin
+ return 0;
+ end WSAGetLastError;
procedure Get_Error_Code(Info : in out Host_Info_Type;
Error_Code : out Error_Codes) is
@@ -212,8 +216,10 @@
C_Name_Length : Size_T := Claw.sockets.Alt_Gethostbyname.C_Name_Type'length;
- function Get_Last_Error return Claw.DWord;
- pragma Import (StdCall, Get_Last_Error, "GetLastError");
+ function Get_Last_Error return Claw.DWord is
+ begin
+ return 0;
+ end Get_Last_Error;
begin
@@ -489,19 +495,13 @@
if Is_Running then
Error := 0;
else
- Error := WSAStartup(16#0101#, wsadata'access);
- if Error = 0 then
- Is_Running := True;
- end if;
+ Is_Running := True;
end if;
end Make_Running;
procedure Make_Stopped is
begin
if not Is_Running then return;end if;
- if WSACleanup = Socket_Error then
- raise Claw.windows_error; -- to be caught by Shut_Down
- end if;
Is_Running := False;
end Make_Stopped;
end Winsock_Systems;
diff -r f734a2862510 -r 2cca25a3f5f4 nc-sockets.ads
--- a/nc-sockets.ads Tue Dec 21 19:45:44 2010 +0200
+++ b/nc-sockets.ads Wed Dec 22 18:05:52 2010 +0200
@@ -8,7 +8,7 @@
package NC.Sockets is
package Claw renames NC;
- pragma Link_With("libwsock32.a");
+ -- pragma Link_With("libwsock32.a");
--
-- Edit History:
--
@@ -746,13 +746,13 @@
Host_Address_List_Ptr : Host_Address_List_Ptr_Type; -- h_addr_list
end record;
for Hostents use record
- Host_Name_Ptr at 0 range 0 .. 31;
- Host_Alias_Ptr_List at 4 range 0 .. 31;
- Host_Address_Kind at 8 range 0 .. 15;
- Host_Address_Length at 10 range 0 .. 15;
- Host_Address_List_Ptr at 12 range 0 .. 31;
+ Host_Name_Ptr at 0 range 0 .. 63;
+ Host_Alias_Ptr_List at 8 range 0 .. 63;
+ Host_Address_Kind at 16 range 0 .. 15;
+ Host_Address_Length at 18 range 0 .. 15;
+ Host_Address_List_Ptr at 20 range 0 .. 63;
end record;
- for Hostents'size use 16*8;
+ for Hostents'size use 224;
type Hostent_Ptr_Type is access all HOSTENTs;
@@ -782,9 +782,9 @@
Last_Error_Code : Error_Codes := 0;
end record;
for W_Host_Info_Type use record
- Hostent at 0 range 0 .. 16*8-1;
- Data_Area at 16 range 0 .. (MAXGETHOSTSTRUCT-16)*8-1;
- Last_Error_Code at MAXGETHOSTSTRUCT range 0 .. 31;
+ Hostent at 0 range 0 .. 224-1;
+ Data_Area at 32 range 0 .. (MAXGETHOSTSTRUCT-16)*8-1;
+ Last_Error_Code at (MAXGETHOSTSTRUCT+32) range 0 .. 31;
end record;
procedure Copy_Host_Info(Source : in W_Host_Info_Type;
@@ -800,16 +800,15 @@
package Low_Level is
use type Claw.Int;
- function WSAGetLastError return Error_Codes;
- pragma Import(Stdcall, WSAGetLastError, "WSAGetLastError");
+ -- function WSAGetLastError return Error_Codes;
function gethostbyname(name: NC.lpcstr) return Hostent_Ptr_Type;
- pragma Import(Stdcall, gethostbyname, "gethostbyname");
+ pragma Import(C, gethostbyname, "gethostbyname");
function gethostbyaddr(addr: access Network_Address_Type;
len : Claw.Int := Network_Address_Type'size/8;
kind : Claw.Int := PF_Inet) return Hostent_Ptr_Type;
- pragma Import(Stdcall, gethostbyaddr, "gethostbyaddr");
+ pragma Import(C, gethostbyaddr, "gethostbyaddr");
WSADescription_Len : constant := 256;
WSASys_Status_Len : constant := 128;
@@ -829,21 +828,13 @@
szSystemStatus at 261 range 0 .. 129*8-1;
iMaxSockets at 390 range 0 .. 15;
iMaxUdpDg at 392 range 0 .. 15;
- lpVendorInfo at 394 range 0 .. 31;
+ lpVendorInfo at 394 range 0 .. 63;
end record;
- for WSADatas'size use 398*8;
-
- function WSAStartup (wVersionRequired : NC.word;
- lpWSAData : access WSADatas)
- return Error_Codes;
- pragma Import(Stdcall, WSAStartup, "WSAStartup");
-
- function WSACleanup return Claw.Int;
- pragma Import(Stdcall, WSACleanup, "WSACleanup");
+ for WSADatas'size use 3216;
function gethostname(Name : NC.lpcstr;
Length : Claw.Int) return Claw.Int;
- pragma Import(Stdcall, gethostname, "gethostname");
+ pragma Import(C, gethostname, "gethostname");
type Address_Family_Type is new Claw.short;
AF_INET : constant Address_Family_Type := 2;
@@ -851,7 +842,7 @@
type Network_Port_Type is new NC.word; -- network byte order
function htons(hostshort: Port_Type) return Network_Port_Type;
- pragma Import(Stdcall, htons, "htons");
+ pragma Import(C, htons, "htons");
type SOCKADDR_INs is record
Family : Address_Family_Type := AF_INET;
@@ -863,32 +854,32 @@
for SOCKADDR_INs use record
Family at 0 range 0 .. 15;
Port at 2 range 0 .. 15;
- Address at 4 range 0 .. 31;
- Extra at 8 range 0 .. 8*8-1;
+ Address at 4 range 0 .. 63;
+ Extra at 12 range 0 .. 8*8-1;
end record;
- for SOCKADDR_INs'size use 16*8;
+ for SOCKADDR_INs'size use 160;
function Connect(S : Socket_Handles;
Name : access SOCKADDR_INs;
Length : Claw.Int := SOCKADDR_INs'size/8)
return Claw.Int;
- pragma Import(Stdcall, Connect, "connect");
+ pragma Import(C, Connect, "connect");
function Bind(S : Socket_Handles;
Address : access SOCKADDR_INs;
Length : Claw.Int := SOCKADDR_INs'size/8)
return Claw.Int;
- pragma Import(Stdcall, Bind, "bind");
+ pragma Import(C, Bind, "bind");
function Listen(S : Socket_Handles;
Q_Length : Claw.Int) return Claw.Int;
- pragma Import(Stdcall, Listen, "listen");
+ pragma Import(C, Listen, "listen");
function Accept_function(S : Socket_Handles;
Address : access SOCKADDR_INs;
Length : access Claw.Int)
return Socket_Handles;
- pragma Import(Stdcall, Accept_function, "accept");
+ pragma Import(C, Accept_function, "accept");
type Protocol_Type is new Claw.Int;
Ipproto_TCP : constant Protocol_Type := 6;
@@ -898,7 +889,7 @@
Kind : Sock_Type;
Protocol: Protocol_Type)
return Socket_Handles;
- pragma Import(Stdcall, Socket_function, "socket");
+ pragma Import(C, Socket_function, "socket");
FD_SETSIZE : constant := 64;
@@ -932,10 +923,10 @@
Exceptions_FD_Set : access FD_SET_Type;
Timeout : access Timeval_Type)
return Claw.Int;
- pragma Import(Stdcall, Select_function, "select");
+ pragma Import(C, Select_function, "select");
function closesocket(s: Socket_Handles) return Claw.Int;
- pragma Import(Stdcall, closesocket, "closesocket");
+ pragma Import(C, closesocket, "close");
function recv(
s : Socket_Handles;
@@ -943,7 +934,7 @@
Len : Claw.Int;
Flags: Claw.Int)
return Claw.Int;
- pragma Import(Stdcall, recv, "recv");
+ pragma Import(C, recv, "recv");
function recvfrom(
s : Socket_Handles;
@@ -953,7 +944,7 @@
Name : access SOCKADDR_INs;
Length : access Claw.Int)
return Claw.Int;
- pragma Import(Stdcall, recvfrom, "recvfrom");
+ pragma Import(C, recvfrom, "recvfrom");
function send(
s : Socket_Handles;
@@ -961,7 +952,7 @@
Len : Claw.Int;
Flags: Claw.Int)
return Claw.Int;
- pragma Import(Stdcall, send, "send");
+ pragma Import(C, send, "send");
function sendto(
s : Socket_Handles;
@@ -971,7 +962,7 @@
Name : access SOCKADDR_INs;
Length : Claw.Int := SOCKADDR_INs'size/8)
return Claw.Int;
- pragma Import(Stdcall, sendto, "sendto");
+ pragma Import(C, sendto, "sendto");
type Event_Type is new Claw.uint;
FD_READ_Event : constant Event_Type := 1;
@@ -984,12 +975,12 @@
function getpeername(s : Socket_Handles;
Address: access SOCKADDR_INs;
Length : access Claw.Int) return Claw.Int;
- pragma Import(Stdcall, getpeername, "getpeername");
+ pragma Import(C, getpeername, "getpeername");
function getsockname(s : Socket_Handles;
Address: access SOCKADDR_INs;
Length : access Claw.Int) return Claw.Int;
- pragma Import(Stdcall, getsockname, "getsockname");
+ pragma Import(C, getsockname, "getsockname");
type ioctl_cmd_type is new Claw.DWord;
@@ -998,7 +989,7 @@
function ioctlsocket(s : Socket_Handles;
cmd : ioctl_cmd_type;
arg : access Claw.DWord) return Claw.Int;
- pragma Import(Stdcall, ioctlsocket, "ioctlsocket");
+ pragma Import(C, ioctlsocket, "ioctl");
end Low_Level;
diff -r f734a2862510 -r 2cca25a3f5f4 nc.ads
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/nc.ads Wed Dec 22 18:05:52 2010 +0200
@@ -0,0 +1,19 @@
+with Interfaces.C;
+package NC is
+ type Short is new Interfaces.C.Short;
+ type Int is new Interfaces.C.Int;
+ subtype Natural_Int is Int range 0 .. Int'last;
+ type UInt is new Interfaces.C.Unsigned;
+ type DWord is new Interfaces.C.Unsigned_Long;
+
+ type Byte is range 0 .. 255;
+ for Byte'size use 8;
+ type Word is mod 2**16;
+ for Word'size use 16;
+
+ Windows_Error,
+ Not_Valid_Error,
+ Already_Valid_Error,
+ Not_Found_Error : Exception;
+ type Lpcstr is access all Interfaces.C.Char;
+end NC;
--
Tero Koskinen - http://iki.fi/tero.koskinen/