zone-run: Add simple script for running `zone' without a vast image.

[zone] / net.lisp

diff --git a/net.lisp b/net.lisp
index d245e91186525abea7f8a817d92957e5dae5686c..13f390c03132b6a1e16ea40268b4b5b0bd0b3159 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -269,8 +269,10 @@ (defgeneric ipaddr-string (ip)
   (:documentation "Transform the address IP into a numeric textual form."))
 
 (defmethod print-object ((addr ipaddr) stream)
   (:documentation "Transform the address IP into a numeric textual form."))
 
 (defmethod print-object ((addr ipaddr) stream)

-  (print-unreadable-object (addr stream :type t)
-    (write-string (ipaddr-string addr) stream)))
+  (if *print-escape*
+      (print-unreadable-object (addr stream :type t)
+       (write-string (ipaddr-string addr) stream))
+      (write-string (ipaddr-string addr) stream)))

 
 (export 'ipaddrp)
 (defun ipaddrp (ip)
 
 (export 'ipaddrp)
 (defun ipaddrp (ip)


@@ -299,8 +301,8 @@ (defun integer-netmask (n i)
   "Given an integer I, return an N-bit netmask with its I top bits set."
   (- (ash 1 n) (ash 1 (- n i))))
 
   "Given an integer I, return an N-bit netmask with its I top bits set."
   (- (ash 1 n) (ash 1 (- n i))))
 

-(export 'ipmask-cidl-slash)
-(defun ipmask-cidl-slash (width mask)
+(export 'ipmask-cidr-slash)
+(defun ipmask-cidr-slash (width mask)

   "Given a netmask MASK, try to compute a prefix length.
 
    Return an integer N such that (integer-netmask WIDTH N) = MASK, or nil if
   "Given a netmask MASK, try to compute a prefix length.
 
    Return an integer N such that (integer-netmask WIDTH N) = MASK, or nil if


@@ -384,12 +386,14 @@ (defun ipnet-string (ipn)
   (with-ipnet (net nil mask) ipn
     (format nil "~A/~A"
            (ipaddr-string net)
   (with-ipnet (net nil mask) ipn
     (format nil "~A/~A"
            (ipaddr-string net)

-           (or (ipmask-cidl-slash (ipnet-width ipn) mask)
+           (or (ipmask-cidr-slash (ipnet-width ipn) mask)

                (ipaddr-string (make-instance (class-of net) :addr mask))))))
 
 (defmethod print-object ((ipn ipnet) stream)
                (ipaddr-string (make-instance (class-of net) :addr mask))))))
 
 (defmethod print-object ((ipn ipnet) stream)

-  (print-unreadable-object (ipn stream :type t)
-    (write-string (ipnet-string ipn) stream)))
+  (if *print-escape*
+      (print-unreadable-object (ipn stream :type t)
+       (write-string (ipnet-string ipn) stream))
+      (write-string (ipnet-string ipn) stream)))

 
 (defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t))
   "Parse a subnet description from (a substring of) STR.
 
 (defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t))
   "Parse a subnet description from (a substring of) STR.


@@ -480,7 +484,7 @@ (defun parse-subipnet (ipn str &key (start 0) (end nil) (slashp t))
   (let* ((addr-class (extract-class-name (ipnet-net ipn)))
         (width (ipaddr-width addr-class))
         (max (- width
   (let* ((addr-class (extract-class-name (ipnet-net ipn)))
         (width (ipaddr-width addr-class))
         (max (- width

-                (or (ipmask-cidl-slash width (ipnet-mask ipn))
+                (or (ipmask-cidr-slash width (ipnet-mask ipn))

                     (error "Base network has complex netmask")))))
     (multiple-value-bind (addr mask)
        (parse-subnet addr-class width max (stringify str)
                     (error "Base network has complex netmask")))))
     (multiple-value-bind (addr mask)
        (parse-subnet addr-class width max (stringify str)


@@ -1162,7 +1166,9 @@ (defun net-parse-to-ipnets (form &optional (family t))
                                 (cons ipn ipns)))
                           ipns
                           :initial-value nil)))
                                 (cons ipn ipns)))
                           ipns
                           :initial-value nil)))

-      (or merged (error "No matching addresses.")))))
+      (or merged
+         (error "No addresses match ~S~:[ in family ~S~;~*~]."
+                form (eq family t) family)))))

 
 (export 'net-host)
 (defun net-host (net-form host &optional (family t))
 
 (export 'net-host)
 (defun net-host (net-form host &optional (family t))


@@ -1279,7 +1285,8 @@ (defun host-parse (addr &optional (family t))
                                                   :initial-value nil))
                     (car list))))
       (unless (host-addrs host)
                                                   :initial-value nil))
                     (car list))))
       (unless (host-addrs host)

-       (error "No matching addresses."))
+       (error "No addresses match ~S~:[ in family ~S~;~*~]."
+              addr (eq family t) family))

       host)))
 
 (export 'host-create)
       host)))
 
 (export 'host-create)