mdw@git.distorted.org.uk Git - zone/blob - addr-family-ipv4.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; IPv6 address family support
   4 ;;;
   5 ;;; (c) 2005 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 (in-package #:net)
  25
  26 ;;;--------------------------------------------------------------------------
  27 ;;; Basic address type.
  28
  29 (deftype u32 ()
  30   "The type of unsigned 32-bit values."
  31   '(unsigned-byte 32))
  32
  33 (export 'ip4addr)
  34 (defclass ip4addr (ipaddr)
  35   ((addr :type u32 :initarg :addr :reader ipaddr-addr)))
  36
  37 (defmethod family-addrclass ((family (eql :ipv4))) 'ip4addr)
  38
  39 (defmethod ipaddr-family ((addr ip4addr)) :ipv4)
  40 (defmethod ipaddr-width ((class (eql 'ip4addr))) 32)
  41 (defmethod ipaddr-rrtype ((addr ip4addr)) :a)
  42
  43 (defun parse-partial-ip4addr (str &key (start 0) (end nil) (min 1) (max 32))
  44   "Parse (a substring of) STR as a partial IPv4 address."
  45   (parse-partial-address str :start start :end end
  46                          :delim #\. :width 8 :radix 10
  47                          :min min :max max :shiftp t
  48                          :what "IPv4 address"))
  49
  50 (defmethod parse-partial-ipaddr ((class (eql 'ip4addr)) str
  51                                  &key (start 0) (end nil) (min 1) (max 32))
  52   (parse-partial-ip4addr str :start start :end end :min min :max max))
  53
  54 (defmethod ipaddr-string ((ip ip4addr))
  55   "Convert IP into an IPv4 dotted-quad address string."
  56   (let ((addr (ipaddr-addr ip)))
  57     (join-strings #\. (collecting ()
  58                         (dotimes (i 4)
  59                           (collect (ldb (byte 8 (- 24 (* i 8))) addr)))))))
  60
  61 ;;;--------------------------------------------------------------------------
  62 ;;; IPv4 networks.
  63
  64 (defmethod ipmask ((addr ip4addr) (mask ip4addr))
  65   (ipaddr-addr mask))
  66
  67 (defclass ip4net (ipnet)
  68   ((net :type ip4addr :initarg :net :reader ipnet-net)
  69    (mask :type u32 :initarg :mask :reader ipnet-mask)))
  70
  71 (defmethod ipaddr-ipnet ((addr ip4addr) mask)
  72   (make-instance 'ip4net :net addr :mask mask))
  73
  74 (defmethod ipnet-broadcast ((ipn ip4net))
  75   (with-ipnet (nil addr mask) ipn
  76     (make-instance 'ip4addr :addr (logior addr (logxor mask #xffffffff)))))
  77
  78 ;;;--------------------------------------------------------------------------
  79 ;;; Reverse lookups.
  80
  81 (defmethod reverse-domain-component-width ((ipaddr ip4addr)) 8)
  82 (defmethod reverse-domain-radix ((ipaddr ip4addr)) 10)
  83 (defmethod reverse-domain-suffix ((ipaddr ip4addr))
  84   (make-domain-name :labels (list "arpa" "in-addr") :absolutep t))
  85
  86 ;;;----- That's all, folks --------------------------------------------------