bug#63516: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket' procedure to open a socket.

[Ludovic Courtès]

This gives us a real port, which can then let us benefit from the
suspendable port facilities.

* netlink/connection.scm (ffi-socket, ffi-close): Remove.
(socket): Remove record type.
(open-socket): Use Guile's 'socket' procedure.
(close-socket): Make a deprecated alias for 'close-port'.
(get-addr): Add docstring.
(connect, send-msg, receive-msg): Use 'fileno' instead of 'socket-num'.
* ip/addr.scm (addr-del, addr-add, get-addrs): Use 'close-port' instead
of 'close-socket'.
* ip/link.scm (get-links, link-set, link-add, link-del): Likewise.
* ip/route.scm (route-del, route-add, get-routes): Likewise.
* doc/guile-netlink.texi (Netlink Connections): Remove 'close-socket'.
---
 doc/guile-netlink.texi |  4 ----
 ip/addr.scm            |  6 +++---
 ip/link.scm            |  8 ++++----
 ip/route.scm           |  6 +++---
 netlink/connection.scm | 35 +++++++++++++----------------------
 5 files changed, 23 insertions(+), 36 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 548e47b..48ca6d7 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -256,10 +256,6 @@ 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.
 @end deffn
 
-@deffn {Scheme Procedure} close-socket @var{socket}
-Closes a netlink socket.  The socket cannot be used afterwards.
-@end deffn
-
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
 Send @var{msg} (it must be of type message, @xref{Netlink Headers}) to
 @var{addr} using @var{sock}.  If not passed, @var{addr} is the address of
diff --git a/ip/addr.scm b/ip/addr.scm
index 0976ab9..fcb286f 100644
--- a/ip/addr.scm
+++ b/ip/addr.scm
@@ -100,7 +100,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (addr-add device cidr #:key (ipv6? #f) (peer (cidr->addr cidr))
@@ -180,7 +180,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define (get-addrs)
@@ -216,7 +216,7 @@
                           (get-attr attrs IFA_BROADCAST)
                           (get-attr attrs IFA_CACHEINFO))))
                     addrs)))
-      (close-socket sock)
+      (close-port sock)
       addrs)))
 
 (define print-addr
diff --git a/ip/link.scm b/ip/link.scm
index 0957a5e..814a008 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -94,7 +94,7 @@
                    (get-attr attrs IFLA_ADDRESS)
                    (get-attr attrs IFLA_BROADCAST))))
                links)))
-      (close-socket sock)
+      (close-port sock)
       links)))
 
 (define print-link
@@ -246,7 +246,7 @@ criteria."
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
       (when netnsfd
         (close netnsfd))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (bond-type-args #:key (mode #f) (miimon #f) (lacp-active #f) 
(lacp-rate #f)
@@ -364,7 +364,7 @@ 
balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (link-del device)
@@ -390,5 +390,5 @@ 
balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
diff --git a/ip/route.scm b/ip/route.scm
index bf43c18..d5e1275 100644
--- a/ip/route.scm
+++ b/ip/route.scm
@@ -106,7 +106,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define* (route-add dest
@@ -170,7 +170,7 @@
   (let ((sock (connect-route)))
     (send-msg message sock)
     (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-      (close-socket sock)
+      (close-port sock)
       (answer-ok? (last answer)))))
 
 (define (link-ref links id)
@@ -221,7 +221,7 @@
                            (get-attr attrs RTA_PRIORITY)
                            (link-ref links (get-attr attrs RTA_OIF)))))
                      routes)))
-      (close-socket sock)
+      (close-port sock)
       routes)))
 
 (define print-route
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 11f004f..6f41ef8 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -22,7 +22,6 @@
   #:use-module (netlink message)
   #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
-  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:export (connect
@@ -34,12 +33,7 @@
             get-addr))
 
 (define libc (dynamic-link))
-(define ffi-socket (pointer->procedure int
-                                       (dynamic-func "socket" libc)
-                                       (list int int int)))
-(define ffi-close (pointer->procedure void
-                                      (dynamic-func "close" libc)
-                                      (list int)))
+
 (define ffi-sendto (pointer->procedure int
                                        (dynamic-func "sendto" libc)
                                        (list int '* size_t int '* int)
@@ -51,22 +45,19 @@
                                      (dynamic-func "bind" libc)
                                      (list int '* int)))
 
-;; define socket type
-(define-record-type socket
-    (make-socket num open?)
-    socket?
-    (num socket-num)
-    (open? socket-open?))
-
 ;; define simple functions to open/close sockets
 (define (open-socket proto)
-    (make-socket (ffi-socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto) 
#t))
-(define (close-socket socket)
-    (if (socket-open? socket)
-        (ffi-close (socket-num socket)))
-    (make-socket (socket-num socket) #f))
+  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto))
+
+(define (close-socket sock)
+  (issue-deprecation-warning
+   "'close-socket' is deprecated; use 'close-port' instead.")
+  (close-port sock))
 
 (define (get-addr family pid groups)
+  "This is a variant of 'make-socket-address' for AF_NETLINK sockets.  The
+main difference is that it returns a raw bytevector that libguile procedures
+such as 'bind' cannot handle."
   (let ((addr (make-bytevector 12)))
     (bytevector-u16-set! addr 0 family (native-endianness))
     (bytevector-u32-set! addr 4 pid (native-endianness))
@@ -85,7 +76,7 @@
 
 (define* (connect proto addr)
   (let ((sock (open-socket proto)))
-    (ffi-bind (socket-num sock)
+    (ffi-bind (fileno sock)
               (bytevector->pointer addr)
               12)
     sock))
@@ -101,7 +92,7 @@
   (let* ((len (data-size msg))
          (bv (make-bytevector len)))
     (serialize msg 0 bv)
-    (ffi-sendto (socket-num sock) (bytevector->pointer bv) len 0 %null-pointer 
0)))
+    (ffi-sendto (fileno sock) (bytevector->pointer bv) len 0 %null-pointer 0)))
 
 (define* (receive-msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (let* ((len (* 1024 32))
@@ -111,7 +102,7 @@
                              iovec 1
                              %null-pointer 0
                              0))
-         (size (ffi-recvmsg (socket-num sock) msghdr 0))
+         (size (ffi-recvmsg (fileno sock) msghdr 0))
          (answer (make-bytevector size)))
     (when (> size (* 1024 32))
       (raise (condition (&netlink-answer-too-big-error (size size)))))
-- 
2.40.1