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