From 9967a8aaa33abb10f0bf5f134604b3751ab43fe3 Mon Sep 17 00:00:00 2001
From: Stelian Ionescu <sionescu@cddr.org>
Date: Sun, 5 May 2013 03:26:00 +0200
Subject: [PATCH] Add class SOCKET-RAW-NETLINK

---
 src/sockets/base-sockets.lisp   |  9 +++++++++
 src/sockets/socket-methods.lisp | 22 +++++++++++++++++++++-
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/src/sockets/base-sockets.lisp b/src/sockets/base-sockets.lisp
index b0f79ed..41ecf85 100644
--- a/src/sockets/base-sockets.lisp
+++ b/src/sockets/base-sockets.lisp
@@ -152,6 +152,10 @@ Works only on DATAGRAM sockets."))
   (:default-initargs :address-family :local)
   (:documentation "Mixin for sockets of domain AF_LOCAL."))
 
+(defclass netlink-socket (socket) ()
+  (:default-initargs :address-family :netlink)
+  (:documentation "Mixin for sockets of domain AF_NETLINK."))
+
 (defgeneric send-file-descriptor (socket file-descriptor)
   (:documentation "Send FILE-DESCRIPTOR through SOCKET.
 The receiving process must use RECEIVE-FILE-DESCRIPTOR to receive the
@@ -283,3 +287,8 @@ address and the remote port if applicable."))
     (internet-socket raw-socket) ()
   (:default-initargs :type :raw)
   (:documentation "Class representing active sockets of type SOCK_RAW and domain AF_LOCAL."))
+
+(defclass socket-raw-netlink
+    (netlink-socket raw-socket) ()
+  (:default-initargs :type :raw)
+  (:documentation "Class representing active sockets of type SOCK_RAW and domain AF_NETLINK."))
diff --git a/src/sockets/socket-methods.lisp b/src/sockets/socket-methods.lisp
index 745abd7..a342190 100644
--- a/src/sockets/socket-methods.lisp
+++ b/src/sockets/socket-methods.lisp
@@ -13,7 +13,8 @@
   (let ((sf (ecase address-family
               (:ipv4  af-inet)
               (:ipv6  af-inet6)
-              (:local af-local)))
+              (:local af-local)
+              (:netlink af-netlink)))
         (st (ecase type
               (:stream   sock-stream)
               (:datagram sock-dgram)
@@ -140,6 +141,16 @@
               (format stream " waiting @ ~A/~A"
                       (address-to-string host) port))
             (format stream ", closed" )))))
+
+(defmethod print-object ((socket socket-raw-netlink) stream)
+  (print-unreadable-object (socket stream :identity t)
+    (format stream "netlink socket")
+    (if (socket-bound-p socket)
+        (multiple-value-bind (address port)
+            (local-name socket)
+          (format stream " bound to ~A@~A"
+                  port (address-to-string address)))
+        (format stream ", ~:[closed~;unbound~]" (fd-of socket)))))
 
 
 ;;;-------------------------------------------------------------------------
@@ -189,6 +200,9 @@
 (defmethod local-port ((socket internet-socket))
   (nth-value 1 (%local-name socket)))
 
+(defmethod local-port ((socket netlink-socket))
+  (nth-value 1 (%local-name socket)))
+
 (defmethod local-filename ((socket local-socket))
   (%local-name socket))
 
@@ -255,6 +269,12 @@
     (%bind (fd-of socket) sun (actual-size-of-sockaddr-un sun)))
   (values socket))
 
+(defmethod bind-address ((socket netlink-socket) (address netlink-address)
+                         &key (port 0))
+  (with-sockaddr-nl (snl (netlink-address-multicast-groups address) port)
+    (%bind (fd-of socket) snl (isys:sizeof 'sockaddr-nl)))
+  (values socket))
+
 (defmethod bind-address :after ((socket socket) (address address) &key)
   (setf (slot-value socket 'bound) t))
 
-- 
2.11.4.GIT