bug#63516: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra SOCK_ flags to 'socket'.

[Ludovic Courtès]

In particular, this lets users pass SOCK_NONBLOCK.

* netlink/connection.scm (open-socket): Add 'flags' parameter and honor it.
(connect): Add #:flags and pass it to 'open-socket'.
(connect-route): Add #:flags and pass it to 'connect'.
* doc/guile-netlink.texi (Netlink Connections): Adjust accordingly.
---
 doc/guile-netlink.texi | 11 +++++++++--
 netlink/connection.scm | 13 +++++++------
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 48ca6d7..bdb20c6 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -240,7 +240,8 @@ to communicate or 0 for the kernel. @var{groups} is an 
integer representing
 the set of broadcast groups to which the connection subscribes.
 @end deffn
 
-@deffn {Scheme Procedure} connect @var{proto} @var{addr}
+@cindex non-blocking socket
+@deffn {Scheme Procedure} connect @var{proto} @var{addr} [#:flags 0]
 Creates a netlink socket for @var{proto} and binds it to @var{addr}.
 
 @var{proto} is the integer representing the protocol.  For instance, rtnetlink
@@ -248,12 +249,18 @@ can be selected by usin @code{NETLINK_ROUTE} (defined in
 @code{(netlink constant)}).
 
 @var{addr} is a bytevector, as returned by @code{get-addr}.
+
+@var{flags} is a set of additional flags to pass as the second argument
+to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
-@deffn {Scheme Procedure} connect-route [#:groups @code{0}]
+@deffn {Scheme Procedure} connect-route [#:groups 0] [#:flags 0]
 This procedure is a wrapper for @code{connect} that creates a socket for the
 rtnetlink protocol, binds it to the kernel and returns it.  By passing the
 optional @var{groups} keyword, you can select broadcast groups to subscribe to.
+
+@var{flags} is a set of additional flags to pass as the second argument
+to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 42f7dbb..4ad9b10 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -74,8 +74,8 @@ first argument is a port, call it upon EAGAIN or EWOULDBLOCK."
                       #:waiter (lambda () (current-read-waiter))))
 
 ;; define simple functions to open/close sockets
-(define (open-socket proto)
-  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto))
+(define (open-socket proto flags)
+  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC flags) proto))
 
 (define (close-socket sock)
   (issue-deprecation-warning
@@ -102,15 +102,16 @@ such as 'bind' cannot handle."
     (list '* size_t)
     (list content size)))
 
-(define* (connect proto addr)
-  (let ((sock (open-socket proto)))
+(define* (connect proto addr #:key (flags 0))
+  (let ((sock (open-socket proto flags)))
     (ffi-bind sock
               (bytevector->pointer addr)
               12)
     sock))
 
-(define* (connect-route #:key (groups 0))
-  (connect NETLINK_ROUTE (get-addr AF_NETLINK 0 groups)))
+(define* (connect-route #:key (groups 0) (flags 0))
+  (connect NETLINK_ROUTE (get-addr AF_NETLINK 0 groups)
+           #:flags flags))
 
 (define* (send-msg msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (unless (message? msg)
-- 
2.40.1