diff options
Diffstat (limited to 'lisp/entity/dns-record.lisp')
| -rw-r--r-- | lisp/entity/dns-record.lisp | 168 |
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))) |