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