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-subnet-mask (&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 (defun ensure-subnet-mask (thing)
  23   "If THING is of type IPV4-ADDRESS it is returned as is; if keyword it must be one of
  24 :A, :B or :C otherwise it's treated as a CIDR suffix."
  25   (etypecase thing
  26     (ipv4-address  thing)
  27     (unsigned-byte (make-subnet-mask :cidr thing))
  28     (keyword       (make-subnet-mask :class thing))))
  29
  30 (defgeneric inet-address-network-portion (address mask)
  31   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  32 network part of ADDRESS.")
  33   (:method ((address ipv4-address) mask)
  34     (setf mask (ensure-subnet-mask mask))
  35     (let ((v (make-array 4 :element-type 'ub8))
  36           (av (address-name address))
  37           (mv (address-name mask)))
  38       (dotimes (i 4)
  39         (setf (aref v i)
  40               (logand (aref av i)
  41                       (aref mv i))))
  42       (make-instance 'ipv4-address :name v))))
  43
  44 (defgeneric inet-address-host-portion (address mask)
  45   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  46 host part of ADDRESS.")
  47   (:method ((address ipv4-address) mask)
  48     (setf mask (ensure-subnet-mask mask))
  49     (let ((v (make-array 4 :element-type 'ub8))
  50           (av (address-name address))
  51           (mv (address-name mask)))
  52       (dotimes (i 4)
  53         (setf (aref v i)
  54               (logand (aref av i)
  55                       (logxor (aref mv i) 255))))
  56       (make-instance 'ipv4-address :name v))))
  57
  58 (defgeneric inet-address-in-network-p (address network mask)
  59   (:documentation "Return T if ADDRESS is part of the subnet specified by
  60 NETWORK and MASK.")
  61   (:method ((address ipv4-address) (network ipv4-address) mask)
  62     (setf mask (ensure-subnet-mask mask))
  63     (address= (inet-address-network-portion address mask)
  64               (inet-address-network-portion network mask))))
  65
  66 (defgeneric inet-addresses-in-same-network-p (address1 address2 network mask)
  67   (:documentation "Return T if ADDRESS1 and ADDRESS2 are both part part of the
  68 subnet specified by NETWORK and MASK.")
  69   (:method ((address1 ipv4-address) (address2 ipv4-address) (network ipv4-address) mask)
  70     (setf mask (ensure-subnet-mask mask))
  71     (let ((address1-network (inet-address-network-portion address1 mask))
  72           (address2-network (inet-address-network-portion address2 mask))
  73           (subnet (inet-address-network-portion network mask)))
  74       (and (address= address1-network subnet)
  75            (address= address2-network subnet)))))
  76
  77 (defgeneric inet-address-network-class (address)
  78   (:documentation "Return the network class of ADDRESS: one of :A, :B, :C, :D OR :E .")
  79   (:method ((address ipv4-address))
  80     (let ((octet (aref (address-name address) 0)))
  81       (cond
  82         ((= #b0000 (ldb (byte 1 7) octet)) :a)
  83         ((= #b0010 (ldb (byte 2 6) octet)) :b)
  84         ((= #b0110 (ldb (byte 3 5) octet)) :c)
  85         ((= #b1110 (ldb (byte 4 4) octet)) :d)
  86         ((= #b1111 (ldb (byte 4 4) octet)) :e)))))
  87
  88 (defgeneric inet-address-private-p (address)
  89   (:documentation "Returns T if ADDRESS is in a private network range.
  90 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
  91 See http://en.wikipedia.org/wiki/Private_network for details.")
  92   (:method ((address ipv4-address))
  93     (let* ((address-name (address-name address))
  94            (first (aref address-name 0))
  95            (second (aref address-name 1)))
  96       (values (or (= first 10)
  97                   (and (= first 172)
  98                        (<= 16 second 31))
  99                   (and (= first 192)
 100                        (= second 168)))
 101               (inet-address-network-class address))))
 102   (:method ((address address))
 103     nil))