zone, net, frontend: Kill trailing whitespaces.
[zone] / zone.lisp
index 35e6f80..7e6da2b 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
 ;;; 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.
 ;;;--------------------------------------------------------------------------
 ;;; Zone defaults.  It is intended that scripts override these.
 
+#+ecl
+(cffi:defcfun gethostname :int
+  (name :pointer)
+  (len :uint))
+
 (defvar *default-zone-source*
-  (let ((hn (unix:unix-gethostname)))
+  (let ((hn #+cmu (unix:unix-gethostname)
+           #+clisp (unix:get-host-name)
+           #+ecl (cffi:with-foreign-pointer-as-string (buffer 256 len)
+                   (let ((rc (gethostname buffer len)))
+                     (unless (zerop rc)
+                       (error "gethostname(2) failed (rc = ~A)." rc))))))
     (and hn (concatenate 'string (canonify-hostname hn) ".")))
   "The default zone source: the current host's name.")
 
        (unless (ipnet-subnetp net tnet)
          (error "~A is not a subnet of ~A."
                 (ipnet-pretty tnet)
-                (ipnet-pretty net)))            
+                (ipnet-pretty net)))
        (unless tdom
          (setf tdom
                (join-strings #\.
                      :ttl ttl
                      :data (join-strings #\. (list tail tdom)))
                     list)))))))
-                                                 
+
 ;;;--------------------------------------------------------------------------
 ;;; Zone form parsing.
 
    NAME                The name of the record to be added.
 
    DATA                The content of the record to be added (a single object,
-               unevaluated). 
+               unevaluated).
 
    LIST                A function to add a record to the zone.  See below.
 
   (setf types (listify types))
   (let* ((type (car types))
         (func (intern (format nil "ZONE-PARSE/~:@(~A~)" type))))
-    (multiple-value-bind (doc decls body) (parse-body body)
+    (with-parsed-body (body decls doc) body
       (with-gensyms (col tname ttype tttl tdata tdefsubp i)
        `(progn
           (dolist (,i ',types)
                            (zr-defsubp zr)))))
          (zone-process-records records
                                (zone-default-ttl zone)
-                               #'parse-record ))
+                               #'parse-record))
       (setf (zone-records zone) (nconc (zone-records zone) rec)))))
 
 (defun zone-parse (zf)
       (rec :name (zone-parse-host "broadcast" name)
           :type :a
           :data (ipnet-broadcast n)))))
-  
+
 (defzoneparse (:rev :reverse) (name data rec)
   ":reverse ((NET :bytes BYTES) ZONE*)"
   (setf data (listify data))
        (unless (ipnet-subnetp net tnet)
          (error "~A is not a subnet of ~A."
                 (ipnet-pretty tnet)
-                (ipnet-pretty net)))            
+                (ipnet-pretty net)))
        (unless tdom
          (with-ipnet (net mask) tnet
            (setf tdom
 ;;; Zone file `~(~A~)'
 ;;;   (generated ~A)
 
-$ORIGIN ~@0*~(~A.~)
-$TTL ~@2*~D~2%"
+$ORIGIN ~0@*~(~A.~)
+$TTL ~2@*~D~2%"
            (zone-name zone)
            (iso-date :now :datep t :timep t)
            (zone-default-ttl zone))