X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/f4e0c48f17d3c959d3751faba9ce9cd0becfba41..32ebbe9b0fcc1a698c6ffec760259c5f7e953a9d:/addr-family-ipv4.lisp

diff --git a/addr-family-ipv4.lisp b/addr-family-ipv4.lisp
new file mode 100644
index 0000000..f1846c8
--- /dev/null
+++ b/addr-family-ipv4.lisp
@@ -0,0 +1,85 @@
+;;; -*-lisp-*-
+;;;
+;;; IPv6 address family support
+;;;
+;;; (c) 2005 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package #:net)
+
+;;;--------------------------------------------------------------------------
+;;; Basic address type.
+
+(deftype u32 ()
+  "The type of unsigned 32-bit values."
+  '(unsigned-byte 32))
+
+(export 'ip4addr)
+(defclass ip4addr (ipaddr)
+  ((addr :type u32 :initarg :addr :reader ipaddr-addr)))
+
+(defmethod family-addrclass ((family (eql :ipv4))) 'ip4addr)
+
+(defmethod ipaddr-family ((addr ip4addr)) :ipv4)
+(defmethod ipaddr-width ((class (eql 'ip4addr))) 32)
+(defmethod ipaddr-rrtype ((addr ip4addr)) :a)
+
+(defun parse-partial-ip4addr (str &key (start 0) (end nil) (min 1) (max 32))
+  "Parse (a substring of) STR as a partial IPv4 address."
+  (parse-partial-address str :start start :end end
+			 :delim #\. :width 8 :radix 10
+			 :min min :max max :shiftp t
+			 :what "IPv4 address"))
+
+(defmethod parse-partial-ipaddr ((class (eql 'ip4addr)) str
+				 &key (start 0) (end nil) (min 1) (max 32))
+  (parse-partial-ip4addr str :start start :end end :min min :max max))
+
+(defmethod ipaddr-string ((ip ip4addr))
+  "Convert IP into an IPv4 dotted-quad address string."
+  (let ((addr (ipaddr-addr ip)))
+    (join-strings #\. (collecting ()
+			(dotimes (i 4)
+			  (collect (ldb (byte 8 (- 24 (* i 8))) addr)))))))
+
+;;;--------------------------------------------------------------------------
+;;; IPv4 networks.
+
+(defmethod ipmask ((addr ip4addr) (mask ip4addr))
+  (ipaddr-addr mask))
+
+(defclass ip4net (ipnet)
+  ((net :type ip4addr :initarg :net :reader ipnet-net)
+   (mask :type u32 :initarg :mask :reader ipnet-mask)))
+
+(defmethod ipaddr-ipnet ((addr ip4addr) mask)
+  (make-instance 'ip4net :net addr :mask mask))
+
+(defmethod ipnet-broadcast ((ipn ip4net))
+  (with-ipnet (nil addr mask) ipn
+    (make-instance 'ip4addr :addr (logior addr (logxor mask #xffffffff)))))
+
+;;;--------------------------------------------------------------------------
+;;; Reverse lookups.
+
+(defmethod reverse-domain-component-width ((ipaddr ip4addr)) 8)
+(defmethod reverse-domain-radix ((ipaddr ip4addr)) 10)
+(defmethod reverse-domain-suffix ((ipaddr ip4addr)) "in-addr.arpa")
+
+;;;----- That's all, folks --------------------------------------------------