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(-)
Toggle diff (202 lines)
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
