sockets/address.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :net.sockets)
  23
  24 \f
  25 ;;;
  26 ;;; Conversion functions
  27 ;;;
  28
  29 (defun ipaddr-to-dotted (ipaddr)
  30   "Convert a 32-bit unsigned integer to a dotted string."
  31   (check-type ipaddr ub32)
  32   (let ((*print-pretty* nil))
  33     (with-output-to-string (s)
  34       (princ (ldb (byte 8 24) ipaddr) s) (princ #\. s)
  35       (princ (ldb (byte 8 16) ipaddr) s) (princ #\. s)
  36       (princ (ldb (byte 8 8)  ipaddr) s) (princ #\. s)
  37       (princ (ldb (byte 8 0)  ipaddr) s))))
  38
  39 (defun dotted-to-ipaddr (address)
  40   "Convert a dotted IPv4 address to a 32-bit unsigned integer."
  41   (vector-to-ipaddr (dotted-to-vector address)))
  42
  43 (defun dotted-to-vector (address)
  44   "Convert a dotted IPv4 address to a (simple-array (unsigned-byte 8) 4)."
  45   (check-type address string)
  46   (let ((addr (make-array 4 :element-type 'ub8 :initial-element 0))
  47         (split (split-sequence #\. address :count 5)))
  48     (flet ((set-array-value (index str)
  49              (setf (aref addr index)
  50                    (or (parse-number-or-nil str :ub8)
  51                        (error 'parse-error)))))
  52       (let ((len (length split)))
  53         (unless (<= 1 len 4) (error 'parse-error))
  54         (set-array-value 3 (nth (1- len) split))
  55         (loop :for n :in split
  56               :for index :below (1- len)
  57            :do (set-array-value index n))))
  58     (values addr)))
  59
  60 (defun vector-to-dotted (vector)
  61   "Convert an 4-element vector to a dotted string."
  62   (coercef vector 'ipv4-array)
  63   (let ((*print-pretty* nil))
  64     (with-output-to-string (s)
  65       (princ (aref vector 0) s) (princ #\. s)
  66       (princ (aref vector 1) s) (princ #\. s)
  67       (princ (aref vector 2) s) (princ #\. s)
  68       (princ (aref vector 3) s))))
  69
  70 (defun colon-separated-to-vector (string)
  71   "Convert a colon-separated IPv6 address to a (simple-array (unsigned-byte 16) 8)."
  72   (check-type string string)
  73   (with-foreign-object (in6-addr :uint16 8)
  74     (with-foreign-string (string-pointer string)
  75       (et:bzero in6-addr 16)
  76       (handler-case
  77           (et:inet-pton et:af-inet6      ; address family
  78                         string-pointer   ; name
  79                         in6-addr)        ; pointer to struct in6_addr
  80         (unix-error () (error 'parse-error))))
  81     (in6-addr-to-ipv6-array in6-addr)))
  82
  83 (defun vector-to-colon-separated (vector &optional (case :downcase))
  84   "Convert an 8-element vector to a colon-separated IPv6 address. `CASE' may be :DOWNCASE or :UPCASE."
  85   (coercef vector 'ipv6-array)
  86   (check-type case (member :upcase :downcase))
  87   (with-foreign-object (sin6 'et:sockaddr-in6)
  88     (with-foreign-pointer (namebuf et:inet6-addrstrlen bufsize)
  89       (make-sockaddr-in6 sin6 vector)
  90       (et:inet-ntop et:af-inet6                          ; address family
  91                     (foreign-slot-pointer
  92                       sin6 'et:sockaddr-in6 'et:addr)    ; pointer to struct in6_addr
  93                     namebuf                              ; destination buffer
  94                     bufsize)                             ; INET6_ADDRSTRLEN
  95       (return-from vector-to-colon-separated
  96         (let ((str (foreign-string-to-lisp namebuf bufsize)))
  97           (case case
  98             (:downcase (nstring-downcase str))
  99             (:upcase   (nstring-upcase   str))))))))
 100
 101 (defun string-address-to-vector (address)
 102   "Convert a string address(dotted or colon-separated) to a vector address.
 103 If the string is not a valid address, return NIL."
 104   (or (ignore-errors (dotted-to-vector address))
 105       (ignore-errors (colon-separated-to-vector address))))
 106
 107 (defun address-to-vector (address)
 108   "Convert any reppresentation of an internet address to a vector. Allowed inputs are: unsigned 32-bit integers, strings, vectors and INETADDR objects.
 109 If the address is valid, two values are returned: the vector and the address type(:IPV4 or IPV6), otherwise NIL is returned."
 110   (let (vector addr-type)
 111     (typecase address
 112       (number (and (ignore-errors (setf vector (ipaddr-to-vector address)))
 113                    (setf addr-type :ipv4)))
 114       (string (cond
 115                 ((ignore-errors (setf vector (dotted-to-vector address)))
 116                  (setf addr-type :ipv4))
 117                 ((ignore-errors (setf vector (colon-separated-to-vector address)))
 118                  (setf addr-type :ipv6))))
 119       ((vector * 4) (and (ignore-errors (setf vector (coerce address 'ipv4-array)))
 120                          (setf addr-type :ipv4)))
 121       ((vector * 8) (and (ignore-errors (setf vector (coerce address 'ipv6-array)))
 122                          (setf addr-type :ipv6)))
 123       (ipv4addr (setf vector (name address)
 124                       addr-type :ipv4))
 125       (ipv6addr (setf vector (name address)
 126                       addr-type :ipv6)))
 127     (when vector (values vector addr-type))))
 128
 129 (defun ensure-address (address &optional (family :internet))
 130   (cond ((sockaddrp address)
 131          (progn
 132            (ecase family
 133              (:internet (check-type address inetaddr))
 134              (:local    (check-type address localaddr)))
 135            (values address)))
 136         ((stringp address)
 137          (if (eql family :local)
 138              (make-instance 'localaddr :name address)
 139              (make-address (or (dotted-to-vector address)
 140                                (colon-separated-to-vector address)))))
 141         (t (make-address address))))
 142
 143 \f
 144 ;;;
 145 ;;; Class definitions
 146 ;;;
 147
 148 (defclass sockaddr ()
 149   ((name :initarg :name :reader name :type vector))
 150   (:documentation "Base class for all socket address classes."))
 151
 152 (defclass inetaddr (sockaddr) ()
 153   (:documentation "IP addresses."))
 154
 155 (defclass ipv4addr (inetaddr) ()
 156   (:documentation "IPv4 address."))
 157
 158 (defclass ipv6addr (inetaddr) ()
 159   (:documentation "IPv6 address."))
 160
 161 (defclass localaddr (sockaddr)
 162   ((abstract :initform nil :initarg :abstract :reader abstract-p :type boolean))
 163   (:documentation "UNIX socket address."))
 164
 165 \f
 166 ;;;
 167 ;;; Print methods
 168 ;;;
 169
 170 (defmethod print-object ((address ipv4addr) stream)
 171   (print-unreadable-object (address stream :type nil :identity nil)
 172     (format stream "IPv4 address: ~A"
 173             (sockaddr->presentation address))))
 174
 175 (defmethod print-object ((address ipv6addr) stream)
 176   (print-unreadable-object (address stream :type nil :identity nil)
 177     (format stream "IPv6 address: ~A"
 178             (sockaddr->presentation address))))
 179
 180 (defmethod print-object ((address localaddr) stream)
 181   (print-unreadable-object (address stream :type nil :identity nil)
 182     (with-slots (abstract) address
 183       (format stream "Unix socket address: ~A. Abstract: ~:[no~;yes~]"
 184               (sockaddr->presentation address) abstract))))
 185
 186 (defgeneric sockaddr->presentation (addr)
 187   (:documentation "Returns a textual presentation of ADDR."))
 188
 189 (defmethod sockaddr->presentation ((addr ipv4addr))
 190   (vector-to-dotted (name addr)))
 191
 192 (defmethod sockaddr->presentation ((addr ipv6addr))
 193   (vector-to-colon-separated (name addr)))
 194
 195 (defmethod sockaddr->presentation ((addr localaddr))
 196   (if (abstract-p addr)
 197       "<unknown socket>"
 198       (name addr)))
 199
 200 \f
 201 ;;;
 202 ;;; Equality methods
 203 ;;;
 204
 205 (defun vector-equal (v1 v2)
 206   (and (= (length v1) (length v2))
 207        (every #'eql v1 v2)))
 208
 209 (defgeneric sockaddr= (addr1 addr2)
 210   (:documentation "Returns T if both arguments are the same socket address."))
 211
 212 (defmethod sockaddr= ((addr1 inetaddr) (addr2 inetaddr))
 213   (vector-equal (name addr1) (name addr2)))
 214
 215 (defmethod sockaddr= ((addr1 localaddr) (addr2 localaddr))
 216   (equal (name addr1) (name addr2)))
 217
 218 \f
 219 ;;;
 220 ;;; Copy methods
 221 ;;;
 222
 223 (defgeneric copy-sockaddr (addr)
 224   (:documentation "Returns a copy of ADDR which is SOCKADDR= to the original."))
 225
 226 (defmethod copy-sockaddr ((addr ipv4addr))
 227   (make-instance 'ipv4addr
 228                  :name (copy-seq (name addr))))
 229
 230 (defmethod copy-sockaddr ((addr ipv6addr))
 231   (make-instance 'ipv6addr
 232                  :name (copy-seq (name addr))))
 233
 234 (defmethod copy-sockaddr ((addr localaddr))
 235   (make-instance 'localaddr
 236                  :name (copy-seq (name addr))
 237                  :abstract (abstract-p addr)))
 238
 239 (defgeneric map-ipv4-address->ipv6 (addr)
 240   (:documentation "Returns an IPv6 address by mapping ADDR onto it."))
 241 (defmethod map-ipv4-address->ipv6 ((addr ipv4addr))
 242   (make-instance 'ipv6addr
 243                  :name (map-ipv4-vector-to-ipv6 (name addr))))
 244
 245
 246 ;;; Constructor
 247 (defun make-address (name)
 248   (cond
 249     ((stringp name)
 250      (make-instance 'localaddr :name name))
 251     ((ignore-errors (coercef name 'ipv4-array))
 252      (make-instance 'ipv4addr :name name))
 253     ((ignore-errors (coercef name 'ipv6-array))
 254      (make-instance 'ipv6addr :name name))
 255     (t (error 'type-error :datum name :expected-type '(or string ipv4-array ipv6-array)))))
 256 \f
 257 ;;;
 258 ;;; Well-known addresses
 259 ;;;
 260
 261 (defparameter +ipv4-unspecified+
 262   (make-address #(0 0 0 0)))
 263
 264 (defparameter +ipv4-loopback+
 265   (make-address #(127 0 0 1)))
 266
 267 (defparameter +ipv6-unspecified+
 268   (make-address #(0 0 0 0 0 0 0 0)))
 269
 270 (defparameter +ipv6-loopback+
 271   (make-address #(0 0 0 0 0 0 0 1)))
 272
 273 ;; Multicast addresses replacing IPv4 broadcast addresses
 274 (defparameter +ipv6-interface-local-all-nodes+
 275   (make-address #(#xFF01 0 0 0 0 0 0 1)))
 276
 277 (defparameter +ipv6-link-local-all-nodes+
 278   (make-address #(#xFF02 0 0 0 0 0 0 1)))
 279
 280 (defparameter +ipv6-interface-local-all-routers+
 281   (make-address #(#xFF01 0 0 0 0 0 0 2)))
 282
 283 (defparameter +ipv6-link-local-all-routers+
 284   (make-address #(#xFF02 0 0 0 0 0 0 2)))
 285
 286 (defparameter +ipv6-site-local-all-routers+
 287   (make-address #(#xFF05 0 0 0 0 0 0 2)))
 288
 289 \f
 290 ;;;
 291 ;;; Predicates
 292 ;;;
 293
 294 ;; General predicates
 295 (defgeneric sockaddrp (address)
 296   (:documentation "Returns T if ADDRESS is a socket address."))
 297
 298 (defmethod sockaddrp ((address sockaddr))
 299   (declare (ignore address))
 300   t)
 301
 302 (defmethod sockaddrp (address)
 303   (declare (ignore address))
 304   nil)
 305
 306 (defgeneric ipv4-address-p (address)
 307   (:documentation "Returns T if ADDRESS is an IPv4 address object."))
 308
 309 (defmethod ipv4-address-p ((address ipv4addr))
 310   (declare (ignore address))
 311   t)
 312
 313 (defmethod ipv4-address-p (address)
 314   (declare (ignore address))
 315   nil)
 316
 317 (defgeneric ipv6-address-p (address)
 318   (:documentation "Returns T if ADDRESS is an IPv6 address object."))
 319
 320 (defmethod ipv6-address-p ((address ipv6addr))
 321   (declare (ignore address))
 322   t)
 323
 324 (defmethod ipv6-address-p (address)
 325   (declare (ignore address))
 326   nil)
 327
 328 (defgeneric local-address-p (address)
 329   (:documentation "Returns T if ADDRESS is local address object."))
 330
 331 (defmethod local-address-p ((address localaddr))
 332   (declare (ignore address))
 333   t)
 334
 335 (defmethod local-address-p (address)
 336   (declare (ignore address))
 337   nil)
 338
 339 (defmethod address-type ((address ipv4addr))
 340   (declare (ignore address))
 341   :ipv4)
 342
 343 (defmethod address-type ((address ipv6addr))
 344   (declare (ignore address))
 345   :ipv6)
 346
 347 (defmethod address-type ((address localaddr))
 348   (declare (ignore address))
 349   :local)
 350
 351 (defmethod address-type (address)
 352   (declare (ignore address))
 353   nil)
 354
 355 ;; IPv4 predicates
 356
 357 (defgeneric inetaddr-unspecified-p (addr)
 358   (:documentation "Returns T if ADDR is an \"unspecified\" internet address."))
 359 (defmethod inetaddr-unspecified-p ((addr ipv4addr))
 360   (sockaddr= addr +ipv4-unspecified+))
 361
 362 (defgeneric inetaddr-loopback-p (addr)
 363   (:documentation "Returns T if ADDR is a loopback internet address."))
 364 (defmethod inetaddr-loopback-p ((addr ipv4addr))
 365   (sockaddr= addr +ipv4-loopback+))
 366
 367 (defgeneric inetaddr-multicast-p (addr)
 368   (:documentation "Returns T if ADDR is an multicast internet address."))
 369 (defmethod inetaddr-multicast-p ((addr ipv4addr))
 370   (eql (logand (aref (name addr) 0)
 371                #xE0)
 372        #xE0))
 373
 374 (defgeneric inetaddr-unicast-p (addr)
 375   (:documentation "Returns T if ADDR is an unicast internet address."))
 376 (defmethod inetaddr-unicast-p ((addr ipv4addr))
 377   (and (not (inetaddr-unspecified-p addr))
 378        (not (inetaddr-loopback-p addr))
 379        (not (inetaddr-multicast-p addr))))
 380
 381 ;; IPv6 predicates
 382 ;; definitions taken from RFC 2460
 383
 384 (defmethod inetaddr-unspecified-p ((addr ipv6addr))
 385   (sockaddr= addr +ipv6-unspecified+))
 386
 387 (defmethod inetaddr-loopback-p ((addr ipv6addr))
 388   (sockaddr= addr +ipv6-loopback+))
 389
 390 (defgeneric ipv6-ipv4-mapped-p (addr)
 391   (:documentation "Returns T if ADDR is an IPv6 address representing an IPv4 mapped address."))
 392 (defmethod ipv6-ipv4-mapped-p ((addr ipv6addr))
 393   (with-slots (name) addr
 394     (and (zerop (aref name 0))
 395          (zerop (aref name 1))
 396          (zerop (aref name 2))
 397          (zerop (aref name 3))
 398          (zerop (aref name 4))
 399          (eql (aref name 5) #xFFFF)
 400          (< (ldb (byte 8 0) (aref name 6))
 401             255)
 402          (< (ldb (byte 8 8) (aref name 6))
 403             255)
 404          (< (ldb (byte 8 0) (aref name 7))
 405             255)
 406          (< (ldb (byte 8 8) (aref name 7))
 407             255))))
 408
 409 (defmethod inetaddr-multicast-p ((addr ipv6addr))
 410   (eql (logand (aref (name addr) 0)
 411                #xFF00)
 412        #xFF00))
 413
 414 (defgeneric ipv6-interface-local-multicast-p (addr)
 415   (:documentation "Returns T if ADDR is an interface-local IPv6 address."))
 416 (defmethod ipv6-interface-local-multicast-p ((addr ipv6addr))
 417   (eql (logand (aref (name addr) 0)
 418                #xFF0F)
 419        #xFF01))
 420
 421 (defgeneric ipv6-link-local-multicast-p (addr)
 422   (:documentation "Returns T if ADDR is a link-local IPv6 address."))
 423 (defmethod ipv6-link-local-multicast-p ((addr ipv6addr))
 424   (eql (logand (aref (name addr) 0)
 425                #xFF0F)
 426        #xFF02))
 427
 428 (defgeneric ipv6-admin-local-multicast-p (addr)
 429   (:documentation "Returns T if ADDR is a admin-local multicast IPv6 address."))
 430 (defmethod ipv6-admin-local-multicast-p ((addr ipv6addr))
 431   (eql (logand (aref (name addr) 0)
 432                #xFF0F)
 433        #xFF04))
 434
 435 (defgeneric ipv6-site-local-multicast-p (addr)
 436   (:documentation "Returns T if ADDR is an site-local multicast IPv6 address."))
 437 (defmethod ipv6-site-local-multicast-p ((addr ipv6addr))
 438   (eql (logand (aref (name addr) 0)
 439                #xFF0F)
 440        #xFF05))
 441
 442 (defgeneric ipv6-organization-local-multicast-p (addr)
 443   (:documentation "Returns T if ADDR is an organization-local multicast IPv6 address."))
 444 (defmethod ipv6-organization-local-multicast-p ((addr ipv6addr))
 445   (eql (logand (aref (name addr) 0)
 446                #xFF0F)
 447        #xFF08))
 448
 449 (defgeneric ipv6-global-multicast-p (addr)
 450   (:documentation "Returns T if ADDR is a global multicast IPv6 address."))
 451 (defmethod ipv6-global-multicast-p ((addr ipv6addr))
 452   (eql (logand (aref (name addr) 0)
 453                #xFF0F)
 454        #xFF0E))
 455
 456 (defgeneric ipv6-reserved-multicast-p (addr)
 457   (:documentation "Returns T if ADDR is a reserved multicast IPv6 address."))
 458 (defmethod ipv6-reserved-multicast-p ((addr ipv6addr))
 459   (member (logand (aref (name addr) 0)
 460                   #xFF0F)
 461           (list #xFF00 #xFF03 #xFF0F)))
 462
 463 (defgeneric ipv6-unassigned-multicast-p (addr)
 464   (:documentation "Returns T if ADDR is an unassigned multicast IPv6 address."))
 465 (defmethod ipv6-unassigned-multicast-p ((addr ipv6addr))
 466   (member (logand (aref (name addr) 0)
 467                   #xFF0F)
 468           (list #xFF06 #xFF07 #xFF09 #xFF0A #xFF0B #xFF0C #xFF0D)))
 469
 470 (defgeneric ipv6-transient-multicast-p (addr)
 471   (:documentation "Returns T if ADDR is a transient multicast IPv6 address."))
 472 (defmethod ipv6-transient-multicast-p ((addr ipv6addr))
 473   (eql (logand (aref (name addr) 0)
 474                #xFF10)
 475        #xFF10))
 476
 477 (defgeneric ipv6-solicited-node-multicast-p (addr)
 478   (:documentation "Returns T if ADDR is an solicited-node multicast IPv6 address."))
 479 (defmethod ipv6-solicited-node-multicast-p ((addr ipv6addr))
 480   (let ((vec (name addr)))
 481     (and (eql (aref vec 0) #xFF02) ; link-local permanent multicast
 482          (eql (aref vec 5) 1)
 483          (eql (logand (aref vec 6)
 484                       #xFF00)
 485               #xFF00))))
 486
 487 (defgeneric ipv6-link-local-unicast-p (addr)
 488   (:documentation "Returns T if ADDR is an link-local unicast IPv6 address."))
 489 (defmethod ipv6-link-local-unicast-p ((addr ipv6addr))
 490   (eql (aref (name addr) 0) #xFE80))
 491
 492 (defgeneric ipv6-site-local-unicast-p (addr)
 493   (:documentation "Returns T if ADDR is an site-local unicast IPv6 address."))
 494 (defmethod ipv6-site-local-unicast-p ((addr ipv6addr))
 495   (eql (aref (name addr) 0) #xFEC0))
 496
 497 (defgeneric ipv6-global-unicast-p (addr)
 498   (:documentation "Returns T if ADDR is an global unicasst IPv6 address."))
 499 (defmethod ipv6-global-unicast-p ((addr ipv6addr))
 500   (and (not (inetaddr-unspecified-p addr))
 501        (not (inetaddr-loopback-p addr))
 502        (not (inetaddr-multicast-p addr))
 503        (not (ipv6-link-local-unicast-p addr))))
 504
 505 (defmethod inetaddr-unicast-p ((addr ipv6addr))
 506   (or (ipv6-link-local-unicast-p addr)
 507       (and (not (inetaddr-unspecified-p addr))
 508            (not (inetaddr-loopback-p addr))
 509            (not (inetaddr-multicast-p addr)))))
 510
 511 (defgeneric ipv6-multicast-type (addr)
 512   (:documentation "Returns the multicast type of ADDR(which must be IPv6)."))
 513 (defmethod ipv6-multicast-type ((addr ipv6addr))
 514   (cond
 515     ((ipv6-interface-local-multicast-p addr)    :interface-local)
 516     ((ipv6-link-local-multicast-p addr)         :link-local)
 517     ((ipv6-admin-local-multicast-p addr)        :admin-local)
 518     ((ipv6-site-local-multicast-p addr)         :site-local)
 519     ((ipv6-organization-local-multicast-p addr) :organization-local)
 520     ((ipv6-global-multicast-p addr)             :global)
 521     ((ipv6-reserved-multicast-p addr)           :reserved)
 522     ((ipv6-unassigned-multicast-p addr)         :unassigned)))
 523
 524 (defgeneric inetaddr-type (addr)
 525   (:documentation "Returns the address type of ADDR."))
 526
 527 (defmethod inetaddr-type ((addr ipv6addr))
 528   (cond
 529     ((inetaddr-unspecified-p addr)    (values :ipv6 :unspecified))
 530     ((inetaddr-loopback-p addr)       (values :ipv6 :loopback))
 531     ((inetaddr-multicast-p addr)      (values :ipv6 :multicast (ipv6-multicast-type addr)))
 532     ((ipv6-link-local-unicast-p addr) (values :ipv6 :unicast :link-local))
 533     (t                                (values :ipv6 :unicast :global))))
 534
 535 (defmethod inetaddr-type ((addr ipv4addr))
 536   (cond
 537     ((inetaddr-unspecified-p addr) (values :ipv4 :unspecified))
 538     ((inetaddr-loopback-p addr)    (values :ipv4 :loopback))
 539     ((inetaddr-multicast-p addr)   (values :ipv4 :multicast))
 540     ((inetaddr-unicast-p addr)     (values :ipv4 :unicast))))