guile-netlink

connection: Use Guile's 'socket' procedure to open a socket.

Ludovic Court??sTue May 23 20:42:51+0200 2023

21b4b5b

connection: Use Guile's 'socket' procedure to open a socket. 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'. Signed-off-by: Julien Lepiller <julien@lepiller.eu>

doc/guile-netlink.texi

 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

ip/addr.scm

   (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))
   (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)
                           (get-attr attrs IFA_BROADCAST)
                           (get-attr attrs IFA_CACHEINFO))))
                     addrs)))
       (close-socket sock)
       (close-port sock)
       addrs)))
 (define print-addr

ip/link.scm

                    (get-attr attrs IFLA_ADDRESS)
                    (get-attr attrs IFLA_BROADCAST))))
                links)))
       (close-socket sock)
       (close-port sock)
       links)))
 (define print-link
     (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)
   (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)
   (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)))))

ip/route.scm

   (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
   (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)
                            (get-attr attrs RTA_PRIORITY)
                            (link-ref links (get-attr attrs RTA_OIF)))))
                      routes)))
       (close-socket sock)
       (close-port sock)
       routes)))
 (define print-route

netlink/connection.scm

   #: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
             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)
                                      (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))
 (define* (connect proto addr)
   (let ((sock (open-socket proto)))
     (ffi-bind (socket-num sock)
     (ffi-bind (fileno sock)
               (bytevector->pointer addr)
 )
     sock))
   (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))
                              iovec 1
                              %null-pointer 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)))))