;;; -*-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))
  (make-domain-name :labels (list "arpa" "in-addr") :absolutep t))

;;;----- That's all, folks --------------------------------------------------