~mdw
/
zone
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
zone: Use new with-parsed-body macro.
[zone]
/
zone.lisp
diff --git
a/zone.lisp
b/zone.lisp
index
35e6f80
..
5755d11
100644
(file)
--- a/
zone.lisp
+++ b/
zone.lisp
@@
-144,8
+144,18
@@
;;;--------------------------------------------------------------------------
;;; Zone defaults. It is intended that scripts override these.
;;;--------------------------------------------------------------------------
;;; Zone defaults. It is intended that scripts override these.
+#+ecl
+(cffi:defcfun gethostname :int
+ (name :pointer)
+ (len :uint))
+
(defvar *default-zone-source*
(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.")
(and hn (concatenate 'string (canonify-hostname hn) ".")))
"The default zone source: the current host's name.")
@@
-503,7
+513,7
@@
(setf types (listify types))
(let* ((type (car types))
(func (intern (format nil "ZONE-PARSE/~:@(~A~)" type))))
(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)
(with-gensyms (col tname ttype tttl tdata tdefsubp i)
`(progn
(dolist (,i ',types)
@@
-754,8
+764,8
@@
;;; Zone file `~(~A~)'
;;; (generated ~A)
;;; 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))
(zone-name zone)
(iso-date :now :datep t :timep t)
(zone-default-ttl zone))