net.sockets/address-arithmetic.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Arithmetic with addresses and network masks.
   4 ;;;
   5
   6 (in-package :net.sockets)
   7
   8 (defun make-netmask (&key cidr class)
   9   "Create a subnet mask by specifying either its class(:A, :B or :C) or
  10 a CIDR suffix(a number between 0 and 32)."
  11   (assert (or cidr class) (cidr class) "You must either specify a CIDR or a network class.")
  12   (cond
  13     (cidr (check-type cidr (mod 33) "a number between 0 and 32"))
  14     (class (check-type class (member :a :b :c)
  15                        "a valid network class - one of :A, :B or :C")
  16            (setf cidr (case class (:a 8) (:b 16) (:c 24)))))
  17   (let ((mask #xFFFFFFFF))
  18     (declare (type ub32 mask))
  19     (setf (ldb (byte (- 32 cidr) 0) mask) 0)
  20     (make-instance 'ipv4-address :name (integer-to-vector mask))))
  21
  22 (defobsolete make-subnet-mask make-netmask)
  23
  24 (defun ensure-netmask (thing)
  25   "If THING is of type IPV4-ADDRESS it is returned as is; if keyword it must be one of
  26 :A, :B or :C otherwise it's treated as a CIDR suffix."
  27   (etypecase thing
  28     (ipv4-address  thing)
  29     (unsigned-byte (make-netmask :cidr thing))
  30     (keyword       (make-netmask :class thing))))
  31
  32 (defobsolete ensure-subnet-mask ensure-netmask)
  33
  34 (defgeneric inet-address-network-portion (address mask)
  35   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  36 network part of ADDRESS.")
  37   (:method ((address ipv4-address) mask)
  38     (setf mask (ensure-subnet-mask mask))
  39     (let ((v (make-array 4 :element-type 'ub8))
  40           (av (address-name address))
  41           (mv (address-name mask)))
  42       (dotimes (i 4)
  43         (setf (aref v i)
  44               (logand (aref av i)
  45                       (aref mv i))))
  46       (make-instance 'ipv4-address :name v))))
  47
  48 (defgeneric inet-address-host-portion (address mask)
  49   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  50 host part of ADDRESS.")
  51   (:method ((address ipv4-address) mask)
  52     (setf mask (ensure-subnet-mask mask))
  53     (let ((v (make-array 4 :element-type 'ub8))
  54           (av (address-name address))
  55           (mv (address-name mask)))
  56       (dotimes (i 4)
  57         (setf (aref v i)
  58               (logand (aref av i)
  59                       (logxor (aref mv i) 255))))
  60       (make-instance 'ipv4-address :name v))))
  61
  62 (defgeneric inet-address-in-network-p (address network mask)
  63   (:documentation "Return T if ADDRESS is part of the subnet specified by
  64 NETWORK and MASK.")
  65   (:method ((address ipv4-address) (network ipv4-address) mask)
  66     (setf mask (ensure-subnet-mask mask))
  67     (address= (inet-address-network-portion address mask)
  68               (inet-address-network-portion network mask))))
  69
  70 (defgeneric inet-addresses-in-same-network-p (address1 address2 network mask)
  71   (:documentation "Return T if ADDRESS1 and ADDRESS2 are both part part of the
  72 subnet specified by NETWORK and MASK.")
  73   (:method ((address1 ipv4-address) (address2 ipv4-address) (network ipv4-address) mask)
  74     (setf mask (ensure-subnet-mask mask))
  75     (let ((address1-network (inet-address-network-portion address1 mask))
  76           (address2-network (inet-address-network-portion address2 mask))
  77           (subnet (inet-address-network-portion network mask)))
  78       (and (address= address1-network subnet)
  79            (address= address2-network subnet)))))
  80
  81 (defgeneric inet-address-network-class (address)
  82   (:documentation "Return the network class of ADDRESS: one of :A, :B, :C, :D or :E .")
  83   (:method ((address ipv4-address))
  84     (let ((octet (aref (address-name address) 0)))
  85       (cond
  86         ((= #b0000 (ldb (byte 1 7) octet)) :a)
  87         ((= #b0010 (ldb (byte 2 6) octet)) :b)
  88         ((= #b0110 (ldb (byte 3 5) octet)) :c)
  89         ((= #b1110 (ldb (byte 4 4) octet)) :d)
  90         ((= #b1111 (ldb (byte 4 4) octet)) :e)))))
  91
  92 (defgeneric inet-address-private-p (address)
  93   (:documentation "Returns T if ADDRESS is in a private network range.
  94 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
  95 See http://en.wikipedia.org/wiki/Private_network for details.")
  96   (:method ((address ipv4-address))
  97     (let* ((address-name (address-name address))
  98            (first (aref address-name 0))
  99            (second (aref address-name 1)))
 100       (values (or (= first 10)
 101                   (and (= first 172)
 102                        (<= 16 second 31))
 103                   (and (= first 192)
 104                        (= second 168)))
 105               (inet-address-network-class address))))
 106   (:method ((address address))
 107     nil))
 108 \f
 109
 110 (defclass ipv4-network ()
 111   ((address :initarg :address :accessor address-of)
 112    (netmask :initarg :netmask :accessor netmask-of)
 113    (cidr :accessor cidr-of))
 114   (:documentation "IPv4 network: an address plus a netmask."))
 115
 116 (defun compute-cidr-prefix-from-netmask (netmask)
 117   (let ((ub32-address (vector-to-integer (address-name netmask))))
 118     (loop :with count := 0
 119        :for i :below 32
 120        :do (if (logbitp i ub32-address)
 121                (loop-finish)
 122                (incf count))
 123        :finally (return count))))
 124
 125 (defmethod initialize-instance :after ((network ipv4-network)
 126                                        &key address netmask)
 127   (check-type address ipv4-address "an Ipv4 address")
 128   (check-type netmask ipv4-address "an Ipv4 netmask")
 129   (setf (cidr-of network) (compute-cidr-prefix-from-netmask netmask))
 130   (setf (address-of network)
 131         (inet-address-network-portion address netmask)))
 132
 133 (defmethod print-object ((network ipv4-network) stream)
 134   (format stream "@~A/~A"
 135           (address-to-string (address-of network))
 136           (cidr-of network)))