X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/f4decf40ece4ec98a4a6531a28f9fec84f99a0ca..716105aa3a725242d5fac82bab8db82e0bb46995:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 611a6ac..2e108ba 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -27,7 +27,9 @@
 ;;; Packaging.
 
 (defpackage #:zone
-  (:use #:common-lisp #:mdw.base #:mdw.str #:collect #:safely #:net)
+  (:use #:common-lisp
+	#:mdw.base #:mdw.str #:collect #:safely
+	#:net #:services)
   (:export #:soa #:mx #:zone #:zone-record #:zone-subdomain
 	   #:*default-zone-source* #:*default-zone-refresh*
 	     #:*default-zone-retry* #:*default-zone-expire*
@@ -612,6 +614,31 @@ (defzoneparse :alias (name data rec :zname zname)
 	 :type :cname
 	 :data name)))
 
+(defzoneparse :srv (name data rec :zname zname)
+  ":srv (((SERVICE &key :port) (PROVIDER &key :port :prio :weight :ip)*)*)"
+  (dolist (srv data)
+    (destructuring-bind (servopts &rest providers) srv
+      (destructuring-bind
+	  (service &key ((:port default-port)) (protocol :tcp))
+	  (listify servopts)
+	(unless default-port
+	  (let ((serv (serv-by-name service protocol)))
+	    (setf default-port (and serv (serv-port serv)))))
+	(let ((rname (format nil "~(_~A._~A~).~A" service protocol name)))
+	  (dolist (prov providers)
+	    (destructuring-bind
+		(srvname
+		 &key
+		 (port default-port)
+		 (prio *default-mx-priority*)
+		 (weight 0)
+		 ip)
+		(listify prov)
+	      (let ((host (zone-parse-host srvname zname)))
+		(when ip (rec :name host :type :a :data (parse-ipaddr ip)))
+		(rec :name rname
+		     :data (list prio weight port host))))))))))
+
 (defzoneparse :net (name data rec)
   ":net (NETWORK*)"
   (dolist (net (listify data))
@@ -810,6 +837,9 @@ (defgeneric bind-record-format-args (type data)
   (:method ((type (eql :ns)) data) (list "~A" (bind-hostname data)))
   (:method ((type (eql :mx)) data)
     (list "~2D ~A" (cdr data) (bind-hostname (car data))))
+  (:method ((type (eql :srv)) data)
+    (destructuring-bind (prio weight port host) data
+      (list "~2D ~5D ~5D ~A" prio weight port (bind-hostname host))))
   (:method ((type (eql :txt)) data) (list "~S" (stringify data))))
 
 ;;;----- That's all, folks --------------------------------------------------