net.sockets/address-arithmetic.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; address-arithmetic.lisp --- Arithmetic with addresses and network masks.
   4 ;;;
   5 ;;; Copyright (C) 2008, Stelian Ionescu  <sionescu@common-lisp.net>
   6 ;;;
   7 ;;; This code is free software; you can redistribute it and/or
   8 ;;; modify it under the terms of the version 2.1 of
   9 ;;; the GNU Lesser General Public License as published by
  10 ;;; the Free Software Foundation, as clarified by the
  11 ;;; preamble found here:
  12 ;;;     http://opensource.franz.com/preamble.html
  13 ;;;
  14 ;;; This program is distributed in the hope that it will be useful,
  15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU Lesser General
  20 ;;; Public License along with this library; if not, write to the
  21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  22 ;;; Boston, MA 02110-1301, USA
  23
  24 (in-package :net.sockets)
  25
  26 (defun make-subnet-mask (&key cidr class)
  27   (assert (or cidr class) (cidr class) "You must either specify a CIDR or a network class.")
  28   (when cidr (check-type cidr (mod 32) "a number between 0 and 31"))
  29   (when class (check-type class (member :a :b :c) "a valid network class - one of :A, :B or :C"))
  30   (let ((mask #xFFFFFFFF))
  31     (declare (type ub32 mask))
  32     (when class (setf cidr (case class
  33                              (:a 8)
  34                              (:b 16)
  35                              (:c 24))))
  36     (setf (ldb (byte (- 32 cidr) 0) mask) 0)
  37     (make-instance 'ipv4-address :name (integer-to-vector mask))))
  38
  39 (defun ensure-subnet-mask (thing)
  40   "If THING is of type IPV4-ADDRESS it is returned as is; if keyword it must be one of
  41 :A, :B or :C otherwise it's treated as a CIDR suffix."
  42   (etypecase thing
  43     (ipv4-address  thing)
  44     (unsigned-byte (make-subnet-mask :cidr thing))
  45     (keyword       (make-subnet-mask :class thing))))
  46
  47 (defgeneric inet-address-network-portion (address mask)
  48   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  49 network part of ADDRESS.")
  50   (:method ((address ipv4-address) mask)
  51     (setf mask (ensure-subnet-mask mask))
  52     (let ((v (make-array 4 :element-type 'ub8))
  53           (av (address-name address))
  54           (mv (address-name mask)))
  55       (dotimes (i 4)
  56         (setf (aref v i)
  57               (logand (aref av i)
  58                       (aref mv i))))
  59       (make-instance 'ipv4-address :name v))))
  60
  61 (defgeneric inet-address-host-portion (address mask)
  62   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  63 host part of ADDRESS.")
  64   (:method ((address ipv4-address) mask)
  65     (setf mask (ensure-subnet-mask mask))
  66     (let ((v (make-array 4 :element-type 'ub8))
  67           (av (address-name address))
  68           (mv (address-name mask)))
  69       (dotimes (i 4)
  70         (setf (aref v i)
  71               (logand (aref av i)
  72                       (logxor (aref mv i) 255))))
  73       (make-instance 'ipv4-address :name v))))
  74
  75 (defgeneric inet-address-in-network-p (address network mask)
  76   (:documentation "Return T if ADDRESS is part of the subnet specified by
  77 NETWORK and MASK.")
  78   (:method ((address ipv4-address)
  79             (network ipv4-address)
  80             mask)
  81     (setf mask (ensure-subnet-mask mask))
  82     (address= (inet-address-network-portion address mask)
  83               (inet-address-network-portion network mask))))
  84
  85 (defgeneric inet-addresses-in-same-network-p (address1 address2 network mask)
  86   (:documentation "Return T if ADDRESS1 and ADDRESS2 are both part part of the
  87 subnet specified by NETWORK and MASK.")
  88   (:method ((address1 ipv4-address)
  89             (address2 ipv4-address)
  90             (network ipv4-address)
  91             mask)
  92     (setf mask (ensure-subnet-mask mask))
  93     (let ((address1-network (inet-address-network-portion address1 mask))
  94           (address2-network (inet-address-network-portion address2 mask))
  95           (subnet (inet-address-network-portion network mask)))
  96       (and (address= address1-network subnet)
  97            (address= address2-network subnet)))))
  98
  99 (defgeneric inet-address-network-class (address)
 100   (:documentation "Return the network class of ADDRESS: one of :A, :B, :C, :D OR :E .")
 101   (:method ((address ipv4-address))
 102     (let ((octet (aref (address-name address) 0)))
 103       (cond
 104         ((= #b0000 (ldb (byte 1 7) octet)) :a)
 105         ((= #b0010 (ldb (byte 2 6) octet)) :b)
 106         ((= #b0110 (ldb (byte 3 5) octet)) :c)
 107         ((= #b1110 (ldb (byte 4 4) octet)) :d)
 108         ((= #b1111 (ldb (byte 4 4) octet)) :e)))))
 109
 110 (defgeneric inet-address-private-p (address)
 111   (:documentation "Returns T if ADDRESS is in a private network range.
 112 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
 113 See http://en.wikipedia.org/wiki/Private_network for details.")
 114   (:method ((address ipv4-address))
 115     (let* ((address-name (address-name address))
 116            (first (aref address-name 0))
 117            (second (aref address-name 1)))
 118       (values (or (= first 10)
 119                   (and (= first 172)
 120                        (<= 16 second 31))
 121                   (and (= first 192)
 122                        (= second 168)))
 123               (inet-address-network-class address))))
 124   (:method ((address address))
 125     nil))