net.sockets/address-predicates.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; address-predicates.lisp --- Predicate functions for addresses.
   4 ;;;
   5 ;;; Copyright (C) 2006-2007, 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 ;;;; Well-known addresses
  27
  28 ;;; Defines a constant address.  We need ENSURE-ADDRESS at compile
  29 ;;; time which is why these functions are in a separate file from
  30 ;;; address.lisp.
  31 (defmacro define-address (name address-string docstring)
  32   `(define-constant ,name (ensure-address ,address-string)
  33      :documentation ,(format nil "~A (~A)" docstring address-string)
  34      :test 'address=))
  35
  36 (define-address +ipv4-unspecified+ "0.0.0.0"   "Unspecified IPv4 address.")
  37 (define-address +ipv4-loopback+    "127.0.0.1" "Loopback IPv4 address.")
  38 (define-address +ipv6-unspecified+ "::"        "Unspecified IPv6 address.")
  39 (define-address +ipv6-loopback+    "::1"       "Loopback IPv6 address.")
  40
  41 ;;;; Multicast addresses replacing IPv4 broadcast addresses
  42
  43 (define-address +ipv6-interface-local-all-nodes+ "ff01::1"
  44   "Interface local all nodes address.")
  45
  46 (define-address +ipv6-link-local-all-nodes+ "ff02::1"
  47   "Link local all nodes address.")
  48
  49 (define-address +ipv6-interface-local-all-routers+ "ff01::2"
  50   "Interface local all routers address.")
  51
  52 (define-address +ipv6-link-local-all-routers+ "ff02::2"
  53   "Link local all routers address.")
  54
  55 (define-address +ipv6-site-local-all-routers+ "ff05::2"
  56   "Site local all routers address.")
  57
  58 ;;;; Predicates
  59
  60 (defun addressp (address)
  61   "Returns T if ADDRESS is an object of class ADDRESS.  Does not
  62 return T for other low-level address representations."
  63   (typep address 'address))
  64
  65 (defun inet-address-p (address)
  66   "Returns T if ADDRESS is an Inet address object."
  67   (typep address 'inet-address))
  68
  69 (defun ipv4-address-p (address)
  70   "Returns T if ADDRESS is an IPv4 address object."
  71   (typep address 'ipv4-address))
  72
  73 (defun ipv6-address-p (address)
  74   "Returns T if ADDRESS is an IPv6 address object."
  75   (typep address 'ipv6-address))
  76
  77 (defun local-address-p (address)
  78   "Returns T if ADDRESS is a local address object."
  79   (typep address 'local-address))
  80
  81 (defgeneric address-type (address)
  82   (:documentation "Returns a keyword symbol denoting the kind of
  83 ADDRESS (:IPV4, :IPV6 or :LOCAL).  If ADDRESS is not a known
  84 address object, NIL is returned.")
  85   (:method ((address ipv4-address)) :ipv4)
  86   (:method ((address ipv6-address)) :ipv6)
  87   (:method ((address local-address)) :local)
  88   (:method (address)
  89     (declare (ignore address))
  90     nil))
  91
  92 (defgeneric inet-address-unspecified-p (addr)
  93   (:documentation "Returns T if ADDR is an \"unspecified\" internet address.")
  94   (:method ((address ipv4-address))
  95     (address= address +ipv4-unspecified+))
  96   (:method ((address ipv6-address))
  97     (address= address +ipv6-unspecified+)))
  98
  99 (defgeneric inet-address-loopback-p (address)
 100   (:documentation "Returns T if ADDRESS is a loopback internet address.")
 101   (:method ((address ipv4-address))
 102     (address= address +ipv4-loopback+))
 103   (:method ((address ipv6-address))
 104     (address= address +ipv6-loopback+)))
 105
 106 (defgeneric inet-address-multicast-p (address)
 107   (:documentation "Returns T if ADDRESS is an multicast internet address.")
 108   (:method ((address ipv4-address))
 109     (= (logand (aref (address-name address) 0) #xE0)
 110        #xE0))
 111   (:method ((address ipv6-address))
 112     (= (logand (aref (address-name address) 0) #xFF00)
 113        #xFF00)))
 114
 115 (defgeneric inet-address-unicast-p (address)
 116   (:documentation "Returns T if ADDRESS is an unicast internet address.")
 117   (:method ((address ipv4-address))
 118     (and (not (inet-address-unspecified-p address))
 119          (not (inet-address-loopback-p address))
 120          (not (inet-address-multicast-p address))))
 121   (:method ((address ipv6-address))
 122     (or (ipv6-link-local-unicast-p address)
 123         (and (not (inet-address-unspecified-p address))
 124              (not (inet-address-loopback-p address))
 125              (not (inet-address-multicast-p address))))))
 126
 127 (defgeneric inet-address-private-p (address)
 128   (:documentation "Returns T if ADDRESS is in a private network range.
 129 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
 130 See http://en.wikipedia.org/wiki/Private_network for details.")
 131   (:method ((address ipv4-address))
 132     (let* ((address-name (address-name address))
 133            (first (aref address-name 0))
 134            (second (aref address-name 1)))
 135       (or (= first 10)
 136           (and (= first 172)
 137                (<= 16 second 31))
 138           (and (= first 192)
 139                (= second 168)))))
 140   (:method ((address address))
 141     nil))
 142
 143 (defun ipv6-ipv4-mapped-p (address)
 144   "Returns T if ADDRESS is an IPv6 address representing an IPv4
 145 mapped address."
 146   (and (ipv6-address-p address)
 147        (ipv4-on-ipv6-mapped-vector-p (address-name address))))
 148
 149 (defun ipv6-interface-local-multicast-p (address)
 150   "Returns T if ADDRESS is an interface-local IPv6 address."
 151   (check-type address ipv6-address "an IPv6 address")
 152   (= (logand (aref (address-name address) 0) #xFF0F)
 153      #xFF01))
 154
 155 (defun ipv6-link-local-multicast-p (address)
 156   "Returns T if ADDRESS is a link-local IPv6 address."
 157   (check-type address ipv6-address "an IPv6 address")
 158   (= (logand (aref (address-name address) 0) #xFF0F)
 159      #xFF02))
 160
 161 (defun ipv6-admin-local-multicast-p (address)
 162   "Returns T if ADDRESS is a admin-local multicast IPv6 address."
 163   (check-type address ipv6-address "an IPv6 address")
 164   (= (logand (aref (address-name address) 0) #xFF0F)
 165      #xFF04))
 166
 167 (defun ipv6-site-local-multicast-p (address)
 168   "Returns T if ADDRESS is an site-local multicast IPv6 address."
 169   (check-type address ipv6-address "an IPv6 address")
 170   (= (logand (aref (address-name address) 0) #xFF0F)
 171      #xFF05))
 172
 173 (defun ipv6-organization-local-multicast-p (address)
 174   "Returns T if ADDRESS is an organization-local multicast IPv6 address."
 175   (check-type address ipv6-address "an IPv6 address")
 176   (= (logand (aref (address-name address) 0) #xFF0F)
 177      #xFF08))
 178
 179 (defun ipv6-global-multicast-p (address)
 180   "Returns T if ADDRESS is a global multicast IPv6 address."
 181   (check-type address ipv6-address "an IPv6 address")
 182   (= (logand (aref (address-name address) 0) #xFF0F)
 183      #xFF0E))
 184
 185 (defun ipv6-reserved-multicast-p (address)
 186   "Returns T if ADDRESS is a reserved multicast IPv6 address."
 187   (check-type address ipv6-address "an IPv6 address")
 188   (member (logand (aref (address-name address) 0) #xFF0F)
 189           '(#xFF00 #xFF03 #xFF0F)))
 190
 191 (defun ipv6-unassigned-multicast-p (address)
 192   "Returns T if ADDRESS is an unassigned multicast IPv6 address."
 193   (check-type address ipv6-address "an IPv6 address")
 194   (member (logand (aref (address-name address) 0) #xFF0F)
 195           '(#xFF06 #xFF07 #xFF09 #xFF0A #xFF0B #xFF0C #xFF0D)))
 196
 197 (defun ipv6-transient-multicast-p (address)
 198   "Returns T if ADDRESS is a transient multicast IPv6 address."
 199   (check-type address ipv6-address "an IPv6 address")
 200   (= (logand (aref (address-name address) 0) #xFF10)
 201      #xFF10))
 202
 203 (defun ipv6-solicited-node-multicast-p (address)
 204   "Returns T if ADDRESS is a solicited-node multicast IPv6 address."
 205   (check-type address ipv6-address "an IPv6 address")
 206   (let ((vec (address-name address)))
 207     (and (= (aref vec 0) #xFF02)      ; link-local permanent multicast
 208          (= (aref vec 5) 1)
 209          (= (logand (aref vec 6) #xFF00)
 210             #xFF00))))
 211
 212 (defun ipv6-link-local-unicast-p (address)
 213   "Returns T if ADDRESS is an link-local unicast IPv6 address."
 214   (check-type address ipv6-address "an IPv6 address")
 215   (= (aref (address-name address) 0) #xFE80))
 216
 217 (defun ipv6-site-local-unicast-p (address)
 218   "Returns T if ADDRESS is an site-local unicast IPv6 address."
 219   (check-type address ipv6-address "an IPv6 address")
 220   (= (aref (address-name address) 0) #xFEC0))
 221
 222 (defun ipv6-global-unicast-p (address)
 223   "Returns T if ADDRESS is an global unicasst IPv6 address."
 224   (check-type address ipv6-address "an IPv6 address")
 225   (and (not (inet-address-unspecified-p address))
 226        (not (inet-address-loopback-p address))
 227        (not (inet-address-multicast-p address))
 228        (not (ipv6-link-local-unicast-p address))))
 229
 230 (defun ipv6-multicast-type (address)
 231   "Returns the multicast type of ADDRESS or NIL if it's not a
 232 multicast address."
 233   (check-type address ipv6-address "an IPv6 address")
 234   (cond
 235     ((ipv6-interface-local-multicast-p address) :interface-local)
 236     ((ipv6-link-local-multicast-p address) :link-local)
 237     ((ipv6-admin-local-multicast-p address) :admin-local)
 238     ((ipv6-site-local-multicast-p address) :site-local)
 239     ((ipv6-organization-local-multicast-p address) :organization-local)
 240     ((ipv6-global-multicast-p address) :global)
 241     ((ipv6-reserved-multicast-p address) :reserved)
 242     ((ipv6-unassigned-multicast-p address) :unassigned)))
 243
 244 (defun ipv6-unicast-type (address)
 245   "Returns the unicast type of ADDRESS or NIL if it's not a
 246 unicast address."
 247   (check-type address ipv6-address "an IPv6 address")
 248   (cond
 249     ((ipv6-link-local-unicast-p address) :link-local)
 250     ((ipv6-site-local-unicast-p address) :site-local)
 251     ((ipv6-global-unicast-p address) :global)))
 252
 253 (defgeneric inet-address-type (address)
 254   (:documentation "Returns the address type of ADDRESS as 2 values:
 255
 256   * protocol, one of :IPV4 or :IPV6
 257   * kind, one of :UNSPECIFIED, :LOOPBACK, :MULTICAST or :UNICAST
 258
 259 For unicast or multicast IPv6 addresses, a third value is
 260 returned which corresponds to the return value of
 261 IPV6-UNICAST-TYPE or IPV6-MULTICAST-TYPE, respectively." ))
 262
 263 (defmethod inet-address-type ((addr ipv6-address))
 264   (cond
 265     ((inet-address-unspecified-p addr) (values :ipv6 :unspecified))
 266     ((inet-address-loopback-p addr) (values :ipv6 :loopback))
 267     ((inet-address-multicast-p addr)
 268      (values :ipv6 :multicast (ipv6-multicast-type addr)))
 269     (t (values :ipv6 :unicast (ipv6-unicast-type addr)))))
 270
 271 (defmethod inet-address-type ((addr ipv4-address))
 272   (values :ipv4
 273           (cond
 274             ((inet-address-unspecified-p addr) :unspecified)
 275             ((inet-address-loopback-p addr) :loopback)
 276             ((inet-address-multicast-p addr) :multicast)
 277             ((inet-address-unicast-p addr) :unicast))))