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   (check-type cidr (or null (mod 32)) "a number between 0 and 31")
  29   (check-type class (member nil :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 (defgeneric inet-address-network-portion (address mask)
  40   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  41 network part of ADDRESS.")
  42   (:method ((address ipv4-address)
  43             (mask ipv4-address))
  44     (let ((v (make-array 4 :element-type 'ub8))
  45           (av (address-name address))
  46           (mv (address-name mask)))
  47       (dotimes (i 4)
  48         (setf (aref v i)
  49               (logand (aref av i)
  50                       (aref mv i))))
  51       (make-instance 'ipv4-address :name v))))
  52
  53 (defgeneric inet-address-host-portion (address mask)
  54   (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
  55 host part of ADDRESS.")
  56   (:method ((address ipv4-address)
  57             (mask ipv4-address))
  58     (let ((v (make-array 4 :element-type 'ub8))
  59           (av (address-name address))
  60           (mv (address-name mask)))
  61       (dotimes (i 4)
  62         (setf (aref v i)
  63               (logand (aref av i)
  64                       (logxor (aref mv i) 255))))
  65       (make-instance 'ipv4-address :name v))))
  66
  67 (defgeneric inet-address-in-network-p (address network mask)
  68   (:documentation "Return T if ADDRESS is part of the subnet specified by
  69 NETWORK and MASK.")
  70   (:method ((address ipv4-address)
  71             (network ipv4-address)
  72             (mask ipv4-address))
  73     (address= (address-network-portion address mask)
  74               (address-network-portion network mask))))
  75
  76 (defgeneric inet-addresses-in-same-network-p (address1 address2 network mask)
  77   (:documentation "Return T if ADDRESS1 and ADDRESS2 are both part part of the
  78 subnet specified by NETWORK and MASK.")
  79   (:method ((address1 ipv4-address)
  80             (address2 ipv4-address)
  81             (network ipv4-address)
  82             (mask ipv4-address))
  83     (let ((address1-network (address-network-portion address1 mask))
  84           (address2-network (address-network-portion address2 mask))
  85           (subnet (address-network-portion network mask)))
  86       (and (address= address1-network subnet)
  87            (address= address2-network subnet)))))
  88
  89 (defgeneric inet-address-network-class (address)
  90   (:documentation "Return the network class of ADDRESS: one of :A, :B, :C, :D OR :E .")
  91   (:method ((address ipv4-address))
  92     (let ((octet (aref (address-name address) 0)))
  93       (cond
  94         ((= #b0000 (ldb (byte 1 7) octet)) :a)
  95         ((= #b0010 (ldb (byte 2 6) octet)) :b)
  96         ((= #b0110 (ldb (byte 3 5) octet)) :c)
  97         ((= #b1110 (ldb (byte 4 4) octet)) :d)
  98         ((= #b1111 (ldb (byte 4 4) octet)) :e)))))