From 5d98a14ae32950b120ad52dc96ff6384a401bbbd Mon Sep 17 00:00:00 2001
From: Stelian Ionescu <sionescu@common-lisp.net>
Date: Sat, 29 Nov 2008 16:34:51 +0100
Subject: [PATCH] Add and export class IPV4-NETWORK.

---
 net.sockets/address-arithmetic.lisp | 29 +++++++++++++++++++++++++++++
 net.sockets/pkgdcl.lisp             |  1 +
 2 files changed, 30 insertions(+)

diff --git a/net.sockets/address-arithmetic.lisp b/net.sockets/address-arithmetic.lisp
index 81672d1..d4b1823 100644
--- a/net.sockets/address-arithmetic.lisp
+++ b/net.sockets/address-arithmetic.lisp
@@ -105,3 +105,32 @@ See http://en.wikipedia.org/wiki/Private_network for details.")
               (inet-address-network-class address))))
   (:method ((address address))
     nil))
+
+
+(defclass ipv4-network ()
+  ((address :initarg :address :accessor address-of)
+   (netmask :initarg :netmask :accessor netmask-of)
+   (cidr :accessor cidr-of))
+  (:documentation "IPv4 network: an address plus a netmask."))
+
+(defun compute-cidr-prefix-from-netmask (netmask)
+  (let ((ub32-address (vector-to-integer (address-name netmask))))
+    (loop :with count := 0
+       :for i :below 32
+       :do (if (logbitp i ub32-address)
+               (loop-finish)
+               (incf count))
+       :finally (return count))))
+
+(defmethod initialize-instance :after ((network ipv4-network)
+                                       &key address netmask)
+  (check-type address ipv4-address "an Ipv4 address")
+  (check-type netmask ipv4-address "an Ipv4 netmask")
+  (setf (cidr-of network) (compute-cidr-prefix-from-netmask netmask))
+  (setf (address-of network)
+        (inet-address-network-portion address netmask)))
+
+(defmethod print-object ((network ipv4-network) stream)
+  (format stream "@~A/~A"
+          (address-to-string (address-of network))
+          (cidr-of network)))
diff --git a/net.sockets/pkgdcl.lisp b/net.sockets/pkgdcl.lisp
index 049dc29..ce1dd11 100644
--- a/net.sockets/pkgdcl.lisp
+++ b/net.sockets/pkgdcl.lisp
@@ -118,6 +118,7 @@
    ;; Network masks and subnets
    #:make-netmask
    #:ensure-netmask
+   #:ipv4-network
    #:inet-address-private-p
    #:inet-address-network-portion
    #:inet-address-host-portion
-- 
2.11.4.GIT