;;; -*- 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)))