diff --git a/Makefile b/Makefile index 8b30018..7cc8ab6 100644 --- a/Makefile +++ b/Makefile @@ -37,9 +37,14 @@ samples: generate: mkdir -p .temp - echo "#include ">.temp/x.c - (cd .temp;g++ -c -fdump-ada-spec x.c) - cat .temp/zmq_h.ads | sed "s-/usr/local/include/--" >src/zmq_h.ads + echo "#include ">.temp/x.cpp + gprbuild -p -c -Pgenerate.gpr x.cpp + + python renames.py .temp/zmq_h.ads + gnatchop -w -gnat05 .temp/zmq_h.ads src + gnatpp -rnb -M127 src/zmq-low_level.ads -cargs -gnat05 + + clean: rm -rf .obj ${MAKE} -C tests clean diff --git a/eBindings/Makefile b/eBindings/Makefile old mode 100644 new mode 100755 index 82530c4..e2e93b7 --- a/eBindings/Makefile +++ b/eBindings/Makefile @@ -3,7 +3,5 @@ compile: install: %: ${MAKE} -C uuid ${@} - ${MAKE} -C pthread ${@} ${MAKE} -C dl ${@} - ${MAKE} -C zmq ${@} diff --git a/eBindings/zmq/Makefile b/eBindings/zmq/Makefile old mode 100644 new mode 100755 index 874b8a2..b4c36d1 --- a/eBindings/zmq/Makefile +++ b/eBindings/zmq/Makefile @@ -4,7 +4,7 @@ all:install install: mkdir -p ${PREFIX}/lib/gnat - cp libzmq.gpr ${PREFIX}/lib/gnat + cp -f libzmq.gpr ${PREFIX}/lib/gnat chmod -w ${PREFIX}/lib/gnat/libzmq.gpr clean: diff --git a/examples/hwserver.adb b/examples/hwserver.adb new file mode 100755 index 0000000..4c1ef13 --- /dev/null +++ b/examples/hwserver.adb @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2010 Per Sandberg -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files -- +-- (the "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, sublicense, and / or sell copies of the Software, and to -- +-- permit persons to whom the Software is furnished to do so, subject to -- +-- the following conditions : -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, -- +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -- +-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -- +-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -- +-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -- +-- OTHER DEALINGS IN THE SOFTWARE. -- +------------------------------------------------------------------------------- + +-- Hello World server in Ada +-- Binds REP socket to tcp:--*:5555 +-- Expects "Hello" from client, replies with "World" + + +with ZMQ.Sockets; +with ZMQ.Contexts; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +procedure HWServer is + Context : ZMQ.Contexts.Context; + Socket : ZMQ.Sockets.Socket; + inbuffer : Ada.Strings.Unbounded.Unbounded_String; +begin + -- Prepare our context and socket + Context.Initialize (1); + Socket.Initialize (Context, ZMQ.Sockets.REP); + Socket.Bind ("tcp://*:5555"); + + loop + -- Wait for next request from client + inbuffer := Socket.recv; + Put_Line ("Received request:" & To_String (inbuffer)); + + -- Do some 'work' + delay 1.0; + + -- Send reply back to client + Socket.Send ("World"); + end loop; +end HWServer; diff --git a/examples/zmq-examples.gpr b/examples/zmq-examples.gpr old mode 100644 new mode 100755 index 9bae067..03cdbac --- a/examples/zmq-examples.gpr +++ b/examples/zmq-examples.gpr @@ -1,5 +1,6 @@ with "../zmq.gpr"; with "xmlada.gpr"; +-- with "gnatcoll.gpr"; project ZMQ.Examples is for Main use ("zmq-examples-client.adb", diff --git a/generate.gpr b/generate.gpr new file mode 100644 index 0000000..f5b6cf5 --- /dev/null +++ b/generate.gpr @@ -0,0 +1,9 @@ +with "libzmq.gpr"; +project generate is + for languages use ("C++"); + for object_dir use ".temp"; + for source_Dirs use (".temp"); + package compiler is + for Default_Switches("C++") use ("-fdump-ada-spec"); + end compiler; +end generate; diff --git a/helpers/zmq-helpers.gpr b/helpers/zmq-helpers.gpr index 00ff8ae..38e93dc 100644 --- a/helpers/zmq-helpers.gpr +++ b/helpers/zmq-helpers.gpr @@ -1,5 +1,5 @@ with "../zmq.gpr"; -project Zmq.helpers is +project ZMQ.helpers is for Main use ("getinfo.adb"); for Object_Dir use ".obj"; for Exec_Dir use "."; @@ -8,5 +8,5 @@ project Zmq.helpers is -- package Binder renames zmq.Binder; package IDE renames zmq.IDE; -end Zmq.helpers; +end ZMQ.helpers; diff --git a/renames.py b/renames.py new file mode 100644 index 0000000..2b845f3 --- /dev/null +++ b/renames.py @@ -0,0 +1,42 @@ +#!/usr/bin/env python +renames=[["with stddef_h;\n",""], + ["stddef_h.size_t","size_t"], + ["zmq_h","ZMQ.Low_Level"]] + + +import sys +import os +import re + + +m=re.compile("(^.*-- *)(/.*?/)(zmq\\.h.*$)") +def fix(line): + ma=m.match(line) + if ma: + line=ma.group(1)+ma.group(3) + ma=re.match("^\\s+--\\s+unsupported\\s+macro:\\s+(\\w+)\\s+.ZMQ_HAUSNUMERO\\s+\\+\\s+(\\w+).*",line) + if ma: + line=" %s : constant := ZMQ_HAUSNUMERO + %s;" % (ma.group(1), ma.group(2)) + return line + +def rename(p): + f=file(p) + buffer=f.read() + f.close(); + + for i in renames: + buffer=buffer.replace(i[0],i[1]) + + buffer=buffer.split("\n") + ret=[] + for line in buffer: + ret.append(fix(line)) + if re.match("^package.*is",line): + ret.append(" pragma Preelaborate;") + + f=file(p,"w") + f.write("\n".join(ret)) + f.close() + +if __name__ == "__main__": + rename(sys.argv[1]) diff --git a/src/.gitignore b/src/.gitignore index 123a071..8e78cf7 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -4,7 +4,4 @@ lib *.pyc new\ file .temp -gen -ctest.c -zmq_h.ads diff --git a/src/zmq-contexts.adb b/src/zmq-contexts.adb index 9b4a942..b14d7fd 100644 --- a/src/zmq-contexts.adb +++ b/src/zmq-contexts.adb @@ -42,20 +42,15 @@ package body ZMQ.Contexts is -- Initialize -- ---------------- - not overriding procedure Initialize - (This : in out Context; - App_Threads : Natural) + overriding procedure Initialize + (This : in out Context) is begin Validate_Library_Version; - if This.c /= Null_Address then - raise ZMQ_Error with "Alredy Initialized"; - end if; - This.c := Low_Level.zmq_init - (int (App_Threads)); - if This.c = Null_Address then + This.C := Low_Level.zmq_ctx_new; + if This.C = Null_Address then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; + GNAT.Source_Info.Enclosing_Entity; end if; end Initialize; @@ -66,26 +61,67 @@ package body ZMQ.Contexts is overriding procedure Finalize (This : in out Context) is - rc : int; + Rc : int; begin - if This.Is_Connected then - rc := Low_Level.zmq_term (This.c); - This.c := Null_Address; - if rc /= 0 then - raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; - end if; + Rc := Low_Level.zmq_term (This.C); + This.C := Null_Address; + if Rc /= 0 then + raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & + GNAT.Source_Info.Enclosing_Entity; end if; end Finalize; - function Is_Connected (This : Context) return Boolean is - begin - return This.c /= Null_Address; - end Is_Connected; function GetImpl (This : Context) return System.Address is begin - return This.c; + return This.C; end GetImpl; + procedure Set_Number_Of_IO_Threads + (This : Context; Number_Of_IO_Threads : Positive := IO_THREADS_DFLT) is + Rc : int; + begin + Rc := Low_Level.zmq_ctx_set + (context => This.GetImpl, + option => Low_Level.ZMQ_IO_THREADS, + optval => int (Number_Of_IO_Threads)); + if Rc /= 0 then + raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & + GNAT.Source_Info.Enclosing_Entity; + end if; + end Set_Number_Of_IO_Threads; + + procedure Set_Maximum_Number_Of_Sockets + (This : Context; Number_Of_Sockets : Positive := MAX_SOCKETS_DFLT) is + Rc : int; + begin + Rc := Low_Level.zmq_ctx_set + (context => This.GetImpl, + option => Low_Level.ZMQ_MAX_SOCKETS, + optval => int (Number_Of_Sockets)); + if Rc /= 0 then + raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & + GNAT.Source_Info.Enclosing_Entity; + end if; + end Set_Maximum_Number_Of_Sockets; + + function Get_Number_Of_IO_Threads (This : Context) return Positive is + begin + return Ret : Positive do + Ret := Positive + (Low_Level.zmq_ctx_get (context => This.GetImpl, + option => Low_Level.ZMQ_IO_THREADS)); + end return; + end Get_Number_Of_IO_Threads; + + function Get_Maximum_Number_Of_Sockets (This : Context) return Positive is + begin + return Ret : Positive do + Ret := Positive + (Low_Level.zmq_ctx_get (context => This.GetImpl, + option => Low_Level.ZMQ_MAX_SOCKETS)); + end return; + end Get_Maximum_Number_Of_Sockets; + + end ZMQ.Contexts; diff --git a/src/zmq-contexts.ads b/src/zmq-contexts.ads index 304250e..718f308 100644 --- a/src/zmq-contexts.ads +++ b/src/zmq-contexts.ads @@ -33,23 +33,43 @@ with Ada.Finalization; with System; package ZMQ.Contexts is + IO_THREADS_DFLT : constant := 1; + MAX_SOCKETS_DFLT : constant := 1024; type Context is new Ada.Finalization.Limited_Controlled with private; type Any_Context is access all Context'Class; - not overriding - procedure Initialize (This : in out Context; - App_Threads : Natural); + + procedure Set_Number_Of_IO_Threads + (This : Context; Number_Of_IO_Threads : Positive := IO_THREADS_DFLT); + -- specifies the size of the ØMQ thread pool to handle I/O operations. + -- If your application is using only the inproc transport for messaging + -- you may set this to zero, otherwise set it to at least one. + -- This option only applies before creating any sockets on the context. + + procedure Set_Maximum_Number_Of_Sockets + (This : Context; Number_Of_Sockets : Positive := MAX_SOCKETS_DFLT); + -- Sets the maximum number of sockets allowed on the context. + + function Get_Number_Of_IO_Threads + (This : Context) return Positive; + -- Returns the size of the ØMQ thread pool for this context. + + function Get_Maximum_Number_Of_Sockets + (This : Context) return Positive; + -- Returns the maximum number of sockets allowed for this context. + + function GetImpl (This : Context) return System.Address; + -- "Private" function to get lowlevel implementation handle. + +private + type Context is new Ada.Finalization.Limited_Controlled with record + C : System.Address := System.Null_Address; + end record; + overriding + procedure Initialize (This : in out Context); overriding procedure Finalize (This : in out Context); - - function Is_Connected (This : Context) return Boolean; - - function GetImpl (This : Context) return System.Address; -private - type Context is new Ada.Finalization.Limited_Controlled with record - c : System.Address := System.Null_Address; - end record; end ZMQ.Contexts; diff --git a/src/zmq-devices.adb b/src/zmq-devices.adb old mode 100644 new mode 100755 index f25c2f4..24bff61 --- a/src/zmq-devices.adb +++ b/src/zmq-devices.adb @@ -33,27 +33,27 @@ with ZMQ.Low_Level; with Interfaces.C; use Interfaces.C; -package body ZMQ.devices is +package body ZMQ.Devices is ---------------- -- initialize -- ---------------- - - map : constant array (Device_Kind) of int := - (Streamer => Low_Level.Defs.ZMQ_STREAMER, - Forwarder => Low_Level.Defs.ZMQ_FORWARDER, - Queue => Low_Level.Defs.ZMQ_QUEUE); - procedure initialize - (this : in out device; - Kind : Device_Kind; - insocket : ZMQ.Sockets.Socket; - outsocket : ZMQ.Sockets.Socket) + type Device_Kind_map is array (Device_Kind) of int; + Map : constant Device_Kind_map := + (Streamer => Low_Level.ZMQ_STREAMER, + Forwarder => Low_Level.ZMQ_FORWARDER, + Queue => Low_Level.ZMQ_QUEUE); + procedure Initialize + (This : in out Device; + Kind : Device_Kind; + In_Socket : ZMQ.Sockets.Socket; + Out_Ocket : ZMQ.Sockets.Socket) is begin - this.impl := - Low_Level.zmq_device (map (Kind), - insocket.get_impl, - outsocket.get_impl); - end initialize; + This.Impl := + Low_Level.Zmq_Device (Map (Kind), + In_Socket.Get_Impl, + Out_Ocket.Get_Impl); + end Initialize; -end ZMQ.devices; +end ZMQ.Devices; diff --git a/src/zmq-devices.ads b/src/zmq-devices.ads index ca2f912..c3620f1 100644 --- a/src/zmq-devices.ads +++ b/src/zmq-devices.ads @@ -33,17 +33,17 @@ private with Interfaces.C; with ZMQ.Sockets; -package ZMQ.devices is --- Devices are building blocks intended to serve as intermediate nodes --- in complex messaging topologies. - type device is tagged private; +package ZMQ.Devices is + -- Devices are building blocks intended to serve as intermediate nodes + -- in complex messaging topologies. + type Device is tagged private; type Device_Kind is (Streamer, Forwarder, Queue); - procedure initialize (this : in out device; - Kind : Device_Kind; - insocket : ZMQ.Sockets.Socket; - outsocket : ZMQ.Sockets.Socket); + procedure Initialize (This : in out Device; + Kind : Device_Kind; + In_Socket : ZMQ.Sockets.Socket; + Out_Ocket : ZMQ.Sockets.Socket); private - type device is tagged record - impl : Interfaces.C.int; + type Device is tagged record + Impl : Interfaces.C.int; end record; -end ZMQ.devices; +end ZMQ.Devices; diff --git a/src/zmq-low_level.ads b/src/zmq-low_level.ads index b963dc0..27980be 100644 --- a/src/zmq-low_level.ads +++ b/src/zmq-low_level.ads @@ -1,139 +1,155 @@ -------------------------------------------------------------------------------- --- -- --- 0MQ Ada-binding -- --- -- --- Z M Q . L O W _ L E V E L -- --- -- --- S p e c -- --- -- --- Copyright (C) 2010-2011, per.sandberg@bredband.net -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files -- --- (the "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, sublicense, and / or sell copies of the Software, and to -- --- permit persons to whom the Software is furnished to do so, subject to -- --- the following conditions : -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, -- --- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -- --- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -- --- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -- --- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -- --- OTHER DEALINGS IN THE SOFTWARE. -- -------------------------------------------------------------------------------- +pragma Ada_2005; +pragma Style_Checks (Off); - --- The contents of this file is derived from zmq.h using the --- -fdump-ada-spec switch for gcc. - -with Interfaces.C; use Interfaces.C; +with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; with System; package ZMQ.Low_Level is pragma Preelaborate; - pragma Warnings (Off); - package Defs is - ZMQ_VERSION_MAJOR : constant := 2; -- zmq.h:55 - ZMQ_VERSION_MINOR : constant := 1; -- zmq.h:56 - ZMQ_VERSION_PATCH : constant := 0; -- zmq.h:57 - ZMQ_VERSION : constant := ZMQ_VERSION_MAJOR * 10000 + ZMQ_VERSION_MINOR * 100 + ZMQ_VERSION_PATCH; + ZMQ_VERSION_MAJOR : constant := 3; -- zmq.h:61 + ZMQ_VERSION_MINOR : constant := 2; -- zmq.h:62 + ZMQ_VERSION_PATCH : constant := 2; -- zmq.h:63 + -- arg-macro: function ZMQ_MAKE_VERSION (major, minor, p((major) * 10000 + (minor) * 100 + (patch) + -- return (major) * 10000 + (minor) * 100 + (patch); + -- unsupported macro: ZMQ_VERSION ZMQ_MAKE_VERSION(ZMQ_VERSION_MAJOR, ZMQ_VERSION_MINOR, ZMQ_VERSION_PATCH) - ZMQ_HAUSNUMERO : constant := 156384712; -- zmq.h:73 - EFSM : constant := (ZMQ_HAUSNUMERO + 51); - ENOCOMPATPROTO : constant := (ZMQ_HAUSNUMERO + 52); - ETERM : constant := (ZMQ_HAUSNUMERO + 53); - EMTHREAD : constant := (ZMQ_HAUSNUMERO + 54); + ZMQ_HAUSNUMERO : constant := 156384712; -- zmq.h:79 + EFSM : constant := ZMQ_HAUSNUMERO + 51; + ENOCOMPATPROTO : constant := ZMQ_HAUSNUMERO + 52; + ETERM : constant := ZMQ_HAUSNUMERO + 53; + EMTHREAD : constant := ZMQ_HAUSNUMERO + 54; - ZMQ_MAX_VSM_SIZE : constant := 30; -- zmq.h:124 + ZMQ_IO_THREADS : constant := 1; -- zmq.h:158 + ZMQ_MAX_SOCKETS : constant := 2; -- zmq.h:159 - ZMQ_DELIMITER : constant := 31; -- zmq.h:128 - ZMQ_VSM : constant := 32; -- zmq.h:129 + ZMQ_IO_THREADS_DFLT : constant := 1; -- zmq.h:162 + ZMQ_MAX_SOCKETS_DFLT : constant := 1024; -- zmq.h:163 - ZMQ_MSG_MORE : constant := 1; -- zmq.h:134 - ZMQ_MSG_SHARED : constant := 128; -- zmq.h:135 + ZMQ_PAIR : constant := 0; -- zmq.h:204 + ZMQ_PUB : constant := 1; -- zmq.h:205 + ZMQ_SUB : constant := 2; -- zmq.h:206 + ZMQ_REQ : constant := 3; -- zmq.h:207 + ZMQ_REP : constant := 4; -- zmq.h:208 + ZMQ_DEALER : constant := 5; -- zmq.h:209 + ZMQ_ROUTER : constant := 6; -- zmq.h:210 + ZMQ_PULL : constant := 7; -- zmq.h:211 + ZMQ_PUSH : constant := 8; -- zmq.h:212 + ZMQ_XPUB : constant := 9; -- zmq.h:213 + ZMQ_XSUB : constant := 10; -- zmq.h:214 + -- unsupported macro: ZMQ_XREQ ZMQ_DEALER + -- unsupported macro: ZMQ_XREP ZMQ_ROUTER - ZMQ_PAIR : constant := 0; -- zmq.h:172 - ZMQ_PUB : constant := 1; -- zmq.h:173 - ZMQ_SUB : constant := 2; -- zmq.h:174 - ZMQ_REQ : constant := 3; -- zmq.h:175 - ZMQ_REP : constant := 4; -- zmq.h:176 - ZMQ_XREQ : constant := 5; -- zmq.h:177 - ZMQ_XREP : constant := 6; -- zmq.h:178 - ZMQ_PULL : constant := 7; -- zmq.h:179 - ZMQ_PUSH : constant := 8; -- zmq.h:180 - ZMQ_UPSTREAM : constant := ZMQ_PULL; - ZMQ_DOWNSTREAM : constant := ZMQ_PUSH; + ZMQ_AFFINITY : constant := 4; -- zmq.h:221 + ZMQ_IDENTITY : constant := 5; -- zmq.h:222 + ZMQ_SUBSCRIBE : constant := 6; -- zmq.h:223 + ZMQ_UNSUBSCRIBE : constant := 7; -- zmq.h:224 + ZMQ_RATE : constant := 8; -- zmq.h:225 + ZMQ_RECOVERY_IVL : constant := 9; -- zmq.h:226 + ZMQ_SNDBUF : constant := 11; -- zmq.h:227 + ZMQ_RCVBUF : constant := 12; -- zmq.h:228 + ZMQ_RCVMORE : constant := 13; -- zmq.h:229 + ZMQ_FD : constant := 14; -- zmq.h:230 + ZMQ_EVENTS : constant := 15; -- zmq.h:231 + ZMQ_TYPE : constant := 16; -- zmq.h:232 + ZMQ_LINGER : constant := 17; -- zmq.h:233 + ZMQ_RECONNECT_IVL : constant := 18; -- zmq.h:234 + ZMQ_BACKLOG : constant := 19; -- zmq.h:235 + ZMQ_RECONNECT_IVL_MAX : constant := 21; -- zmq.h:236 + ZMQ_MAXMSGSIZE : constant := 22; -- zmq.h:237 + ZMQ_SNDHWM : constant := 23; -- zmq.h:238 + ZMQ_RCVHWM : constant := 24; -- zmq.h:239 + ZMQ_MULTICAST_HOPS : constant := 25; -- zmq.h:240 + ZMQ_RCVTIMEO : constant := 27; -- zmq.h:241 + ZMQ_SNDTIMEO : constant := 28; -- zmq.h:242 + ZMQ_IPV4ONLY : constant := 31; -- zmq.h:243 + ZMQ_LAST_ENDPOINT : constant := 32; -- zmq.h:244 + ZMQ_ROUTER_MANDATORY : constant := 33; -- zmq.h:245 + ZMQ_TCP_KEEPALIVE : constant := 34; -- zmq.h:246 + ZMQ_TCP_KEEPALIVE_CNT : constant := 35; -- zmq.h:247 + ZMQ_TCP_KEEPALIVE_IDLE : constant := 36; -- zmq.h:248 + ZMQ_TCP_KEEPALIVE_INTVL : constant := 37; -- zmq.h:249 + ZMQ_TCP_ACCEPT_FILTER : constant := 38; -- zmq.h:250 + ZMQ_DELAY_ATTACH_ON_CONNECT : constant := 39; -- zmq.h:251 + ZMQ_XPUB_VERBOSE : constant := 40; -- zmq.h:252 - ZMQ_HWM : constant := 1; -- zmq.h:185 - ZMQ_SWAP : constant := 3; -- zmq.h:186 - ZMQ_AFFINITY : constant := 4; -- zmq.h:187 - ZMQ_IDENTITY : constant := 5; -- zmq.h:188 - ZMQ_SUBSCRIBE : constant := 6; -- zmq.h:189 - ZMQ_UNSUBSCRIBE : constant := 7; -- zmq.h:190 - ZMQ_RATE : constant := 8; -- zmq.h:191 - ZMQ_RECOVERY_IVL : constant := 9; -- zmq.h:192 - ZMQ_MCAST_LOOP : constant := 10; -- zmq.h:193 - ZMQ_SNDBUF : constant := 11; -- zmq.h:194 - ZMQ_RCVBUF : constant := 12; -- zmq.h:195 - ZMQ_RCVMORE : constant := 13; -- zmq.h:196 - ZMQ_FD : constant := 14; -- zmq.h:197 - ZMQ_EVENTS : constant := 15; -- zmq.h:198 - ZMQ_TYPE : constant := 16; -- zmq.h:199 - ZMQ_LINGER : constant := 17; -- zmq.h:200 - ZMQ_RECONNECT_IVL : constant := 18; -- zmq.h:201 - ZMQ_BACKLOG : constant := 19; -- zmq.h:202 + ZMQ_MORE : constant := 1; -- zmq.h:256 - ZMQ_NOBLOCK : constant := 1; -- zmq.h:205 - ZMQ_SNDMORE : constant := 2; -- zmq.h:206 + ZMQ_DONTWAIT : constant := 1; -- zmq.h:259 + ZMQ_SNDMORE : constant := 2; -- zmq.h:260 + -- unsupported macro: ZMQ_NOBLOCK ZMQ_DONTWAIT + -- unsupported macro: ZMQ_FAIL_UNROUTABLE ZMQ_ROUTER_MANDATORY + -- unsupported macro: ZMQ_ROUTER_BEHAVIOR ZMQ_ROUTER_MANDATORY - ZMQ_POLLIN : constant := 1; -- zmq.h:223 - ZMQ_POLLOUT : constant := 2; -- zmq.h:224 - ZMQ_POLLERR : constant := 4; -- zmq.h:225 + ZMQ_EVENT_CONNECTED : constant := 1; -- zmq.h:272 + ZMQ_EVENT_CONNECT_DELAYED : constant := 2; -- zmq.h:273 + ZMQ_EVENT_CONNECT_RETRIED : constant := 4; -- zmq.h:274 - ZMQ_STREAMER : constant := 1; -- zmq.h:245 - ZMQ_FORWARDER : constant := 2; -- zmq.h:246 - ZMQ_QUEUE : constant := 3; -- zmq.h:247 + ZMQ_EVENT_LISTENING : constant := 8; -- zmq.h:276 + ZMQ_EVENT_BIND_FAILED : constant := 16; -- zmq.h:277 + ZMQ_EVENT_ACCEPTED : constant := 32; -- zmq.h:279 + ZMQ_EVENT_ACCEPT_FAILED : constant := 64; -- zmq.h:280 - end Defs; + ZMQ_EVENT_CLOSED : constant := 128; -- zmq.h:282 + ZMQ_EVENT_CLOSE_FAILED : constant := 256; -- zmq.h:283 + ZMQ_EVENT_DISCONNECTED : constant := 512; -- zmq.h:284 + -- unsupported macro: ZMQ_EVENT_ALL ( ZMQ_EVENT_CONNECTED | ZMQ_EVENT_CONNECT_DELAYED | ZMQ_EVENT_CONNECT_RETRIED | + --ZMQ_EVENT_LISTENING | ZMQ_EVENT_BIND_FAILED | ZMQ_EVENT_ACCEPTED | ZMQ_EVENT_ACCEPT_FAILED | ZMQ_EVENT_CLOSED | + --ZMQ_EVENT_CLOSE_FAILED | ZMQ_EVENT_DISCONNECTED ) - procedure zmq_version - (major : access int; - minor : access int; - patch : access int); -- zmq.h:65 + ZMQ_POLLIN : constant := 1; -- zmq.h:366 + ZMQ_POLLOUT : constant := 2; -- zmq.h:367 + ZMQ_POLLERR : constant := 4; -- zmq.h:368 + + ZMQ_STREAMER : constant := 1; -- zmq.h:389 + ZMQ_FORWARDER : constant := 2; -- zmq.h:390 + ZMQ_QUEUE : constant := 3; -- zmq.h:391 + + procedure zmq_version (major : access int; minor : access int; patch : access int); -- zmq.h:71 pragma Import (C, zmq_version, "zmq_version"); - function zmq_errno return int; -- zmq.h:111 + function zmq_errno return int; -- zmq.h:147 pragma Import (C, zmq_errno, "zmq_errno"); - function zmq_strerror (errnum : int) return Interfaces.C.Strings.chars_ptr; -- zmq.h:114 + function zmq_strerror (errnum : int) return Interfaces.C.Strings.chars_ptr; -- zmq.h:150 pragma Import (C, zmq_strerror, "zmq_strerror"); - type zmq_msg_t_vsm_data_array is array (0 .. 29) of aliased unsigned_char; + function zmq_ctx_new return System.Address; -- zmq.h:165 + pragma Import (C, zmq_ctx_new, "zmq_ctx_new"); + + function zmq_ctx_destroy (context : System.Address) return int; -- zmq.h:166 + pragma Import (C, zmq_ctx_destroy, "zmq_ctx_destroy"); + + function zmq_ctx_set + (context : System.Address; + option : int; + optval : int) + return int; -- zmq.h:167 + pragma Import (C, zmq_ctx_set, "zmq_ctx_set"); + + function zmq_ctx_get (context : System.Address; option : int) return int; -- zmq.h:168 + pragma Import (C, zmq_ctx_get, "zmq_ctx_get"); + + function zmq_init (io_threads : int) return System.Address; -- zmq.h:171 + pragma Import (C, zmq_init, "zmq_init"); + + function zmq_term (context : System.Address) return int; -- zmq.h:172 + pragma Import (C, zmq_term, "zmq_term"); + + type zmq_msg_t_u_u_array is array (0 .. 31) of aliased unsigned_char; type zmq_msg_t is record - content : System.Address; -- zmq.h:142 - flags : aliased unsigned_char; -- zmq.h:143 - vsm_size : aliased unsigned_char; -- zmq.h:144 - vsm_data : aliased zmq_msg_t_vsm_data_array; -- zmq.h:145 + u_u : aliased zmq_msg_t_u_u_array; -- zmq.h:179 end record; - pragma Convention (C_Pass_By_Copy, zmq_msg_t); -- zmq.h:146 + pragma Convention (C_Pass_By_Copy, zmq_msg_t); -- zmq.h:179 + -- skipped function type zmq_free_fn - type zmq_free_fn is access procedure (data : System.Address; hint : System.Address); - - function zmq_msg_init (msg : access zmq_msg_t) return int; -- zmq.h:150 + function zmq_msg_init (msg : access zmq_msg_t) return int; -- zmq.h:183 pragma Import (C, zmq_msg_init, "zmq_msg_init"); - function zmq_msg_init_size (msg : access zmq_msg_t; size : size_t) return int; -- zmq.h:151 + function zmq_msg_init_size (msg : access zmq_msg_t; size : size_t) return int; -- zmq.h:184 pragma Import (C, zmq_msg_init_size, "zmq_msg_init_size"); function zmq_msg_init_data @@ -141,87 +157,255 @@ package ZMQ.Low_Level is data : System.Address; size : size_t; ffn : access procedure (arg1 : System.Address; arg2 : System.Address); - hint : System.Address) return int; -- zmq.h:152 + hint : System.Address) + return int; -- zmq.h:185 pragma Import (C, zmq_msg_init_data, "zmq_msg_init_data"); - function zmq_msg_close (msg : access zmq_msg_t) return int; -- zmq.h:154 + function zmq_msg_send + (msg : access zmq_msg_t; + s : System.Address; + flags : int) + return int; -- zmq.h:187 + pragma Import (C, zmq_msg_send, "zmq_msg_send"); + + function zmq_msg_recv + (msg : access zmq_msg_t; + s : System.Address; + flags : int) + return int; -- zmq.h:188 + pragma Import (C, zmq_msg_recv, "zmq_msg_recv"); + + function zmq_msg_close (msg : access zmq_msg_t) return int; -- zmq.h:189 pragma Import (C, zmq_msg_close, "zmq_msg_close"); - function zmq_msg_move (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:155 + function zmq_msg_move (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:190 pragma Import (C, zmq_msg_move, "zmq_msg_move"); - function zmq_msg_copy (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:156 + function zmq_msg_copy (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:191 pragma Import (C, zmq_msg_copy, "zmq_msg_copy"); - function zmq_msg_data (msg : access zmq_msg_t) return System.Address; -- zmq.h:157 + function zmq_msg_data (msg : access zmq_msg_t) return System.Address; -- zmq.h:192 pragma Import (C, zmq_msg_data, "zmq_msg_data"); - function zmq_msg_size (msg : access zmq_msg_t) return size_t; -- zmq.h:158 + function zmq_msg_size (msg : access zmq_msg_t) return size_t; -- zmq.h:193 pragma Import (C, zmq_msg_size, "zmq_msg_size"); - function zmq_init (io_threads : int) return System.Address; -- zmq.h:164 - pragma Import (C, zmq_init, "zmq_init"); + function zmq_msg_more (msg : access zmq_msg_t) return int; -- zmq.h:194 + pragma Import (C, zmq_msg_more, "zmq_msg_more"); - function zmq_term (context : System.Address) return int; -- zmq.h:165 - pragma Import (C, zmq_term, "zmq_term"); + function zmq_msg_get (msg : access zmq_msg_t; option : int) return int; -- zmq.h:195 + pragma Import (C, zmq_msg_get, "zmq_msg_get"); - function zmq_socket (context : System.Address; c_type : int) return System.Address; -- zmq.h:208 + function zmq_msg_set + (msg : access zmq_msg_t; + option : int; + optval : int) + return int; -- zmq.h:196 + pragma Import (C, zmq_msg_set, "zmq_msg_set"); + + type anon_7; + type anon_8 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:297 + fd : aliased int; -- zmq.h:298 + end record; + pragma Convention (C_Pass_By_Copy, anon_8); + type anon_9 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:301 + err : aliased int; -- zmq.h:302 + end record; + pragma Convention (C_Pass_By_Copy, anon_9); + type anon_10 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:305 + interval : aliased int; -- zmq.h:306 + end record; + pragma Convention (C_Pass_By_Copy, anon_10); + type anon_11 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:309 + fd : aliased int; -- zmq.h:310 + end record; + pragma Convention (C_Pass_By_Copy, anon_11); + type anon_12 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:313 + err : aliased int; -- zmq.h:314 + end record; + pragma Convention (C_Pass_By_Copy, anon_12); + type anon_13 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:317 + fd : aliased int; -- zmq.h:318 + end record; + pragma Convention (C_Pass_By_Copy, anon_13); + type anon_14 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:321 + err : aliased int; -- zmq.h:322 + end record; + pragma Convention (C_Pass_By_Copy, anon_14); + type anon_15 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:325 + fd : aliased int; -- zmq.h:326 + end record; + pragma Convention (C_Pass_By_Copy, anon_15); + type anon_16 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:329 + err : aliased int; -- zmq.h:330 + end record; + pragma Convention (C_Pass_By_Copy, anon_16); + type anon_17 is record + addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:333 + fd : aliased int; -- zmq.h:334 + end record; + pragma Convention (C_Pass_By_Copy, anon_17); + type anon_7 (discr : unsigned := 0) is record + case discr is + when 0 => + connected : aliased anon_8; -- zmq.h:299 + when 1 => + connect_delayed : aliased anon_9; -- zmq.h:303 + when 2 => + connect_retried : aliased anon_10; -- zmq.h:307 + when 3 => + listening : aliased anon_11; -- zmq.h:311 + when 4 => + bind_failed : aliased anon_12; -- zmq.h:315 + when 5 => + accepted : aliased anon_13; -- zmq.h:319 + when 6 => + accept_failed : aliased anon_14; -- zmq.h:323 + when 7 => + closed : aliased anon_15; -- zmq.h:327 + when 8 => + close_failed : aliased anon_16; -- zmq.h:331 + when others => + disconnected : aliased anon_17; -- zmq.h:335 + end case; + end record; + pragma Convention (C_Pass_By_Copy, anon_7); + pragma Unchecked_Union (anon_7); + type zmq_event_t is record + event : aliased int; -- zmq.h:294 + data : anon_7; -- zmq.h:336 + end record; + pragma Convention (C_Pass_By_Copy, zmq_event_t); -- zmq.h:337 + + -- skipped anonymous struct anon_6 + + function zmq_socket (arg1 : System.Address; c_type : int) return System.Address; -- zmq.h:339 pragma Import (C, zmq_socket, "zmq_socket"); - function zmq_close (s : System.Address) return int; -- zmq.h:209 + function zmq_close (s : System.Address) return int; -- zmq.h:340 pragma Import (C, zmq_close, "zmq_close"); function zmq_setsockopt (s : System.Address; option : int; optval : System.Address; - optvallen : size_t) return int; -- zmq.h:210 + optvallen : size_t) + return int; -- zmq.h:341 pragma Import (C, zmq_setsockopt, "zmq_setsockopt"); function zmq_getsockopt (s : System.Address; option : int; optval : System.Address; - optvallen : access size_t) return int; -- zmq.h:212 + optvallen : access size_t) + return int; -- zmq.h:343 pragma Import (C, zmq_getsockopt, "zmq_getsockopt"); - function zmq_bind (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:214 + function zmq_bind (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:345 pragma Import (C, zmq_bind, "zmq_bind"); - function zmq_connect (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:215 + function zmq_connect (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:346 pragma Import (C, zmq_connect, "zmq_connect"); + function zmq_unbind (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:347 + pragma Import (C, zmq_unbind, "zmq_unbind"); + + function zmq_disconnect (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:348 + pragma Import (C, zmq_disconnect, "zmq_disconnect"); + function zmq_send (s : System.Address; - msg : access zmq_msg_t; - flags : int) return int; -- zmq.h:216 + buf : System.Address; + len : size_t; + flags : int) + return int; -- zmq.h:349 pragma Import (C, zmq_send, "zmq_send"); function zmq_recv (s : System.Address; - msg : access zmq_msg_t; - flags : int) return int; -- zmq.h:217 + buf : System.Address; + len : size_t; + flags : int) + return int; -- zmq.h:350 pragma Import (C, zmq_recv, "zmq_recv"); - type zmq_pollitem_t is record - socket : System.Address; -- zmq.h:229 - fd : aliased int; -- zmq.h:233 - events : aliased short; -- zmq.h:235 - revents : aliased short; -- zmq.h:236 - end record; - pragma Convention (C_Pass_By_Copy, zmq_pollitem_t); -- zmq.h:237 + function zmq_socket_monitor + (s : System.Address; + addr : Interfaces.C.Strings.chars_ptr; + events : int) + return int; -- zmq.h:351 + pragma Import (C, zmq_socket_monitor, "zmq_socket_monitor"); + function zmq_sendmsg + (s : System.Address; + msg : access zmq_msg_t; + flags : int) + return int; -- zmq.h:353 + pragma Import (C, zmq_sendmsg, "zmq_sendmsg"); + + function zmq_recvmsg + (s : System.Address; + msg : access zmq_msg_t; + flags : int) + return int; -- zmq.h:354 + pragma Import (C, zmq_recvmsg, "zmq_recvmsg"); + + -- skipped empty struct iovec + + function zmq_sendiov + (s : System.Address; + iov : System.Address; + count : size_t; + flags : int) + return int; -- zmq.h:359 + pragma Import (C, zmq_sendiov, "zmq_sendiov"); + + function zmq_recviov + (s : System.Address; + iov : System.Address; + count : access size_t; + flags : int) + return int; -- zmq.h:360 + pragma Import (C, zmq_recviov, "zmq_recviov"); + + type zmq_pollitem_t is record + socket : System.Address; -- zmq.h:372 + fd : aliased int; -- zmq.h:376 + events : aliased short; -- zmq.h:378 + revents : aliased short; -- zmq.h:379 + end record; + pragma Convention (C_Pass_By_Copy, zmq_pollitem_t); -- zmq.h:380 + + -- skipped anonymous struct anon_18 function zmq_poll (items : access zmq_pollitem_t; nitems : int; - timeout : long) return int; -- zmq.h:239 + timeout : long) + return int; -- zmq.h:382 pragma Import (C, zmq_poll, "zmq_poll"); + function zmq_proxy + (frontend : System.Address; + backend : System.Address; + capture : System.Address) + return int; -- zmq.h:386 + pragma Import (C, zmq_proxy, "zmq_proxy"); + function zmq_device - (device : int; - insocket : System.Address; - outsocket : System.Address) return int; -- zmq.h:249 + (c_type : int; + frontend : System.Address; + backend : System.Address) + return int; -- zmq.h:393 pragma Import (C, zmq_device, "zmq_device"); end ZMQ.Low_Level; diff --git a/src/zmq-messages.adb b/src/zmq-messages.adb index 917495d..49443af 100644 --- a/src/zmq-messages.adb +++ b/src/zmq-messages.adb @@ -43,12 +43,12 @@ package body ZMQ.Messages is ---------------- procedure Initialize (Self : in out Message) is - ret : int; + Ret : int; begin - ret := Low_Level.zmq_msg_init (Self.Msg'Access); - if ret /= 0 then + Ret := Low_Level.Zmq_Msg_Init (Self.Msg'Access); + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; + GNAT.Source_Info.Enclosing_Entity; end if; end Initialize; @@ -57,12 +57,12 @@ package body ZMQ.Messages is -- ======================================================================== procedure Initialize (Self : in out Message; Size : Natural) is - ret : int; + Ret : int; begin - ret := Low_Level.zmq_msg_init_size (Self.Msg'Access, size_t (Size)); - if ret /= 0 then + Ret := Low_Level.Zmq_Msg_Init_Size (Self.Msg'Access, size_t (Size)); + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; + GNAT.Source_Info.Enclosing_Entity; end if; end Initialize; @@ -80,11 +80,11 @@ package body ZMQ.Messages is procedure Initialize (Self : in out Message; Data : System.Address; Size : Natural) is - type data_Type is new String (1 .. Size); - package conv is new System.Address_To_Access_Conversions (data_Type); + type Data_Type is new String (1 .. Size); + package Conv is new System.Address_To_Access_Conversions (Data_Type); begin Self.Initialize (Size); - conv.To_Pointer ((Self.getData)).all := conv.To_Pointer (Data).all; + Conv.To_Pointer ((Self.GetData)).all := Conv.To_Pointer (Data).all; end Initialize; procedure Initialize (Self : in out Message; Data : String) is @@ -109,16 +109,16 @@ package body ZMQ.Messages is Free : Free_Proc; Hint : System.Address := System.Null_Address) is - ret : int; + Ret : int; begin - ret := Low_Level.zmq_msg_init_data (Self.Msg'Access, + Ret := Low_Level.Zmq_Msg_Init_Data (Self.Msg'Access, Message, size_t (Size), Free, Hint); - if ret /= 0 then + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; + GNAT.Source_Info.Enclosing_Entity; end if; end Initialize; @@ -131,20 +131,20 @@ package body ZMQ.Messages is (Self : in out Message; Data : Element_Access) is - function conv is new + function Conv is new Ada.Unchecked_Conversion (Source => System.Address, Target => Element_Access); - procedure Internal_free (Data : System.Address; Hint : System.Address); - procedure Internal_free (Data : System.Address; Hint : System.Address) is + procedure Internal_Free (Data : System.Address; Hint : System.Address); + procedure Internal_Free (Data : System.Address; Hint : System.Address) is pragma Unreferenced (Hint); - temp : Element_Access := conv (Data); + Temp : Element_Access := Conv (Data); begin - free (temp); - end Internal_free; + Free (Temp); + end Internal_Free; begin Self.Initialize (Data.all'Address, Data.all'Size / 8, - Internal_free'Unrestricted_Access); + Internal_Free'Unrestricted_Access); end Initialize_Generic; ---------------------------------- @@ -156,24 +156,24 @@ package body ZMQ.Messages is Data : Element_Access; Hint : Hint_Access) is - function convHint is new + function ConvHint is new Ada.Unchecked_Conversion (Source => System.Address, Target => Hint_Access); - function conv is new + function Conv is new Ada.Unchecked_Conversion (Source => System.Address, Target => Element_Access); - procedure Internal_free (Data : System.Address; Hint : System.Address); - procedure Internal_free (Data : System.Address; Hint : System.Address) is - Temp_Data : Element_Access := conv (Data); - Temp_Hint : constant Hint_Access := convHint (Hint); + procedure Internal_Free (Data : System.Address; Hint : System.Address); + procedure Internal_Free (Data : System.Address; Hint : System.Address) is + Temp_Data : Element_Access := Conv (Data); + Temp_Hint : constant Hint_Access := ConvHint (Hint); begin - free (Temp_Data, Temp_Hint); - end Internal_free; + Free (Temp_Data, Temp_Hint); + end Internal_Free; begin Self.Initialize (Data.all'Address, Data.all'Size / 8, - Internal_free'Unrestricted_Access, + Internal_Free'Unrestricted_Access, Hint.all'Address); end Initialize_Generic_With_Hint; @@ -185,65 +185,65 @@ package body ZMQ.Messages is --------------- -- getData -- --------------- - function getData (Self : Message) return System.Address is + function GetData (Self : Message) return System.Address is begin - return Low_Level.zmq_msg_data (Self.Msg'Unrestricted_Access); - end getData; + return Low_Level.Zmq_Msg_Data (Self.Msg'Unrestricted_Access); + end GetData; --------------- -- getData -- --------------- - function getData (Self : Message) return String is - type data_type is new String (1 .. Self.getSize); - package conv is new System.Address_To_Access_Conversions (data_type); + function GetData (Self : Message) return String is + type Data_Type is new String (1 .. Self.GetSize); + package Conv is new System.Address_To_Access_Conversions (Data_Type); begin - return String (conv.To_Pointer (Self.getData).all); - end getData; + return String (Conv.To_Pointer (Self.GetData).all); + end GetData; --------------- -- getData -- --------------- - function getData (Self : Message) + function GetData (Self : Message) return Ada.Streams.Stream_Element_Array is - type data_type is new Ada.Streams.Stream_Element_Array - (1 .. Ada.Streams.Stream_Element_Offset (Self.getSize)); - package conv is new System.Address_To_Access_Conversions (data_type); + type Data_Type is new Ada.Streams.Stream_Element_Array + (1 .. Ada.Streams.Stream_Element_Offset (Self.GetSize)); + package Conv is new System.Address_To_Access_Conversions (Data_Type); begin return Ada.Streams.Stream_Element_Array - (conv.To_Pointer (Self.getData).all); - end getData; + (Conv.To_Pointer (Self.GetData).all); + end GetData; --------------- -- getData -- --------------- - function getData (Self : Message) + function GetData (Self : Message) return Ada.Strings.Unbounded.Unbounded_String is - type data_type is new String (1 .. Self.getSize); - package conv is new System.Address_To_Access_Conversions (data_type); + type Data_Type is new String (1 .. Self.GetSize); + package Conv is new System.Address_To_Access_Conversions (Data_Type); begin return Ada.Strings.Unbounded.To_Unbounded_String - (String (conv.To_Pointer (Self.getData).all)); - end getData; + (String (Conv.To_Pointer (Self.GetData).all)); + end GetData; ----------------------- -- getData_Generic -- ----------------------- - function getData_Generic (Self : Message) + function GetData_Generic (Self : Message) return Element is - package conv is new System.Address_To_Access_Conversions (Element); + package Conv is new System.Address_To_Access_Conversions (Element); begin - return conv.To_Pointer (Self.getData).all; - end getData_Generic; + return Conv.To_Pointer (Self.GetData).all; + end GetData_Generic; --------------- -- getSize -- --------------- - function getSize (Self : Message) return Natural is + function GetSize (Self : Message) return Natural is begin - return Natural (Low_Level.zmq_msg_size (Self.Msg'Unrestricted_Access)); - end getSize; + return Natural (Low_Level.Zmq_Msg_Size (Self.Msg'Unrestricted_Access)); + end GetSize; -------------- @@ -251,12 +251,12 @@ package body ZMQ.Messages is -------------- procedure Finalize (Self : in out Message) is - ret : int; + Ret : int; begin - ret := Low_Level.zmq_msg_close (Self.Msg'Access); - if ret /= 0 then + Ret := Low_Level.Zmq_Msg_Close (Self.Msg'Access); + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; + GNAT.Source_Info.Enclosing_Entity; end if; end Finalize; @@ -264,17 +264,17 @@ package body ZMQ.Messages is -- getImpl -- ------------- - function getImpl (Self : Message) return not null zmq_msg_t_Access is + function GetImpl (Self : Message) return not null Zmq_Msg_T_Access is begin return Self.Msg'Unrestricted_Access; - end getImpl; + end GetImpl; - procedure process_data_generic + procedure Process_Data_Generic (Self : Message; - Handle : access procedure (item : Element)) is - package conv is new System.Address_To_Access_Conversions (Element); + Handle : access procedure (Item : Element)) is + package Conv is new System.Address_To_Access_Conversions (Element); begin - Handle (conv.To_Pointer (Self.getData).all); - end process_data_generic; + Handle (Conv.To_Pointer (Self.GetData).all); + end Process_Data_Generic; end ZMQ.Messages; diff --git a/src/zmq-messages.ads b/src/zmq-messages.ads index 320c03c..e5fb276 100644 --- a/src/zmq-messages.ads +++ b/src/zmq-messages.ads @@ -78,8 +78,8 @@ package ZMQ.Messages is type Free_Proc is not null access - procedure (data : System.Address; Hint : System.Address); - procedure Null_Free (data : System.Address; Hint : System.Address) is null; + procedure (Data : System.Address; Hint : System.Address); + procedure Null_Free (Data : System.Address; Hint : System.Address) is null; procedure Initialize (Self : in out Message; Message : System.Address; Size : Natural; @@ -91,7 +91,7 @@ package ZMQ.Messages is generic type Element is private; type Element_Access is access Element; - with procedure free (data : in out Element_Access) is <>; + with procedure Free (Data : in out Element_Access) is <>; procedure Initialize_Generic (Self : in out Message; Data : Element_Access); @@ -101,8 +101,8 @@ package ZMQ.Messages is type Element_Access is access Element; type Hint_Type is private; type Hint_Access is access Hint_Type; - with procedure free - (data : in out Element_Access; hint : Hint_Access) is <>; + with procedure Free + (Data : in out Element_Access; Hint : Hint_Access) is <>; procedure Initialize_Generic_With_Hint (Self : in out Message; Data : Element_Access; Hint : Hint_Access); @@ -111,34 +111,34 @@ package ZMQ.Messages is procedure Finalize (Self : in out Message); - type zmq_msg_t_Access is access all ZMQ.Low_Level.zmq_msg_t; - function getImpl (Self : Message) return not null zmq_msg_t_Access; + type Zmq_Msg_T_Access is access all ZMQ.Low_Level.Zmq_Msg_T; + function GetImpl (Self : Message) return not null Zmq_Msg_T_Access; - function getData (Self : Message) + function GetData (Self : Message) return String; - function getData (Self : Message) + function GetData (Self : Message) return Ada.Streams.Stream_Element_Array; - function getData (Self : Message) + function GetData (Self : Message) return Ada.Strings.Unbounded.Unbounded_String; generic type Element is private; - function getData_Generic (Self : Message) + function GetData_Generic (Self : Message) return Element; generic type Element is private; - procedure process_data_generic + procedure Process_Data_Generic (Self : Message; - Handle : access procedure (item : in Element)); + Handle : access procedure (Item : in Element)); - function getData (Self : Message) return System.Address; - function getSize (Self : Message) return Natural; + function GetData (Self : Message) return System.Address; + function GetSize (Self : Message) return Natural; private type Message is tagged limited record - Msg : aliased ZMQ.Low_Level.zmq_msg_t; + Msg : aliased ZMQ.Low_Level.Zmq_Msg_T; end record; end ZMQ.Messages; diff --git a/src/zmq-pollsets.adb b/src/zmq-pollsets.adb index 645b928..f1490d5 100644 --- a/src/zmq-pollsets.adb +++ b/src/zmq-pollsets.adb @@ -29,6 +29,7 @@ package body ZMQ.Pollsets is ------------ procedure append (this : in out Pollset; item : pollitem'Class) is + pragma Unreferenced (this, item); begin -- Generated stub: replace with real body! pragma Compile_Time_Warning (Standard.True, "append unimplemented"); @@ -40,6 +41,7 @@ package body ZMQ.Pollsets is ------------ procedure remove (this : in out Pollset; item : pollitem'Class) is + pragma Unreferenced (this, item); begin -- Generated stub: replace with real body! pragma Compile_Time_Warning (Standard.True, "remove unimplemented"); @@ -54,6 +56,7 @@ package body ZMQ.Pollsets is (this : in out Pollset; Timeout : Duration) is + pragma Unreferenced (this, Timeout); begin -- Generated stub: replace with real body! pragma Compile_Time_Warning (Standard.True, "poll unimplemented"); diff --git a/src/zmq-sockets-streams.adb b/src/zmq-sockets-streams.adb new file mode 100755 index 0000000..4debace --- /dev/null +++ b/src/zmq-sockets-streams.adb @@ -0,0 +1,79 @@ +package body ZMQ.Sockets.Streams is + + ------------ + -- stream -- + ------------ + + function stream (this : Stream_Socket) return Stream_Access is + begin + -- Generated stub: replace with real body! + pragma Compile_Time_Warning (Standard.True, "stream unimplemented"); + raise Program_Error with "Unimplemented function stream"; + return stream (this); + end stream; + + ---------- + -- Read -- + ---------- + + procedure Read + (File : Stream_Socket; + Item : out Stream_Element_Array; + Last : out Stream_Element_Offset; + From : Positive_Count) + is + pragma Unreferenced (File, Item, Last, From); + begin + -- Generated stub: replace with real body! + pragma Compile_Time_Warning (Standard.True, "Read unimplemented"); + raise Program_Error with "Unimplemented procedure Read"; + end Read; + + ---------- + -- Read -- + ---------- + + procedure Read + (File : Stream_Socket; + Item : out Stream_Element_Array; + Last : out Stream_Element_Offset) + is + pragma Unreferenced (File, Item, Last); + begin + -- Generated stub: replace with real body! + pragma Compile_Time_Warning (Standard.True, "Read unimplemented"); + raise Program_Error with "Unimplemented procedure Read"; + end Read; + + ----------- + -- Write -- + ----------- + + procedure Write + (File : Stream_Socket; + Item : Stream_Element_Array; + To : Positive_Count) + is + pragma Unreferenced (File, Item, To); + begin + -- Generated stub: replace with real body! + pragma Compile_Time_Warning (Standard.True, "Write unimplemented"); + raise Program_Error with "Unimplemented procedure Write"; + end Write; + + ----------- + -- Write -- + ----------- + + procedure Write + (File : Stream_Socket; + Item : Stream_Element_Array) + is + pragma Unreferenced (File, Item); + begin + -- Generated stub: replace with real body! + pragma Compile_Time_Warning (Standard.True, "Write unimplemented"); + raise Program_Error with "Unimplemented procedure Write"; + end Write; + +end ZMQ.Sockets.Streams; diff --git a/src/zmq-sockets-streams.ads b/src/zmq-sockets-streams.ads new file mode 100755 index 0000000..f0c6b1d --- /dev/null +++ b/src/zmq-sockets-streams.ads @@ -0,0 +1,40 @@ +with Ada.Streams; use Ada.Streams; +with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; +package ZMQ.Sockets.Streams is + type Stream_Access is access all Root_Stream_Type'Class; + + type Stream_Socket (With_Context : Contexts.Any_Context; + Kind : Socket_Type; + Buffer_Size : Positive) is new Socket with private; + + function stream (this : Stream_Socket) return Stream_Access; + + procedure Read + (File : Stream_Socket; + Item : out Stream_Element_Array; + Last : out Stream_Element_Offset; + From : Positive_Count); + + procedure Read + (File : Stream_Socket; + Item : out Stream_Element_Array; + Last : out Stream_Element_Offset); + + procedure Write + (File : Stream_Socket; + Item : Stream_Element_Array; + To : Positive_Count); + + procedure Write + (File : Stream_Socket; + Item : Stream_Element_Array); + + +private + type Stream_Socket + (With_Context : Contexts.Any_Context; + Kind : Socket_Type; + Buffer_Size : Positive) is new Socket (With_Context, Kind) with + null record; +end ZMQ.Sockets.Streams; + diff --git a/src/zmq-sockets.adb b/src/zmq-sockets.adb index efcd354..21706bd 100644 --- a/src/zmq-sockets.adb +++ b/src/zmq-sockets.adb @@ -31,7 +31,6 @@ with ZMQ.Low_Level; with Interfaces.C.Strings; -with GNAT.OS_Lib; with GNAT.Source_Info; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; package body ZMQ.Sockets is @@ -41,65 +40,71 @@ package body ZMQ.Sockets is use Ada.Streams; type Map_Array is array (Socket_Opt) of int; Map : constant Map_Array := - (HWM => Low_Level.Defs.ZMQ_HWM, - SWAP => Low_Level.Defs.ZMQ_SWAP, - AFFINITY => Low_Level.Defs.ZMQ_AFFINITY, - IDENTITY => Low_Level.Defs.ZMQ_IDENTITY, - SUBSCRIBE => Low_Level.Defs.ZMQ_SUBSCRIBE, - UNSUBSCRIBE => Low_Level.Defs.ZMQ_UNSUBSCRIBE, - RATE => Low_Level.Defs.ZMQ_RATE, - RECOVERY_IVL => Low_Level.Defs.ZMQ_RECOVERY_IVL, - MCAST_LOOP => Low_Level.Defs.ZMQ_MCAST_LOOP, - SNDBUF => Low_Level.Defs.ZMQ_SNDBUF, - RCVBUF => Low_Level.Defs.ZMQ_RCVBUF, - RCVMORE => Low_Level.Defs.ZMQ_RCVMORE, - FD => Low_Level.Defs.ZMQ_FD, - EVENTS => Low_Level.Defs.ZMQ_EVENTS, - GET_TYPE => Low_Level.Defs.ZMQ_TYPE, - LINGER => Low_Level.Defs.ZMQ_LINGER, - RECONNECT_IVL => Low_Level.Defs.ZMQ_RECONNECT_IVL, - BACKLOG => Low_Level.Defs.ZMQ_BACKLOG + (AFFINITY => Low_Level.ZMQ_AFFINITY, + IDENTITY => Low_Level.ZMQ_IDENTITY, + SUBSCRIBE => Low_Level.ZMQ_SUBSCRIBE, + UNSUBSCRIBE => Low_Level.ZMQ_UNSUBSCRIBE, + RATE => Low_Level.ZMQ_RATE, + RECOVERY_IVL => Low_Level.ZMQ_RECOVERY_IVL, + SNDBUF => Low_Level.ZMQ_SNDBUF, + RCVBUF => Low_Level.ZMQ_RCVBUF, + RCVMORE => Low_Level.ZMQ_RCVMORE, + FD => Low_Level.ZMQ_FD, + EVENTS => Low_Level.ZMQ_EVENTS, + GET_TYPE => Low_Level.ZMQ_TYPE, + LINGER => Low_Level.ZMQ_LINGER, + RECONNECT_IVL => Low_Level.ZMQ_RECONNECT_IVL, + BACKLOG => Low_Level.ZMQ_BACKLOG, + RECONNECT_IVL_MAX => Low_Level.ZMQ_RECONNECT_IVL_MAX, + MAXMSGSIZE => Low_Level.ZMQ_MAXMSGSIZE, + SNDHWM => Low_Level.ZMQ_SNDHWM, + RCVHWM => Low_Level.ZMQ_RCVHWM, + MULTICAST_HOPS => Low_Level.ZMQ_MULTICAST_HOPS, + RCVTIMEO => Low_Level.ZMQ_RCVTIMEO, + SNDTIMEO => Low_Level.ZMQ_SNDTIMEO, + IPV4ONLY => Low_Level.ZMQ_IPV4ONLY, + LAST_ENDPOINT => Low_Level.ZMQ_LAST_ENDPOINT, + ROUTER_BEHAVIOR => Low_Level.ZMQ_ROUTER_BEHAVIOR, + TCP_KEEPALIVE => Low_Level.ZMQ_TCP_KEEPALIVE, + TCP_KEEPALIVE_CNT => Low_Level.ZMQ_TCP_KEEPALIVE_CNT, + TCP_KEEPALIVE_IDLE => Low_Level.ZMQ_TCP_KEEPALIVE_IDLE, + TCP_KEEPALIVE_INTVL => Low_Level.ZMQ_TCP_KEEPALIVE_INTVL, + TCP_ACCEPT_FILTER => Low_Level.ZMQ_TCP_ACCEPT_FILTER, + DELAY_ATTACH_ON_CONNECT => Low_Level.ZMQ_DELAY_ATTACH_ON_CONNECT, + XPUB_VERBOSE => Low_Level.ZMQ_XPUB_VERBOSE ); - function img (item : Ada.Streams.Stream_Element_Array) return String is - ret : String (1 .. item'Length * 2); - cursor : Natural := 1; - type map_string is array (Stream_Element (0) .. + function Img (Item : Ada.Streams.Stream_Element_Array) return String is + Ret : String (1 .. Item'Length * 2); + Cursor : Natural := 1; + type Map_String is array (Stream_Element (0) .. Stream_Element (15)) of Character; - hex : constant map_string := ('0', '1', '2', '3', - '4', '5', '6', '7', - '8', '9', 'A', 'B', - 'C', 'D', 'E', 'F'); + Hex : constant Map_String := ('0', '1', '2', '3', + '4', '5', '6', '7', + '8', '9', 'A', 'B', + 'C', 'D', 'E', 'F'); begin - for i in item'Range loop - ret (cursor) := hex (item (i) / 16); - cursor := cursor + 1; - ret (cursor) := hex (item (i) mod 16); - cursor := cursor + 1; + for I in Item'Range loop + Ret (Cursor) := Hex (Item (I) / 16); + Cursor := Cursor + 1; + Ret (Cursor) := Hex (Item (I) mod 16); + Cursor := Cursor + 1; end loop; - return ret; - end img; + return Ret; + end Img; ---------------- -- Initialize -- ---------------- - not overriding procedure Initialize - (This : in out Socket; - With_Context : Contexts.Context; - Kind : Socket_Type) + overriding procedure Initialize + (This : in out Socket) is begin - if With_Context.GetImpl = Null_Address then - raise ZMQ_Error with "Contecxt Not Initialized"; - end if; - if This.c /= Null_Address then - raise ZMQ_Error with "Socket Initialized"; - end if; - This.c := Low_Level.zmq_socket (With_Context.GetImpl, - Socket_Type'Pos (Kind)); - if This.c = Null_Address then + This.C := Low_Level.zmq_socket (This.With_Context.GetImpl, + Socket_Type'Pos (This.Kind)); + if This.C = Null_Address then raise ZMQ_Error with "Unable to initialize"; end if; end Initialize; @@ -112,12 +117,12 @@ package body ZMQ.Sockets is (This : in out Socket; Address : String) is - addr : chars_ptr := Interfaces.C.Strings.New_String (Address); - ret : int; + Addr : chars_ptr := Interfaces.C.Strings.New_String (Address); + Ret : int; begin - ret := Low_Level.zmq_bind (This.c, addr); - Free (addr); - if ret /= 0 then + Ret := Low_Level.zmq_bind (This.C, Addr); + Free (Addr); + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")"; end if; @@ -129,73 +134,73 @@ package body ZMQ.Sockets is This.Bind (To_String (Address)); end Bind; - procedure setsockopt (This : in out Socket; + procedure Setsockopt (This : in out Socket; Option : Socket_Opt; Value : System.Address; Value_Size : Natural) is - ret : int; + Ret : int; begin - ret := Low_Level.zmq_setsockopt - (This.c, + Ret := Low_Level.zmq_setsockopt + (This.C, Map (Option), Value, size_t (Value_Size)); - if ret /= 0 then + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity & "(" & Option'Img & ")"; end if; - end setsockopt; + end Setsockopt; ---------------- -- setsockopt -- ---------------- - not overriding procedure setsockopt + not overriding procedure Setsockopt (This : in out Socket; Option : Socket_Opt; Value : String) is begin - This.setsockopt (Option, Value'Address, Value'Length); - end setsockopt; + This.Setsockopt (Option, Value'Address, Value'Length); + end Setsockopt; ---------------- -- setsockopt -- ---------------- - not overriding procedure setsockopt + not overriding procedure Setsockopt (This : in out Socket; Option : Socket_Opt; Value : Boolean) is begin - This.setsockopt (Option, Value'Address, 1); - end setsockopt; + This.Setsockopt (Option, Value'Address, 1); + end Setsockopt; ---------------- -- setsockopt -- ---------------- - not overriding procedure setsockopt + not overriding procedure Setsockopt (This : in out Socket; Option : Socket_Opt; Value : Natural) is begin - This.setsockopt (Option, Value'Address, 4); - end setsockopt; + This.Setsockopt (Option, Value'Address, 4); + end Setsockopt; ---------------- -- setsockopt -- ---------------- - not overriding procedure setsockopt + not overriding procedure Setsockopt (This : in out Socket; Option : Socket_Opt; Value : Ada.Streams.Stream_Element_Array) is begin - This.setsockopt (Option, Value (Value'First)'Address, Value'Length); - end setsockopt; + This.Setsockopt (Option, Value (Value'First)'Address, Value'Length); + end Setsockopt; ------------- -- Connect -- @@ -205,12 +210,12 @@ package body ZMQ.Sockets is (This : in out Socket; Address : String) is - addr : chars_ptr := Interfaces.C.Strings.New_String (Address); - ret : int; + Addr : chars_ptr := Interfaces.C.Strings.New_String (Address); + Ret : int; begin - ret := Low_Level.zmq_connect (This.c, addr); - Free (addr); - if ret /= 0 then + Ret := Low_Level.zmq_connect (This.C, Addr); + Free (Addr); + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")"; end if; @@ -228,51 +233,29 @@ package body ZMQ.Sockets is -- Send -- ---------- - not overriding procedure Send - (This : in out Socket; - Msg : Messages.Message'Class; - Flags : Socket_Flags := No_Flags) - is - ret : int; - begin - ret := Low_Level.zmq_send (This.c, Msg.getImpl, int (Flags)); - if ret /= 0 then - raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & - GNAT.Source_Info.Enclosing_Entity; - end if; - end Send; not overriding procedure Send (This : in out Socket; Msg : String; Flags : Socket_Flags := No_Flags) is - m : Messages.Message; begin - m.Initialize (Msg); - This.Send (m, Flags); - m.Finalize; + This.Send (Msg'Address, Msg'Length, Flags); end Send; not overriding procedure Send (This : in out Socket; Msg : Ada.Streams.Stream_Element_Array; Flags : Socket_Flags := No_Flags) is - M : Messages.Message; begin - M.Initialize (Msg); - This.Send (M, Flags); - M.Finalize; + This.Send (Msg'Address, Msg'Length, Flags); end Send; not overriding procedure Send (This : in out Socket; Msg : Ada.Strings.Unbounded.Unbounded_String; Flags : Socket_Flags := No_Flags) is - M : Messages.Message; begin - M.Initialize (Ada.Strings.Unbounded.To_String (Msg)); - This.Send (M, Flags); - M.Finalize; + This.Send (Ada.Strings.Unbounded.To_String (Msg), Flags); end Send; procedure Send_Generic (This : in out Socket; @@ -293,11 +276,15 @@ package body ZMQ.Sockets is Msg_Addres : System.Address; Msg_Length : Natural; Flags : Socket_Flags := No_Flags) is - M : Messages.Message; + Ret : int; begin - M.Initialize (Msg_Addres, Msg_Length); - This.Send (M, Flags); - M.Finalize; + Ret := Low_Level.zmq_send (This.C, Msg_Addres, + size_t (Msg_Length), + int (Flags)); + if Ret /= 0 then + raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & + GNAT.Source_Info.Enclosing_Entity; + end if; end Send; @@ -321,342 +308,303 @@ package body ZMQ.Sockets is -- recv -- ---------- - not overriding procedure recv + not overriding procedure Recv (This : in Socket; Msg : Messages.Message'Class; Flags : Socket_Flags := No_Flags) is - ret : int; + Ret : int; begin - ret := Low_Level.zmq_recv (This.c, - Msg.getImpl, - int (Flags)); + Ret := Low_Level.zmq_recvmsg (This.C, + Msg.GetImpl, + int (Flags)); - if ret /= 0 then + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity; end if; - end recv; + end Recv; - procedure recv (This : in Socket; + procedure Recv (This : in Socket; Flags : Socket_Flags := No_Flags) is - dummy_Msg : Messages.Message; + Dummy_Msg : Messages.Message; begin - dummy_Msg.Initialize; - This.recv (dummy_Msg, Flags); - dummy_Msg.Finalize; - end recv; - - not overriding - function recv (This : in Socket; - Flags : Socket_Flags := No_Flags) return String is - Msg : Messages.Message; - begin - Msg.Initialize; - This.recv (Msg, Flags); - return ret : String (1 .. Msg.getSize) do - ret := Msg.getData; - end return; - end recv; - procedure recv (This : in Socket; - msg : out Ada.Strings.Unbounded.Unbounded_String; - Flags : Socket_Flags := No_Flags) is - begin - msg := Ada.Strings.Unbounded.To_Unbounded_String (This.recv (Flags)); - end recv; + Dummy_Msg.Initialize; + This.Recv (Dummy_Msg, Flags); + Dummy_Msg.Finalize; + end Recv; not overriding - function recv (This : in Socket; + function Recv (This : in Socket; + Max_Length : Natural := 1024; + Flags : Socket_Flags := No_Flags) return String is + Buffer : String (1 .. Max_Length); + begin + This.Recv (Buffer'Address, Buffer'Length, Flags); + + end Recv; + + procedure Recv (This : in Socket; + Msg : out Ada.Strings.Unbounded.Unbounded_String; + Flags : Socket_Flags := No_Flags) is + begin + Msg := Ada.Strings.Unbounded.To_Unbounded_String (This.Recv (Flags)); + end Recv; + + + not overriding + function Recv (This : in Socket; Flags : Socket_Flags := No_Flags) return Ada.Strings.Unbounded.Unbounded_String is begin - return ret : Ada.Strings.Unbounded.Unbounded_String do - This.recv (ret, Flags); + return Ret : Ada.Strings.Unbounded.Unbounded_String do + This.Recv (Ret, Flags); end return; - end recv; + end Recv; -------------- -- Finalize -- -------------- overriding procedure Finalize - (this : in out Socket) + (This : in out Socket) is - ret : int; + Ret : int; begin - if this.c /= Null_Address then - ret := Low_Level.zmq_close (this.c); - this.c := Null_Address; - if ret /= 0 then + if This.C /= Null_Address then + Ret := Low_Level.zmq_close (This.C); + This.C := Null_Address; + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno); end if; end if; end Finalize; - not overriding - - procedure Set_high_water_mark (This : in out Socket; - Value : Natural) is - begin - This.setsockopt (HWM, Value); - end Set_high_water_mark; not overriding - procedure Set_disk_offload_size (This : in out Socket; - Value : Natural) is - begin - This.setsockopt (SWAP, Value); - end Set_disk_offload_size; - - not overriding - procedure Set_IO_thread_affinity (This : in out Socket; + procedure Set_IO_Thread_Affinity (This : in out Socket; Value : Natural) is begin - This.setsockopt (AFFINITY, Value); - end Set_IO_thread_affinity; + This.Setsockopt (AFFINITY, Value); + end Set_IO_Thread_Affinity; not overriding - procedure Set_socket_identity + procedure Set_Socket_Identity (This : in out Socket; Value : Ada.Streams.Stream_Element_Array) is begin - This.setsockopt (IDENTITY, Value); - end Set_socket_identity; + This.Setsockopt (IDENTITY, Value); + end Set_Socket_Identity; - procedure Set_socket_identity + procedure Set_Socket_Identity (This : in out Socket; Value : String) is begin - This.setsockopt (IDENTITY, Value); - end Set_socket_identity; + This.Setsockopt (IDENTITY, Value); + end Set_Socket_Identity; not overriding - procedure Establish_message_filter (This : in out Socket; + procedure Establish_Message_Filter (This : in out Socket; Value : String) is begin - This.setsockopt (SUBSCRIBE, Value); - end Establish_message_filter; + This.Setsockopt (SUBSCRIBE, Value); + end Establish_Message_Filter; not overriding - procedure Establish_message_filter + procedure Establish_Message_Filter (This : in out Socket; Value : Ada.Streams.Stream_Element_Array) is begin - This.setsockopt (SUBSCRIBE, Value); - end Establish_message_filter; + This.Setsockopt (SUBSCRIBE, Value); + end Establish_Message_Filter; - procedure Establish_message_filter + procedure Establish_Message_Filter (This : in out Socket; Value : Ada.Strings.Unbounded.Unbounded_String) is begin - This.setsockopt (SUBSCRIBE, To_String (Value)); - end Establish_message_filter; + This.Setsockopt (SUBSCRIBE, To_String (Value)); + end Establish_Message_Filter; not overriding - procedure Remove_message_filter (This : in out Socket; + procedure Remove_Message_Filter (This : in out Socket; Value : String) is begin - This.setsockopt (UNSUBSCRIBE, Value); - end Remove_message_filter; + This.Setsockopt (UNSUBSCRIBE, Value); + end Remove_Message_Filter; - procedure Remove_message_filter + procedure Remove_Message_Filter (This : in out Socket; Value : Ada.Strings.Unbounded.Unbounded_String) is begin - This.setsockopt (UNSUBSCRIBE, To_String (Value)); - end Remove_message_filter; + This.Setsockopt (UNSUBSCRIBE, To_String (Value)); + end Remove_Message_Filter; - procedure Remove_message_filter + procedure Remove_Message_Filter (This : in out Socket; Value : Ada.Streams.Stream_Element_Array) is begin - This.setsockopt (UNSUBSCRIBE, Value); - end Remove_message_filter; + This.Setsockopt (UNSUBSCRIBE, Value); + end Remove_Message_Filter; not overriding - procedure Set_multicast_data_rate (This : in out Socket; + procedure Set_Multicast_Data_Rate (This : in out Socket; Value : Natural) is begin - This.setsockopt (RATE, Value); - end Set_multicast_data_rate; + This.Setsockopt (RATE, Value); + end Set_Multicast_Data_Rate; not overriding - procedure set_multicast_recovery_interval (This : in out Socket; + procedure Set_Multicast_Recovery_Interval (This : in out Socket; Value : Duration) is begin - This.setsockopt (RECOVERY_IVL, Integer (Value)); - end set_multicast_recovery_interval; + This.Setsockopt (RECOVERY_IVL, Integer (Value)); + end Set_Multicast_Recovery_Interval; not overriding - procedure Set_multicast_loopback (This : in out Socket; - Enable : Boolean) is - begin - This.setsockopt (HWM, Enable); - end Set_multicast_loopback; - not overriding - procedure Set_kernel_transmit_buffer_size (This : in out Socket; + procedure Set_Kernel_Transmit_Buffer_Size (This : in out Socket; Value : Natural) is begin - This.setsockopt (SNDBUF, Value); - end Set_kernel_transmit_buffer_size; + This.Setsockopt (SNDBUF, Value); + end Set_Kernel_Transmit_Buffer_Size; not overriding - procedure Set_kernel_receive_buffer_size (This : in out Socket; + procedure Set_Kernel_Receive_Buffer_Size (This : in out Socket; Value : Natural) is begin - This.setsockopt (RCVBUF, Value); - end Set_kernel_receive_buffer_size; + This.Setsockopt (RCVBUF, Value); + end Set_Kernel_Receive_Buffer_Size; - function get_impl (This : in Socket) return System.Address is + function Get_Impl (This : in Socket) return System.Address is begin - return This.c; - end get_impl; + return This.C; + end Get_Impl; ------------- not overriding - procedure getsockopt (This : in Socket; + procedure Getsockopt (This : in Socket; Option : Socket_Opt; Value : System.Address; Value_Size : out Natural) is - ret : int; - Value_Size_i : aliased size_t; + Ret : int; + Value_Size_I : aliased size_t; begin - ret := Low_Level.zmq_getsockopt - (This.c, + Ret := Low_Level.zmq_getsockopt + (This.C, Map (Option), Value, - Value_Size_i'Access); - Value_Size := Natural (Value_Size_i); - if ret /= 0 then + Value_Size_I'Access); + Value_Size := Natural (Value_Size_I); + if Ret /= 0 then raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity & "(" & Option'Img & ")"; end if; - end getsockopt; + end Getsockopt; not overriding - function getsockopt (This : in Socket; + function Getsockopt (This : in Socket; Option : Socket_Opt) return unsigned_long is Dummy_Value_Size : Natural; begin - return ret : unsigned_long do - This.getsockopt (Option, ret'Address, Dummy_Value_Size); + return Ret : unsigned_long do + This.Getsockopt (Option, Ret'Address, Dummy_Value_Size); if Dummy_Value_Size /= 8 then raise Program_Error with "Invalid getsockopt for this type"; end if; end return; - end getsockopt; + end Getsockopt; - function getsockopt (This : in Socket; + function Getsockopt (This : in Socket; Option : Socket_Opt) return String is Buffer : aliased String (1 .. MAX_OPTION_SIZE); Value_Size : Natural; begin - This.getsockopt (Option, Buffer'Address, Value_Size); + This.Getsockopt (Option, Buffer'Address, Value_Size); return Buffer (1 .. Value_Size); - end getsockopt; + end Getsockopt; not overriding - function getsockopt (This : in Socket; + function Getsockopt (This : in Socket; Option : Socket_Opt) return Boolean is begin - return ret : Boolean do - ret := unsigned_long'(This.getsockopt (Option)) /= 0; + return Ret : Boolean do + Ret := unsigned_long'(This.Getsockopt (Option)) /= 0; end return; - end getsockopt; + end Getsockopt; not overriding - function getsockopt (This : in Socket; + function Getsockopt (This : in Socket; Option : Socket_Opt) return Natural is begin - return ret : Natural do - ret := Natural (unsigned_long'(This.getsockopt (Option))); + return Ret : Natural do + Ret := Natural (unsigned_long'(This.Getsockopt (Option))); end return; - end getsockopt; + end Getsockopt; not overriding - function getsockopt + function Getsockopt (This : in Socket; Option : Socket_Opt) return Ada.Streams.Stream_Element_Array is Buffer : aliased Stream_Element_Array (1 .. MAX_OPTION_SIZE); Value_Size : Ada.Streams.Stream_Element_Offset; begin - This.getsockopt (Option, Buffer'Address, Natural (Value_Size)); + This.Getsockopt (Option, Buffer'Address, Natural (Value_Size)); return Buffer (1 .. Value_Size); - end getsockopt; + end Getsockopt; - function More_message_parts_to_follow (This : Socket) return Boolean is + function More_Message_Parts_To_Follow (This : Socket) return Boolean is begin - return ret : Boolean do - ret := This.getsockopt (RCVMORE); + return Ret : Boolean do + Ret := This.Getsockopt (RCVMORE); end return; - end More_message_parts_to_follow; + end More_Message_Parts_To_Follow; - function Get_high_water_mark (This : Socket) return Natural is - begin - return ret : Natural do - ret := This.getsockopt (HWM); - end return; - end Get_high_water_mark; - - function Get_disk_offload_size (This : Socket) return Natural is - begin - return ret : Natural do - ret := This.getsockopt (SWAP); - end return; - end Get_disk_offload_size; - - function Get_IO_thread_affinity (This : Socket) return Thread_Bitmap is + function Get_IO_Thread_Affinity (This : Socket) return Thread_Bitmap is Value_Size : Natural; begin - return ret : Thread_Bitmap do - This.getsockopt (AFFINITY, ret'Address, Value_Size); + return Ret : Thread_Bitmap do + This.Getsockopt (AFFINITY, Ret'Address, Value_Size); if Value_Size /= 8 then raise Program_Error with "Invalid bitmap size " & Value_Size'Img; end if; end return; - end Get_IO_thread_affinity; + end Get_IO_Thread_Affinity; - function Get_socket_identity + function Get_Socket_Identity (This : Socket) return Ada.Streams.Stream_Element_Array is begin - return This.getsockopt (IDENTITY); - end Get_socket_identity; + return This.Getsockopt (IDENTITY); + end Get_Socket_Identity; - function Get_multicast_data_rate (This : Socket) return Natural is + function Get_Multicast_Data_Rate (This : Socket) return Natural is begin - return This.getsockopt (RATE); - end Get_multicast_data_rate; + return This.Getsockopt (RATE); + end Get_Multicast_Data_Rate; - function Get_multicast_recovery_interval (This : Socket) return Duration is + function Get_Multicast_Recovery_Interval (This : Socket) return Duration is begin - return Duration (unsigned_long'(This.getsockopt (RECOVERY_IVL))); - end Get_multicast_recovery_interval; + return Duration (unsigned_long'(This.Getsockopt (RECOVERY_IVL))); + end Get_Multicast_Recovery_Interval; - function Get_multicast_loopback (This : Socket) return Boolean is + function Get_Kernel_Transmit_Buffer_Size (This : Socket) return Natural is begin - return This.getsockopt (MCAST_LOOP); - end Get_multicast_loopback; + return This.Getsockopt (SNDBUF); + end Get_Kernel_Transmit_Buffer_Size; - function Get_kernel_transmit_buffer_size (This : Socket) return Natural is + function Get_Kernel_Receive_Buffer_Size (This : Socket) return Natural is begin - return This.getsockopt (SNDBUF); - end Get_kernel_transmit_buffer_size; - - function Get_kernel_receive_buffer_size (This : Socket) return Natural is - begin - return This.getsockopt (RCVBUF); - end Get_kernel_receive_buffer_size; + return This.Getsockopt (RCVBUF); + end Get_Kernel_Receive_Buffer_Size; end ZMQ.Sockets; diff --git a/src/zmq-sockets.ads b/src/zmq-sockets.ads index 7ee016d..f35cbd1 100644 --- a/src/zmq-sockets.ads +++ b/src/zmq-sockets.ads @@ -29,14 +29,13 @@ -- OTHER DEALINGS IN THE SOFTWARE. -- ------------------------------------------------------------------------------- - with Ada.Streams; with Ada.Finalization; with Ada.Strings.Unbounded; -with ZMQ.Messages; with ZMQ.Contexts; - +with ZMQ.Messages; with System; +with GNAT.OS_Lib; private with Interfaces.C; package ZMQ.Sockets is @@ -49,64 +48,43 @@ package ZMQ.Sockets is XREQ, XREP, PULL, - PUSH); + PUSH, + XPUB, + XSUB); + + type Socket + (With_Context : Contexts.Any_Context; + Kind : Socket_Type) is + new Ada.Finalization.Limited_Controlled with private; + - type Socket is new Ada.Finalization.Limited_Controlled with private; type Socket_Flags is mod 2 ** 32; - pragma Warnings (off); + pragma Warnings (Off); function "+" (L, R : Socket_Flags) return Socket_Flags renames "or"; - pragma Warnings (on); + pragma Warnings (On); No_Flags : constant Socket_Flags := 2#0000_0000_0000_0000#; More : constant Socket_Flags := 2#0000_0000_0000_0001#; Shared : constant Socket_Flags := 2#0000_0000_1000_0000#; - not overriding - procedure Initialize (This : in out Socket; - With_Context : Contexts.Context; - Kind : Socket_Type); not overriding - procedure Bind (This : in out Socket; - Address : String); + procedure Bind + (This : in out Socket; + Address : String); not overriding - procedure Bind (This : in out Socket; - Address : Ada.Strings.Unbounded.Unbounded_String); + procedure Bind + (This : in out Socket; + Address : Ada.Strings.Unbounded.Unbounded_String); not overriding - procedure Set_high_water_mark - (This : in out Socket; - Value : Natural); - -- Sets the high water mark for the specified socket. - -- The high water mark is a hard limit on the maximum number of - -- outstanding messages 0MQ shall queue in memory for any single peer - -- that the specified socket is communicating with. - -- If this limit has been reached the socket shall enter an exceptional - -- state and depending on the socket type, - -- 0MQ shall take appropriate action such as blocking or dropping - -- sent messages. - -- Refer to the individual socket descriptions in zmq_socket(3) - -- for details on the exact action taken for each socket type. - -- The default ZMQ_HWM value of zero means "no limit". - - not overriding - procedure Set_disk_offload_size (This : in out Socket; - Value : Natural); - -- Sets the disk offload (swap) size < for the specified socket. - -- A socket which has ZMQ_SWAP set to a non - zero value may exceed - - -- in this case outstanding messages shall be offloaded to storage on - -- disk rather than held in memory. - -- The value defines the maximum size of the swap space in bytes - - - not overriding - procedure Set_IO_thread_affinity (This : in out Socket; - Value : Natural); + procedure Set_IO_Thread_Affinity + (This : in out Socket; + Value : Natural); -- Sets the I/O thread affinity for newly created connections on the -- specified socket. -- Affinity determines which threads from the 0MQ I/O thread pool @@ -123,13 +101,13 @@ package ZMQ.Sockets is -- of I/O threads for a specific context. not overriding - procedure Set_socket_identity - (This : in out Socket; - Value : String); + procedure Set_Socket_Identity + (This : in out Socket; + Value : String); not overriding - procedure Set_socket_identity - (This : in out Socket; - Value : Ada.Streams.Stream_Element_Array); + procedure Set_Socket_Identity + (This : in out Socket; + Value : Ada.Streams.Stream_Element_Array); -- Sets the identity of the specified socket. -- Socket identity determines if existing 0MQ infastructure -- (message queues, forwarding devices) shall be identified with a specific @@ -146,15 +124,17 @@ package ZMQ.Sockets is -- by 0MQ infrastructure. not overriding - procedure Establish_message_filter (This : in out Socket; - Value : String); + procedure Establish_Message_Filter + (This : in out Socket; + Value : String); not overriding - procedure Establish_message_filter - (This : in out Socket; - Value : Ada.Strings.Unbounded.Unbounded_String); - procedure Establish_message_filter - (This : in out Socket; - Value : Ada.Streams.Stream_Element_Array); + procedure Establish_Message_Filter + (This : in out Socket; + Value : Ada.Strings.Unbounded.Unbounded_String); + not overriding + procedure Establish_Message_Filter + (This : in out Socket; + Value : Ada.Streams.Stream_Element_Array); -- Establishes a new message filter on a SUB socket. -- Newly created SUB sockets filters out all incoming messages, -- therefore you should call this option to establish an initial @@ -168,16 +148,17 @@ package ZMQ.Sockets is -- if it matches at least one filter. not overriding - procedure Remove_message_filter (This : in out Socket; - Value : String); + procedure Remove_Message_Filter + (This : in out Socket; + Value : String); not overriding - procedure Remove_message_filter - (This : in out Socket; - Value : Ada.Strings.Unbounded.Unbounded_String); + procedure Remove_Message_Filter + (This : in out Socket; + Value : Ada.Strings.Unbounded.Unbounded_String); not overriding - procedure Remove_message_filter - (This : in out Socket; - Value : Ada.Streams.Stream_Element_Array); + procedure Remove_Message_Filter + (This : in out Socket; + Value : Ada.Streams.Stream_Element_Array); -- Remove an existing message filter on a SUB socket. -- The filter specified must match an existing filter previously -- established with "Establish_message_filter". @@ -186,14 +167,16 @@ package ZMQ.Sockets is -- leaving the rest in place and functional. not overriding - procedure Set_multicast_data_rate (This : in out Socket; - Value : Natural); + procedure Set_Multicast_Data_Rate + (This : in out Socket; + Value : Natural); -- Sets the maximum send or receive data rate for multicast transports -- such as PGM using the specified socket. not overriding - procedure set_multicast_recovery_interval (This : in out Socket; - Value : Duration); + procedure Set_Multicast_Recovery_Interval + (This : in out Socket; + Value : Duration); -- Sets the recovery interval in seconds for multicast transports using -- the specified socket. -- The recovery interval determines the maximum time in seconds that a @@ -205,32 +188,21 @@ package ZMQ.Sockets is -- For example, a 1 minute recovery interval at a data rate of -- 1Gbps requires a 7GB in-memory buffer. - not overriding - procedure Set_multicast_loopback (This : in out Socket; - Enable : Boolean); - -- Controls whether data sent via multicast transports using - -- the specified socket can also be received by the sending host - -- via loopback. - -- A value of False disables the loopback functionality, - -- while the default value of True enables the loopback functionality. - -- Leaving multicast loopback enabled when it is not required can have - -- a negative impact on performance. - -- Where possible, disable multicast_loopback - -- in production environments. not overriding - procedure Set_kernel_transmit_buffer_size (This : in out Socket; - Value : Natural); + procedure Set_Kernel_Transmit_Buffer_Size + (This : in out Socket; + Value : Natural); -- Sets the underlying kernel transmit buffer size for the socket -- to the specified size in bytes. -- A value of zero means leave the OS default unchanged. -- For details please refer to your operating system documentation -- for the SO_SNDBUF socket option. - not overriding - procedure Set_kernel_receive_buffer_size (This : in out Socket; - Value : Natural); + procedure Set_Kernel_Receive_Buffer_Size + (This : in out Socket; + Value : Natural); -- Sets the underlying kernel receive buffer size for the socket to -- the specified size in bytes. -- A value of zero means leave the OS default unchanged. @@ -238,34 +210,23 @@ package ZMQ.Sockets is -- SO_RCVBUF socket option. - function More_message_parts_to_follow (This : Socket) return Boolean; + + + + + not overriding + function More_Message_Parts_To_Follow (This : Socket) return Boolean; -- Returns True if the multi-part message currently being read from the -- specified socket has more message parts to follow. -- If there are no message parts to follow or if the message currently -- being read is not a multi-part message a value of True will be returned. -- Otherwise, False will be returned. - function Get_high_water_mark (This : Socket) return Natural; - -- Returns the high water mark for the specified socket. - -- The high water mark is a hard limit on the maximum number of outstanding - -- messages ZMQ shall queue in memory for any single peer that - -- the specified socket is communicating with. - -- If this limit has been reached the socket shall enter an exceptional - -- state and depending on the socket type, ZMQ shall take appropriate - -- action such as blocking or dropping sent messages. - -- The default high_water_mark value of zero means "no limit". - function Get_disk_offload_size (This : Socket) return Natural; - -- Returns the disk offload (swap) size for the specified socket. - -- A socket which has SWAP set to a non-zero value may exceed - - -- in this case outstanding messages shall be offloaded to storage on disk - -- rather than held in memory. - -- The value of defines the maximum size of the swap space in bytes. type Thread_Bitmap is array (0 .. 63) of Boolean; pragma Pack (Thread_Bitmap); - function Get_IO_thread_affinity (This : Socket) return Thread_Bitmap; + function Get_IO_Thread_Affinity (This : Socket) return Thread_Bitmap; -- Returns the I/O thread affinity for newly created connections -- on the specified socket. -- Affinity determines which threads from the ZMQ I/O thread pool @@ -278,8 +239,9 @@ package ZMQ.Sockets is -- a value of 3 specifies that subsequent connections on socket shall be -- handled exclusively by I/O threads 1 and 2. - function Get_socket_identity - (This : Socket) return Ada.Streams.Stream_Element_Array; + function Get_Socket_Identity + (This : Socket) + return Ada.Streams.Stream_Element_Array; -- Returns the identity of the specified socket. -- Socket identity determines if existing ZMQ infastructure -- (message queues, forwarding devices) shall be identified with a specific @@ -295,68 +257,62 @@ package ZMQ.Sockets is -- Identities starting with binary zero are reserved for use by the -- ZMQ infrastructure. - function Get_multicast_data_rate (This : Socket) return Natural; + function Get_Multicast_Data_Rate (This : Socket) return Natural; -- Returns the maximum send or receive data rate for multicast transports -- using the specified socket. - function Get_multicast_recovery_interval (This : Socket) return Duration; + function Get_Multicast_Recovery_Interval (This : Socket) return Duration; -- Retrieves the recovery interval for multicast transports using the -- specified socket. -- The recovery interval determines the maximum time in seconds that -- a receiver can be absent from a multicast group before unrecoverable -- data loss will occur. - function Get_multicast_loopback (This : Socket) return Boolean; - -- Returns True if multicast transports shall be recievd bye the - -- loopback interface. - function Get_kernel_transmit_buffer_size (This : Socket) return Natural; + function Get_Kernel_Transmit_Buffer_Size (This : Socket) return Natural; -- Returns the underlying kernel transmit buffer size for the -- specified socket. -- A value of zero means that the OS default is in effect. -- For details refer to your operating system documentation for -- the SO_SNDBUF socket option. - function Get_kernel_receive_buffer_size (This : Socket) return Natural; + function Get_Kernel_Receive_Buffer_Size (This : Socket) return Natural; -- Returns the underlying kernel receive buffer size for the -- specified socket. -- A value of zero means that the OS default is in effect. -- For details refer to your operating system documentation -- for the SO_RCVBUF socket option - not overriding - procedure Connect (This : in out Socket; - Address : String); - - procedure Connect (This : in out Socket; - Address : Ada.Strings.Unbounded.Unbounded_String); + not overriding procedure Connect + (This : in out Socket; + Address : String); - not overriding - procedure Send (This : in out Socket; - Msg : Messages.Message'Class; - Flags : Socket_Flags := No_Flags); + procedure Connect + (This : in out Socket; + Address : Ada.Strings.Unbounded.Unbounded_String); - not overriding - procedure Send (This : in out Socket; - Msg : String; - Flags : Socket_Flags := No_Flags); - not overriding - procedure Send (This : in out Socket; - Msg : Ada.Strings.Unbounded.Unbounded_String; - Flags : Socket_Flags := No_Flags); + not overriding procedure Send + (This : in out Socket; + Msg : String; + Flags : Socket_Flags := No_Flags); - not overriding - procedure Send (This : in out Socket; - Msg : Ada.Streams.Stream_Element_Array; - Flags : Socket_Flags := No_Flags); + not overriding procedure Send + (This : in out Socket; + Msg : Ada.Strings.Unbounded.Unbounded_String; + Flags : Socket_Flags := No_Flags); - not overriding - procedure Send (This : in out Socket; - Msg_Addres : System.Address; - Msg_Length : Natural; - Flags : Socket_Flags := No_Flags); + not overriding procedure Send + (This : in out Socket; + Msg : Ada.Streams.Stream_Element_Array; + Flags : Socket_Flags := No_Flags); + + not overriding procedure Send + (This : in out Socket; + Msg_Addres : System.Address; + Msg_Length : Natural; + Flags : Socket_Flags := No_Flags); -- Queues the message referenced by the msg argument to be sent to socket -- The flags argument is a combination of the flags defined below: -- NOBLOCK @@ -392,123 +348,195 @@ package ZMQ.Sockets is generic type Element is private; - procedure Send_Generic (This : in out Socket; - Msg : Element; - Flags : Socket_Flags := No_Flags); - - + procedure Send_Generic + (This : in out Socket; + Msg : Element; + Flags : Socket_Flags := No_Flags); -- not overriding -- procedure flush (This : in out Socket); - not overriding - procedure recv (This : in Socket; - Msg : Messages.Message'Class; - Flags : Socket_Flags := No_Flags); - procedure recv (This : in Socket; - msg : out Ada.Strings.Unbounded.Unbounded_String; - Flags : Socket_Flags := No_Flags); + procedure Recv + (This : in Socket; + Msg : out Ada.Strings.Unbounded.Unbounded_String; + Flags : Socket_Flags := No_Flags); + + not overriding function Recv + (This : in Socket; + Flags : Socket_Flags := No_Flags) + return String; + + not overriding function Recv + (This : in Socket; + Flags : Socket_Flags := No_Flags) + return Ada.Strings.Unbounded.Unbounded_String; + + not overriding procedure Recv + (This : in Socket; + Msg : Messages.Message'Class; + Flags : Socket_Flags := No_Flags); + + procedure Recv (This : in Socket; Flags : Socket_Flags := No_Flags); - not overriding - function recv (This : in Socket; - Flags : Socket_Flags := No_Flags) return String; - not overriding - function recv (This : in Socket; - Flags : Socket_Flags := No_Flags) - return Ada.Strings.Unbounded.Unbounded_String; - - procedure recv (This : in Socket; - Flags : Socket_Flags := No_Flags); - - - overriding - procedure Finalize (this : in out Socket); - procedure Close (this : in out Socket) renames Finalize; + procedure Close (This : in out Socket) renames Finalize; -- + type Socket_Monitor is limited interface; + type Any_Socket_Monitor is access all Socket_Monitor'Class; + procedure Connected + (This : Socket_Monitor; + Address : String; + Fd : GNAT.OS_Lib.File_Descriptor) is null; + procedure Connect_Delayed + (This : Socket_Monitor; + Address : String; + Err : Integer) is null; + procedure Connect_Retried + (This : Socket_Monitor; + Address : String; + Interval : Duration) is null; + procedure Listening + (This : Socket_Monitor; + Address : String; + Fd : GNAT.OS_Lib.File_Descriptor) is null; + procedure Bind_Failed + (This : Socket_Monitor; + Address : String; + Err : Integer) is null; + procedure Accepted + (This : Socket_Monitor; + Address : String; + Fd : GNAT.OS_Lib.File_Descriptor) is null; + procedure Accept_Failed + (This : Socket_Monitor; + Address : String; + Err : Integer) is null; + procedure Closed + (This : Socket_Monitor; + Address : String; + Fd : GNAT.OS_Lib.File_Descriptor) is null; + procedure Close_Failed + (This : Socket_Monitor; + Address : String; + Err : Integer) is null; + procedure Disconnected + (This : Socket_Monitor; + Address : String; + Fd : GNAT.OS_Lib.File_Descriptor) is null; + + procedure Set_Monitor (This : Socket; + Monitor : Any_Socket_Monitor); + + -- function "=" (Left, Right : in Context) return Boolean; - function get_impl (This : in Socket) return System.Address; + function Get_Impl (This : in Socket) return System.Address; private - type Socket is new Ada.Finalization.Limited_Controlled with record - c : System.Address := System.Null_Address; + type Socket + (With_Context : Contexts.Any_Context; + Kind : Socket_Type) + is new Ada.Finalization.Limited_Controlled with record + C : System.Address := System.Null_Address; end record; - function img (item : Ada.Streams.Stream_Element_Array) return String; + function Img (Item : Ada.Streams.Stream_Element_Array) return String; + overriding + procedure Initialize + (This : in out Socket); + overriding + procedure Finalize (This : in out Socket); - type Socket_Opt is - (HWM, - SWAP, - AFFINITY, - IDENTITY, - SUBSCRIBE, - UNSUBSCRIBE, - RATE, - RECOVERY_IVL, - MCAST_LOOP, - SNDBUF, - RCVBUF, - RCVMORE, - FD, - EVENTS, - GET_TYPE, - LINGER, - RECONNECT_IVL, - BACKLOG); + type Socket_Opt is (AFFINITY, + IDENTITY, + SUBSCRIBE, + UNSUBSCRIBE, + RATE, + RECOVERY_IVL, + SNDBUF, + RCVBUF, + RCVMORE, + FD, + EVENTS, + GET_TYPE, + LINGER, + RECONNECT_IVL, + BACKLOG, --- + RECONNECT_IVL_MAX, + MAXMSGSIZE, + SNDHWM, + RCVHWM, + MULTICAST_HOPS, + RCVTIMEO, + SNDTIMEO, + IPV4ONLY, + LAST_ENDPOINT, + ROUTER_BEHAVIOR, + TCP_KEEPALIVE, + TCP_KEEPALIVE_CNT, + TCP_KEEPALIVE_IDLE, + TCP_KEEPALIVE_INTVL, + TCP_ACCEPT_FILTER, + DELAY_ATTACH_ON_CONNECT, + XPUB_VERBOSE); - not overriding - procedure setsockopt (This : in out Socket; - Option : Socket_Opt; - Value : String); - not overriding - procedure setsockopt (This : in out Socket; - Option : Socket_Opt; - Value : Boolean); - not overriding - procedure setsockopt (This : in out Socket; - Option : Socket_Opt; - Value : Natural); - not overriding - procedure setsockopt - (This : in out Socket; - Option : Socket_Opt; - Value : Ada.Streams.Stream_Element_Array); - not overriding - procedure setsockopt (This : in out Socket; - Option : Socket_Opt; - Value : System.Address; - Value_Size : Natural); + + not overriding procedure Setsockopt + (This : in out Socket; + Option : Socket_Opt; + Value : String); + not overriding procedure Setsockopt + (This : in out Socket; + Option : Socket_Opt; + Value : Boolean); + not overriding procedure Setsockopt + (This : in out Socket; + Option : Socket_Opt; + Value : Natural); + not overriding procedure Setsockopt + (This : in out Socket; + Option : Socket_Opt; + Value : Ada.Streams.Stream_Element_Array); + + not overriding procedure Setsockopt + (This : in out Socket; + Option : Socket_Opt; + Value : System.Address; + Value_Size : Natural); -------------------------------------------------------- -------------------------------------------------------- - function getsockopt (This : in Socket; - Option : Socket_Opt) return String; - not overriding - function getsockopt (This : in Socket; - Option : Socket_Opt) return Boolean; - not overriding - function getsockopt (This : in Socket; - Option : Socket_Opt) return Natural; - not overriding - function getsockopt - (This : in Socket; - Option : Socket_Opt) return Interfaces.C.unsigned_long; + function Getsockopt + (This : in Socket; + Option : Socket_Opt) + return String; + not overriding function Getsockopt + (This : in Socket; + Option : Socket_Opt) + return Boolean; + not overriding function Getsockopt + (This : in Socket; + Option : Socket_Opt) + return Natural; + not overriding function Getsockopt + (This : in Socket; + Option : Socket_Opt) + return Interfaces.C.unsigned_long; - not overriding - function getsockopt - (This : in Socket; - Option : Socket_Opt) return Ada.Streams.Stream_Element_Array; + not overriding function Getsockopt + (This : in Socket; + Option : Socket_Opt) + return Ada.Streams.Stream_Element_Array; - not overriding - procedure getsockopt (This : in Socket; - Option : Socket_Opt; - Value : System.Address; - Value_Size : out Natural); + not overriding procedure Getsockopt + (This : in Socket; + Option : Socket_Opt; + Value : System.Address; + Value_Size : out Natural); MAX_OPTION_SIZE : constant := 256; diff --git a/src/zmq-sockets.ads.npp b/src/zmq-sockets.ads.npp new file mode 100644 index 0000000..4c5a7b2 --- /dev/null +++ b/src/zmq-sockets.ads.npp @@ -0,0 +1,515 @@ +------------------------------------------------------------------------------- +-- -- +-- 0MQ Ada-binding -- +-- -- +-- Z M Q . S O C K E T S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2010-2011, per.sandberg@bredband.net -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files -- +-- (the "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, sublicense, and / or sell copies of the Software, and to -- +-- permit persons to whom the Software is furnished to do so, subject to -- +-- the following conditions : -- +-- -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, -- +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -- +-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -- +-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -- +-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -- +-- OTHER DEALINGS IN THE SOFTWARE. -- +------------------------------------------------------------------------------- + + +with Ada.Streams; +with Ada.Finalization; +with Ada.Strings.Unbounded; +with ZMQ.Messages; +with ZMQ.Contexts; + +with System; +private with Interfaces.C; +package ZMQ.Sockets is + + type Socket_Type is + (PAIR, + PUB, + SUB, + REQ, + REP, + XREQ, + XREP, + PULL, + PUSH); + + type Socket is new Ada.Finalization.Limited_Controlled with private; + + + type Socket_Flags is mod 2 ** 32; + + pragma Warnings (Off); + function "+" (L, R : Socket_Flags) return Socket_Flags renames "or"; + pragma Warnings (On); + No_Flags : constant Socket_Flags := 2#0000_0000_0000_0000#; + More : constant Socket_Flags := 2#0000_0000_0000_0001#; + Shared : constant Socket_Flags := 2#0000_0000_1000_0000#; + + not overriding + procedure Initialize (This : in out Socket; + With_Context : Contexts.Context; + Kind : Socket_Type); + + not overriding + procedure Bind (This : in out Socket; + Address : String); + + not overriding + procedure Bind (This : in out Socket; + Address : Ada.Strings.Unbounded.Unbounded_String); + + + not overriding + procedure Set_High_Water_Mark + (This : in out Socket; + Value : Natural); + -- Sets the high water mark for the specified socket. + -- The high water mark is a hard limit on the maximum number of + -- outstanding messages 0MQ shall queue in memory for any single peer + -- that the specified socket is communicating with. + -- If this limit has been reached the socket shall enter an exceptional + -- state and depending on the socket type, + -- 0MQ shall take appropriate action such as blocking or dropping + -- sent messages. + -- Refer to the individual socket descriptions in zmq_socket(3) + -- for details on the exact action taken for each socket type. + -- The default ZMQ_HWM value of zero means "no limit". + + not overriding + procedure Set_Disk_Offload_Size (This : in out Socket; + Value : Natural); + -- Sets the disk offload (swap) size < for the specified socket. + -- A socket which has ZMQ_SWAP set to a non - zero value may exceed + + -- in this case outstanding messages shall be offloaded to storage on + -- disk rather than held in memory. + -- The value defines the maximum size of the swap space in bytes + + + not overriding + procedure Set_IO_Thread_Affinity (This : in out Socket; + Value : Natural); + -- Sets the I/O thread affinity for newly created connections on the + -- specified socket. + -- Affinity determines which threads from the 0MQ I/O thread pool + + -- created connections. + -- A value of zero specifies no affinity, meaning that work shall be + -- distributed fairly among all 0MQ I/O threads in the thread pool. + -- For non-zero values, + -- the lowest bit corresponds to thread 1, second lowest bit to thread 2 + -- and so on. + -- For example, a value of 3 specifies that subsequent connections on + -- socket shall behandled exclusively by I/O threads 1 and 2. + -- See also zmq_init(3) for details on allocating the number + -- of I/O threads for a specific context. + + not overriding + procedure Set_Socket_Identity + (This : in out Socket; + Value : String); + not overriding + procedure Set_Socket_Identity + (This : in out Socket; + Value : Ada.Streams.Stream_Element_Array); + -- Sets the identity of the specified socket. + -- Socket identity determines if existing 0MQ infastructure + -- (message queues, forwarding devices) shall be identified with a specific + -- application and persist across multiple runs of the application. + -- If the socket has no identity, each run of an application is completely + -- separate from other runs. However, with identity set the socket shall + -- re-use any existing 0MQ infrastructure configured by the + -- previous run(s). + -- Thus the application may receive messages that were sent in the + -- meantime, message queue limits shall be shared with previous run(s) + -- and so on. + -- Identity should be at least one byte and at most 255 bytes long. + -- Identities starting with binary zero are reserved for use + -- by 0MQ infrastructure. + + not overriding + procedure Establish_Message_Filter (This : in out Socket; + Value : String); + not overriding + procedure Establish_Message_Filter + (This : in out Socket; + Value : Ada.Strings.Unbounded.Unbounded_String); + procedure Establish_Message_Filter + (This : in out Socket; + Value : Ada.Streams.Stream_Element_Array); + -- Establishes a new message filter on a SUB socket. + -- Newly created SUB sockets filters out all incoming messages, + -- therefore you should call this option to establish an initial + -- message filter. + -- An empty option_value of length zero shall subscribe to all + -- incoming messages. + -- A non-empty option_value shall subscribe to all messages beginning + -- with the specified prefix. + -- Mutiple filters may be attached to a single SUB socket, + -- in which case a message shall be accepted + -- if it matches at least one filter. + + not overriding + procedure Remove_Message_Filter (This : in out Socket; + Value : String); + not overriding + procedure Remove_Message_Filter + (This : in out Socket; + Value : Ada.Strings.Unbounded.Unbounded_String); + not overriding + procedure Remove_Message_Filter + (This : in out Socket; + Value : Ada.Streams.Stream_Element_Array); + -- Remove an existing message filter on a SUB socket. + -- The filter specified must match an existing filter previously + -- established with "Establish_message_filter". + -- If the socket has several instances of the same filter attached the + -- Remove_message_filter removes only one instance, + -- leaving the rest in place and functional. + + not overriding + procedure Set_Multicast_Data_Rate (This : in out Socket; + Value : Natural); + -- Sets the maximum send or receive data rate for multicast transports + -- such as PGM using the specified socket. + + not overriding + procedure Set_Multicast_Recovery_Interval (This : in out Socket; + Value : Duration); + -- Sets the recovery interval in seconds for multicast transports using + -- the specified socket. + -- The recovery interval determines the maximum time in seconds that a + -- receiver can be absent from a multicast group before unrecoverable + -- data loss will occur. + -- Caution: + -- Excersize care when setting large recovery intervals as the data needed + -- for recovery will be held in memory. + -- For example, a 1 minute recovery interval at a data rate of + -- 1Gbps requires a 7GB in-memory buffer. + + not overriding + procedure Set_Multicast_Loopback (This : in out Socket; + Enable : Boolean); + -- Controls whether data sent via multicast transports using + -- the specified socket can also be received by the sending host + -- via loopback. + -- A value of False disables the loopback functionality, + -- while the default value of True enables the loopback functionality. + -- Leaving multicast loopback enabled when it is not required can have + -- a negative impact on performance. + -- Where possible, disable multicast_loopback + -- in production environments. + + not overriding + procedure Set_Kernel_Transmit_Buffer_Size (This : in out Socket; + Value : Natural); + -- Sets the underlying kernel transmit buffer size for the socket + -- to the specified size in bytes. + -- A value of zero means leave the OS default unchanged. + -- For details please refer to your operating system documentation + -- for the SO_SNDBUF socket option. + + + not overriding + procedure Set_Kernel_Receive_Buffer_Size (This : in out Socket; + Value : Natural); + -- Sets the underlying kernel receive buffer size for the socket to + -- the specified size in bytes. + -- A value of zero means leave the OS default unchanged. + -- For details refer to your operating system documentation for the + -- SO_RCVBUF socket option. + + + function More_Message_Parts_To_Follow (This : Socket) return Boolean; + -- Returns True if the multi-part message currently being read from the + -- specified socket has more message parts to follow. + -- If there are no message parts to follow or if the message currently + -- being read is not a multi-part message a value of True will be returned. + -- Otherwise, False will be returned. + + function Get_High_Water_Mark (This : Socket) return Natural; + -- Returns the high water mark for the specified socket. + -- The high water mark is a hard limit on the maximum number of outstanding + -- messages ZMQ shall queue in memory for any single peer that + -- the specified socket is communicating with. + -- If this limit has been reached the socket shall enter an exceptional + -- state and depending on the socket type, ZMQ shall take appropriate + -- action such as blocking or dropping sent messages. + -- The default high_water_mark value of zero means "no limit". + + function Get_Disk_Offload_Size (This : Socket) return Natural; + -- Returns the disk offload (swap) size for the specified socket. + -- A socket which has SWAP set to a non-zero value may exceed + + -- in this case outstanding messages shall be offloaded to storage on disk + -- rather than held in memory. + -- The value of defines the maximum size of the swap space in bytes. + + type Thread_Bitmap is array (0 .. 63) of Boolean; + pragma Pack (Thread_Bitmap); + function Get_IO_Thread_Affinity (This : Socket) return Thread_Bitmap; + -- Returns the I/O thread affinity for newly created connections + -- on the specified socket. + -- Affinity determines which threads from the ZMQ I/O thread pool + + -- created connections. + -- A value of zero specifies no affinity, meaning that work shall be + -- distributed fairly among all ZMQ I/O threads in the thread pool. + -- For non-zero values, the lowest bit corresponds to thread 1, + -- second lowest bit to thread 2 and so on. For example, + -- a value of 3 specifies that subsequent connections on socket shall be + -- handled exclusively by I/O threads 1 and 2. + + function Get_Socket_Identity + (This : Socket) return Ada.Streams.Stream_Element_Array; + -- Returns the identity of the specified socket. + -- Socket identity determines if existing ZMQ infastructure + -- (message queues, forwarding devices) shall be identified with a specific + -- application and persist across multiple runs of the application. + -- If the socket has no identity, each run of an application is completely + -- separate from other runs. However, with identity set the socket shall + -- re-use any existing ZMQ infrastructure configured by the + -- previous run(s). + -- Thus the application may receive messages that were sent + -- in the meantime, + -- message queue limits shall be shared with previous run(s) and so on. + -- Identity can be at least one byte and at most 255 bytes long. + -- Identities starting with binary zero are reserved for use by the + -- ZMQ infrastructure. + + function Get_Multicast_Data_Rate (This : Socket) return Natural; + -- Returns the maximum send or receive data rate for multicast transports + -- using the specified socket. + + function Get_Multicast_Recovery_Interval (This : Socket) return Duration; + -- Retrieves the recovery interval for multicast transports using the + -- specified socket. + -- The recovery interval determines the maximum time in seconds that + -- a receiver can be absent from a multicast group before unrecoverable + -- data loss will occur. + + function Get_Multicast_Loopback (This : Socket) return Boolean; + -- Returns True if multicast transports shall be recievd bye the + -- loopback interface. + function Get_Kernel_Transmit_Buffer_Size (This : Socket) return Natural; + -- Returns the underlying kernel transmit buffer size for the + -- specified socket. + -- A value of zero means that the OS default is in effect. + -- For details refer to your operating system documentation for + -- the SO_SNDBUF socket option. + + function Get_Kernel_Receive_Buffer_Size (This : Socket) return Natural; + -- Returns the underlying kernel receive buffer size for the + -- specified socket. + -- A value of zero means that the OS default is in effect. + -- For details refer to your operating system documentation + -- for the SO_RCVBUF socket option + + not overriding + procedure Connect (This : in out Socket; + Address : String); + + procedure Connect (This : in out Socket; + Address : Ada.Strings.Unbounded.Unbounded_String); + + + + not overriding + procedure Send (This : in out Socket; + Msg : Messages.Message'Class; + Flags : Socket_Flags := No_Flags); + + not overriding + procedure Send (This : in out Socket; + Msg : String; + Flags : Socket_Flags := No_Flags); + + not overriding + procedure Send (This : in out Socket; + Msg : Ada.Strings.Unbounded.Unbounded_String; + Flags : Socket_Flags := No_Flags); + + not overriding + procedure Send (This : in out Socket; + Msg : Ada.Streams.Stream_Element_Array; + Flags : Socket_Flags := No_Flags); + + not overriding + procedure Send (This : in out Socket; + Msg_Addres : System.Address; + Msg_Length : Natural; + Flags : Socket_Flags := No_Flags); + -- Queues the message referenced by the msg argument to be sent to socket + -- The flags argument is a combination of the flags defined below: + -- NOBLOCK + -- Specifies that the operation should be performed in non-blocking mode. + -- If the message cannot be queued on the socket, + -- the send function shall fail with errno set to EAGAIN. + -- SNDMORE + -- Specifies that the message being sent is a multi-part message, + -- and that further message parts are to follow. + -- Refer to the section regarding multi-part messages + -- below for a detailed description. + -- Note! + -- A successful invocation of send does not indicate that the message + -- has been transmitted to the network, + -- only that it has been queued on the socket and 0MQ has assumed + -- responsibility for the message. + -- Multi-part messages + -- A 0MQ message is composed of 1 or more message parts; + -- each message part is an independent zmq_msg_t in its own right. + -- 0MQ ensures atomic delivery of messages; + -- peers shall receive either all message parts of + -- a message or none at all. + -- The total number of message parts is unlimited. + -- + -- An application wishing to send a multi-part message does so by + -- specifying the SNDMORE flag to send. + -- The presence of this flag indicates to 0MQ that the message being sent + -- is a multi-part message and that more message parts are to follow. + -- When the application wishes to send the final message part it does so + -- by calling zmq without the SNDMORE flag; + -- this indicates that no more message parts are to follow. + -- Creates a Message and sends it over the socket. + + generic + type Element is private; + procedure Send_Generic (This : in out Socket; + Msg : Element; + Flags : Socket_Flags := No_Flags); + + + + -- not overriding + -- procedure flush (This : in out Socket); + + not overriding + procedure Recv (This : in Socket; + Msg : Messages.Message'Class; + Flags : Socket_Flags := No_Flags); + + procedure Recv (This : in Socket; + Msg : out Ada.Strings.Unbounded.Unbounded_String; + Flags : Socket_Flags := No_Flags); + + + not overriding + function Recv (This : in Socket; + Flags : Socket_Flags := No_Flags) return String; + + not overriding + function Recv (This : in Socket; + Flags : Socket_Flags := No_Flags) + return Ada.Strings.Unbounded.Unbounded_String; + + procedure Recv (This : in Socket; + Flags : Socket_Flags := No_Flags); + + + overriding + procedure Finalize (This : in out Socket); + procedure Close (This : in out Socket) renames Finalize; + -- + + + -- function "=" (Left, Right : in Context) return Boolean; + function Get_Impl (This : in Socket) return System.Address; +private + type Socket is new Ada.Finalization.Limited_Controlled with record + C : System.Address := System.Null_Address; + end record; + function Img (Item : Ada.Streams.Stream_Element_Array) return String; + + type Socket_Opt is + (HWM, + SWAP, + AFFINITY, + IDENTITY, + SUBSCRIBE, + UNSUBSCRIBE, + RATE, + RECOVERY_IVL, + MCAST_LOOP, + SNDBUF, + RCVBUF, + RCVMORE, + FD, + EVENTS, + GET_TYPE, + LINGER, + RECONNECT_IVL, + BACKLOG); + + not overriding + + procedure Setsockopt (This : in out Socket; + Option : Socket_Opt; + Value : String); + not overriding + procedure Setsockopt (This : in out Socket; + Option : Socket_Opt; + Value : Boolean); + not overriding + procedure Setsockopt (This : in out Socket; + Option : Socket_Opt; + Value : Natural); + not overriding + procedure Setsockopt + (This : in out Socket; + Option : Socket_Opt; + Value : Ada.Streams.Stream_Element_Array); + + not overriding + procedure Setsockopt (This : in out Socket; + Option : Socket_Opt; + Value : System.Address; + Value_Size : Natural); + + -------------------------------------------------------- + -------------------------------------------------------- + + function Getsockopt (This : in Socket; + Option : Socket_Opt) return String; + not overriding + function Getsockopt (This : in Socket; + Option : Socket_Opt) return Boolean; + not overriding + function Getsockopt (This : in Socket; + Option : Socket_Opt) return Natural; + not overriding + function Getsockopt + (This : in Socket; + Option : Socket_Opt) return Interfaces.C.Unsigned_Long; + + not overriding + function Getsockopt + (This : in Socket; + Option : Socket_Opt) return Ada.Streams.Stream_Element_Array; + + not overriding + procedure Getsockopt (This : in Socket; + Option : Socket_Opt; + Value : System.Address; + Value_Size : out Natural); + + MAX_OPTION_SIZE : constant := 256; + +end ZMQ.Sockets; diff --git a/src/zmq.adb b/src/zmq.adb index 76a0f56..6da8d02 100644 --- a/src/zmq.adb +++ b/src/zmq.adb @@ -39,11 +39,11 @@ package body ZMQ is -- Error_Message -- ------------------- - function Error_Message (no : Integer) return String is - s : constant String := no'Img; + function Error_Message (No : Integer) return String is + s : constant String := No'Img; begin return "[" & s (s'First + 1 .. s'Last) & "] " & - Interfaces.C.Strings.Value (Low_Level.zmq_strerror (int (no))); + Interfaces.C.Strings.Value (Low_Level.zmq_strerror (int (No))); end Error_Message; function Library_Version return Version_Type is @@ -59,21 +59,22 @@ package body ZMQ is end return; end Library_Version; - function image (item : Version_Type) return String is - s1 : constant String := item.Major'Img; - s2 : constant String := item.Minor'Img; - s3 : constant String := item.Patch'Img; + function Image (Item : Version_Type) return String is + s1 : constant String := Item.Major'Img; + s2 : constant String := Item.Minor'Img; + s3 : constant String := Item.Patch'Img; begin return s1 (s1'First + 1 .. s1'Last) & "." & s2 (s2'First + 1 .. s2'Last) & "." & s3 (s3'First + 1 .. s3'Last); - end image; + end Image; + procedure Validate_Library_Version is Lib_Version : constant Version_Type := Library_Version; begin Ada.Assertions.Assert ((Binding_Version.Major = Lib_Version.Major) and (Binding_Version.Minor = Lib_Version.Minor), - "Incopatible Library" & image (Lib_Version)); + "Incopatible Library " & Image (Lib_Version)); end Validate_Library_Version; end ZMQ; diff --git a/src/zmq.ads b/src/zmq.ads index c94370a..0b78493 100644 --- a/src/zmq.ads +++ b/src/zmq.ads @@ -34,18 +34,18 @@ package ZMQ is pragma Preelaborate; ZMQ_Error : exception; type Version_Type is record - Major : Natural; - Minor : Natural; - Patch : Natural; + Major : aliased Natural; + Minor : aliased Natural; + Patch : aliased Natural; end record; - Binding_Version : constant Version_Type := (2, 1, 0); + Binding_Version : constant Version_Type := (3, 3, 0); function Library_Version return Version_Type; - function image (item : Version_Type) return String; + function Image (Item : Version_Type) return String; private - function Error_Message (no : Integer) return String; + function Error_Message (No : Integer) return String; procedure Validate_Library_Version; -- Raiese ZMQ_Error if the underlaying library isent a valid version diff --git a/tests/testcases/zmq-tests-testcases-test_pubsub.adb b/tests/testcases/zmq-tests-testcases-test_pubsub.adb old mode 100644 new mode 100755 index cbea581..faf82af --- a/tests/testcases/zmq-tests-testcases-test_pubsub.adb +++ b/tests/testcases/zmq-tests-testcases-test_pubsub.adb @@ -1,5 +1,6 @@ with GNAT.Source_Info; with Ada.Strings.Unbounded; +with AUnit.Assertions; use AUnit.Assertions; package body ZMQ.Tests.Testcases.Test_Pubsub is use AUnit; use Ada.Strings.Unbounded; @@ -23,29 +24,29 @@ package body ZMQ.Tests.Testcases.Test_Pubsub is ------------------------- -- initialize ------------------------- - procedure initialize (Test : in out AUnit.Test_Cases.Test_Case'Class) is + procedure Initialize (Test : in out AUnit.Test_Cases.Test_Case'Class) is T : Test_Case renames Test_Case (Test); begin - T.Ctx.Initialize (1); - T.pub.Initialize (T.Ctx, Sockets.PUB); + T.Ctx.Initialize; + T.Pub.Initialize (T.Ctx, Sockets.PUB); T.Sub.Initialize (T.Ctx, Sockets.SUB); - T.Sub.Establish_message_filter (""); + T.Sub.Establish_Message_Filter (""); T.Sub.Bind ("inproc://pub-sub"); - T.pub.Connect ("inproc://pub-sub"); - end initialize; + T.Pub.Connect ("inproc://pub-sub"); + end Initialize; ------------------------- -- Publish ------------------------- procedure Send (Test : in out AUnit.Test_Cases.Test_Case'Class) is T : Test_Case renames Test_Case (Test); - msg : Ada.Strings.Unbounded.Unbounded_String; + Msg : Ada.Strings.Unbounded.Unbounded_String; begin - T.pub.Send (MSG_STRING); - T.Sub.recv (msg); - T.Assert (msg = MSG_STRING, "Error"); + T.Pub.Send (MSG_STRING); + T.Sub.Recv (Msg); + Assert (Msg = MSG_STRING, "Error"); end Send; ------------------------- @@ -54,7 +55,7 @@ package body ZMQ.Tests.Testcases.Test_Pubsub is procedure Finalize (Test : in out AUnit.Test_Cases.Test_Case'Class) is T : Test_Case renames Test_Case (Test); begin - T.pub.Finalize; + T.Pub.Finalize; T.Sub.Finalize; T.Ctx.Finalize; end Finalize; @@ -66,7 +67,7 @@ package body ZMQ.Tests.Testcases.Test_Pubsub is use Test_Cases.Registration; begin - Register_Routine (T, initialize'Access, "initialize"); + Register_Routine (T, Initialize'Access, "initialize"); Register_Routine (T, Send'Access, "Send"); Register_Routine (T, Finalize'Access, "Finalize"); end Register_Tests; diff --git a/tests/testcases/zmq-tests-testcases-test_pubsub.ads b/tests/testcases/zmq-tests-testcases-test_pubsub.ads index 0c04726..5f9e59c 100644 --- a/tests/testcases/zmq-tests-testcases-test_pubsub.ads +++ b/tests/testcases/zmq-tests-testcases-test_pubsub.ads @@ -7,7 +7,7 @@ package ZMQ.Tests.Testcases.Test_Pubsub is type Test_Case is new AUnit.Test_Cases.Test_Case with record Ctx : ZMQ.Contexts.Context; - pub : ZMQ.Sockets.Socket; + Pub : ZMQ.Sockets.Socket; Sub : ZMQ.Sockets.Socket; end record; diff --git a/tests/testcases/zmq-tests-testcases-test_reqresp.adb b/tests/testcases/zmq-tests-testcases-test_reqresp.adb new file mode 100644 index 0000000..8f817d6 --- /dev/null +++ b/tests/testcases/zmq-tests-testcases-test_reqresp.adb @@ -0,0 +1,78 @@ +with GNAT.Source_Info; +with Ada.Strings.Unbounded; +with AUnit.Assertions; use AUnit.Assertions; +package body ZMQ.Tests.Testcases.Test_REQRESP is + use AUnit; + use Ada.Strings.Unbounded; + + MSG_STRING : constant Unbounded_String := To_Unbounded_String ("Query"); + + + ---------- + -- Name -- + ---------- + + function Name (T : Test_Case) + return AUnit.Message_String is + pragma Unreferenced (T); + begin + return Format (GNAT.Source_Info.File); + end Name; + + + + ------------------------- + -- initialize + ------------------------- + procedure Initialize (Test : in out AUnit.Test_Cases.Test_Case'Class) is + T : Test_Case renames Test_Case (Test); + begin + T.Ctx.Initialize; + + T.Sub.Initialize (T.Ctx, Sockets.REP); + T.Sub.Bind ("inproc://req"); + + T.Pub.Initialize (T.Ctx, Sockets.REQ); + T.Pub.Connect ("inproc://req"); + + + end Initialize; + + ------------------------- + -- Publish + ------------------------- + procedure Send (Test : in out AUnit.Test_Cases.Test_Case'Class) is + T : Test_Case renames Test_Case (Test); + Msg : Ada.Strings.Unbounded.Unbounded_String; + begin + T.Pub.Send (MSG_STRING); + T.Sub.Recv (Msg); + T.Sub.Send (Msg); + T.Pub.Recv (Msg); + Assert (Msg = MSG_STRING, "Error"); + end Send; + + ------------------------- + -- Subscribe + ------------------------- + procedure Finalize (Test : in out AUnit.Test_Cases.Test_Case'Class) is + T : Test_Case renames Test_Case (Test); + begin + T.Pub.Finalize; + T.Sub.Finalize; + T.Ctx.Finalize; + end Finalize; + -------------------- + -- Register_Tests -- + -------------------- + + procedure Register_Tests (T : in out Test_Case) is + use Test_Cases.Registration; + + begin + Register_Routine (T, Initialize'Access, "initialize"); + Register_Routine (T, Send'Access, "Send"); + Register_Routine (T, Finalize'Access, "Finalize"); + end Register_Tests; + +end ZMQ.Tests.TestCases.Test_REQRESP; diff --git a/tests/testcases/zmq-tests-testcases-test_reqresp.ads b/tests/testcases/zmq-tests-testcases-test_reqresp.ads new file mode 100644 index 0000000..1c13932 --- /dev/null +++ b/tests/testcases/zmq-tests-testcases-test_reqresp.ads @@ -0,0 +1,21 @@ +with AUnit; +with AUnit.Test_Cases; +with ZMQ.Contexts; +with ZMQ.Sockets; +package ZMQ.Tests.Testcases.Test_REQRESP is + type Test_Case; + + type Test_Case is new AUnit.Test_Cases.Test_Case with record + Ctx : ZMQ.Contexts.Context; + Pub : ZMQ.Sockets.Socket; + Sub : ZMQ.Sockets.Socket; + end record; + + procedure Register_Tests (T : in out Test_Case); + -- Register routines to be run + + function Name (T : Test_Case) + return AUnit.Message_String; + -- Returns name identifying the test case + +end ZMQ.Tests.TestCases.Test_REQRESP; diff --git a/tests/zmq-tests-testsuits-test_all.adb b/tests/zmq-tests-testsuits-test_all.adb index 927cde4..916bc3b 100644 --- a/tests/zmq-tests-testsuits-test_all.adb +++ b/tests/zmq-tests-testsuits-test_all.adb @@ -27,6 +27,7 @@ -- Import tests and sub-suites to run with ZMQ.Tests.TestCases.Test_Compile; with ZMQ.Tests.TestCases.Test_Pubsub; +with ZMQ.Tests.TestCases.Test_REQRESP; package body ZMQ.Tests.Testsuits.Test_All is use AUnit.Test_Suites; @@ -38,6 +39,7 @@ package body ZMQ.Tests.Testsuits.Test_All is -- Statically allocate test cases: Test_1 : aliased TestCases.Test_Compile.Test_Case; Test_2 : aliased TestCases.Test_Pubsub.Test_Case; + Test_3 : aliased TestCases.Test_REQRESP.Test_Case; ----------- -- Suite -- ----------- @@ -46,6 +48,7 @@ package body ZMQ.Tests.Testsuits.Test_All is begin Add_Test (Result'Access, Test_1'Access); Add_Test (Result'Access, Test_2'Access); + Add_Test (Result'Access, Test_3'Access); return Result'Access; end Suite; diff --git a/zmq.gpr b/zmq.gpr old mode 100644 new mode 100755 index 160ba09..051e1a4 --- a/zmq.gpr +++ b/zmq.gpr @@ -29,13 +29,13 @@ -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ - +with "libzmq.gpr"; project ZMQ is For Languages use ("Ada"); type ZMQ_Kind_Type is ("static", "relocatable"); ZMQ_Kind : ZMQ_Kind_Type := external ("LIBRARY_TYPE", "static"); - Version := "2.1.0"; + Version := "3.2.0"; for Library_Name use "zmqAda"; for Library_Version use "lib" & project'Library_Name & ".so." &Version; @@ -67,7 +67,6 @@ project ZMQ is for Switches("zmq-low_level.ads") use Compiler'Default_Switches ("ada") & ("-gnaty-M"); - -- Since this file is "autogenerated". end Compiler; diff --git a/zmq.gpr.inst b/zmq.gpr.inst index 2988f27..a1e7aec 100644 --- a/zmq.gpr.inst +++ b/zmq.gpr.inst @@ -14,6 +14,7 @@ project Zmq is when "relocatable" => for Library_Kind use "dynamic"; end case; - + package Linker is + end Linker; end Zmq;