initail commit

1 files changed, 168 insertions, 0 deletions

diff --git a/lisp/entity/dns-record.lisp b/lisp/entity/dns-record.lisp
new file mode 100644
index 0000000..7fa2f4a
--- /dev/null
+++ b/lisp/entity/dns-record.lisp
@@ -0,0 +1,168 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:dns-admin)
+
+(defclass dns-record (entity)
+  ((*recordtype :initarg :*recordtype
+                :initform nil
+                :accessor *recordtype)
+   (name :initarg :name
+         :initform nil
+         :accessor name))
+  (:documentation "Base class for DNS records."))
+
+(defclass dns-record-infoblox (dns-record)
+  ((--ref :initarg :--ref
+          :initform nil
+          :accessor --ref)
+   (ttl :initarg :ttl
+        :initform nil
+        :accessor ttl))
+  (:documentation "Base class for DNS records of type infoblox."))
+
+(defclass dns-record-infoblox-a (dns-record-infoblox)
+  ((ipv-4-addr :initarg :ipv-4-addr
+               :initform nil
+               :accessor ipv-4-addr))
+  (:documentation "DNS A record of type infoblox."))
+
+(defclass dns-record-infoblox-aaaa (dns-record-infoblox)
+  ((ipv-6-addr :initarg :ipv-6-addr
+               :initform nil
+               :accessor ipv-6-addr))
+  (:documentation "DNS AAAA record of type infoblox."))
+
+(defclass dns-record-infoblox-cname (dns-record-infoblox)
+  ((canonical :initarg :canonical
+              :initform nil
+              :accessor canonical))
+  (:documentation "DNS CNAME record of type infoblox."))
+
+(defclass dns-record-infoblox-ptr (dns-record-infoblox)
+  ((ptrdname :initarg :ptrdname
+             :initform nil
+             :accessor ptrdname)
+   (ipv-4-addr :initarg :ipv-4-addr
+               :initform nil
+               :accessor ipv-4-addr))
+  (:documentation "DNS PTR record of type infoblox."))
+
+(defun sanitize-dns-filter-param (param)
+  (cond ((intersection `(,param) '("" "null" "undefined") :test 'string=) nil)
+        (t param)))
+
+(defmethod slot-to-param ((dns-record dns-record-infoblox) slot)
+  (cond ((eq slot '*recordtype) 'recordtype)
+        ((eq slot '--ref) 'ref)
+        ((eq slot 'ipv-4-addr) 'ipv4addr)
+        ((eq slot 'ipv-6-addr) 'ipv6addr)
+        (t slot)))
+
+(defmethod param-to-slot ((dns-record dns-record-infoblox) param)
+  (cond ((eq param 'recordtype) '*recordtype)
+        ((eq param 'ref) '--ref)
+        ((eq param 'ipv4addr) 'ipv-4-addr)
+        ((eq param 'ipv6addr) 'ipv-6-addr)
+        (t param)))
+
+(defmethod make-dns-record ((dns dns) recordtype)
+  (let* ((package (package-name #.*package*))
+         (dns-record-class (intern (string-upcase (format nil "dns-record-~a-~a" (backend-type dns) recordtype)) (find-package package))))
+    (make-instance dns-record-class :*recordtype recordtype)))
+
+(defmethod intersect-dns-record-function-args ((dns-record dns-record) func-symbol)
+  (intersection (sb-introspect:function-lambda-list func-symbol)
+                (mapcar (lambda (slot)
+                          (slot-to-param dns-record slot))
+                        (map-slot-names dns-record))))
+
+(defmethod search-filter-satisfied-p ((dns-record dns-record) rec)
+  (not (position nil (mapcar (lambda (slot)
+                               (let ((slot-has-value-p (and (slot-value dns-record slot))))
+                                 (or (not slot-has-value-p)
+                                     (and slot-has-value-p
+                                          (match-it (slot-value dns-record slot) (slot-value rec slot))))))
+                             (remove-if 'null (mapcar (lambda (s)
+                                                        (when (slot-is-field-p s) s))
+                                                      (map-slot-names dns-record)))))))
+  
+(defmacro define-dns-impl ((method-name action) &body macro-body)
+  ;; dig @127.0.0.1 +dnssec ckons.org AXFR
+  (let ((endpoint (gensym)))
+    `(progn
+       (defgeneric ,method-name (dns dns-record-infoblox))
+       (defmethod ,method-name ((dns dns) (dns-record dns-record-infoblox))
+         (let ((,endpoint (format nil
+                                  "~a/~a?_return_as_object=1~a"
+                                  (url dns)
+                                  (if (intersection `(,,action) '(:get :post))
+                                      (format nil "record:~a" (*recordtype dns-record))
+                                      (--ref dns-record))
+                                  (if (and (eq (type-of dns-record) 'dns-record-infoblox-ptr)
+                                           (not (eq ,action :delete)))
+                                      "&_return_fields=name,ptrdname,ipv4addr,ipv6addr"
+                                      "")))
+               (parameters (if (slot-value dns-record 'ttl)
+                               `(("use_ttl" . t) ("ttl" . ,(ttl dns-record)))
+                               (remove-if 'null (mapcar (lambda (slot)
+                                                          (when (and (not (eq ,action :get))
+                                                                     (not (eq slot '--ref))
+                                                                     (slot-is-field-p slot)
+                                                                     (slot-value dns-record slot))
+                                                            `(,(string-downcase (symbol-name (slot-to-param dns-record slot))) . ,(slot-value dns-record slot))))
+                                                        (map-slot-names dns-record))))))
+           (when (not (eq ,action :get))
+             (setf parameters (alist-to-json parameters)))
+           (multiple-value-bind (body status-code headers uri stream must-close reason)
+               (apply #'drakma-request `(,,endpoint
+                                         nil
+                                         :method ,,action
+                                         ,@(when (not (eq ,action :get)) `(:content-type "application/json"))
+                                         ,@(if (eq ,action :get)
+                                               `(:parameters ,parameters)
+                                               `(:content ,parameters))
+                                         :basic-authorization (,(session-value :username) ,(session-value :pwd))))
+             (declare (ignore headers uri stream must-close reason))
+             (cond ((or (= status-code 401) (= status-code 403))
+                    (hunchentoot:require-authorization (name *webapp*)))
+                   ((< status-code 300)
+                    ,@macro-body)
+                   (t
+                    (format nil "Error response from infoblox.~%Method = [~a]~%Endpoint = [~a]~%Parameters = [~a]~%Response = [~a]" ',method-name ,endpoint parameters (flexi-streams:octets-to-string body :external-format :utf-8))))))))))
+
+(defmethod get-dns-records ((dns dns) recordtype ref name ipv4addr ipv6addr canonical ptrdname)
+  (declare (special recordtype ref name ipv4addr ipv6addr canonical ptrdname))
+  (let ((dns-record (make-dns-record dns recordtype)))
+    (loop for param in (intersect-dns-record-function-args dns-record 'get-dns-records) do  
+       (setf (slot-value dns-record (param-to-slot dns-record param)) (sanitize-dns-filter-param (symbol-value param))))
+    (get-dns-records-impl dns dns-record)))
+
+(define-dns-impl (get-dns-records-impl :get)
+  (remove-if 'null (mapcar (lambda (rec)
+                             (when (search-filter-satisfied-p dns-record rec) rec))
+                           (json-to-object (type-of dns-record) (cdar (json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))))))
+
+(defmethod add-dns-record ((dns dns) (dns-record dns-record))
+  (add-dns-record-impl dns dns-record))
+
+(define-dns-impl (add-dns-record-impl :post)
+  (json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
+
+(defmethod modify-dns-record ((dns dns) (dns-record dns-record))
+  (modify-dns-record-impl dns dns-record))
+
+(define-dns-impl (modify-dns-record-impl :put)
+  (json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
+
+(defmethod modify-dns-record-ttl ((dns dns) (dns-record dns-record))
+  (modify-dns-record-ttl-impl dns dns-record))
+
+(define-dns-impl (modify-dns-record-ttl-impl :put)
+  (json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
+
+(defmethod delete-dns-record ((dns dns) (dns-record dns-record))
+  (delete-dns-record-impl dns dns-record))
+
+(define-dns-impl (delete-dns-record-impl :delete)
+  (json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))