;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- (declaim (optimize (speed 0) (safety 3) (debug 3))) (in-package #:dns-admin) (defclass dns-service (rest-service) ((title :initarg :title :initform nil :accessor title) (form :initarg :form :initform nil :accessor form)) (:documentation "")) (defclass dns-search-service (dns-service) ((location-p :initarg :location-p :initform nil :accessor location-p) (form :initarg :form :initform nil :accessor form) (results :initarg :results :initform nil :accessor results)) (:documentation "")) (defclass dns-login-service (dns-search-service) () (:documentation "")) (defclass dns-headers-service (rest-service) ((location-p :initarg :location-p :initform nil :accessor location-p) (headers :initarg :headers :initform nil :accessor headers)) (:documentation "")) (defclass dns-add-service (dns-search-service) () (:documentation "")) (defclass dns-modify-service (dns-search-service) () (:documentation "")) (defclass dns-ttl-service (dns-search-service) () (:documentation "")) (defun make-dns-form (form-name action button-label &key required-p recordtype ref name ipv4addr ipv6addr canonical ptrdname) (make-form form-name nil required-p `((:name "ref" :label "Ref" :field-type ,(if required-p "hidden" "text") ,@(when (sanitize-dns-filter-param ref) `(:value ,ref)) ,@(when required-p '(:required "required"))) (:name "name" :label ,(format nil "Name~a" (if required-p " *" "")) :field-type "text" ,@(when (sanitize-dns-filter-param name) `(:value ,name)) ,@(when required-p '(:required "required"))) ,@(cond ((string= recordtype "a") `((:name "ipv4addr" :label ,(format nil "IPv4 Address~a" (if required-p " *" "")) :field-type "text" ,@(when ipv4addr `(:value ,ipv4addr)) ,@(when required-p '(:required "required"))))) ((string= recordtype "aaaa") `((:name "ipv6addr" :label ,(format nil "IPv6 Address~a" (if required-p " *" "")) :field-type "text" ,@(when ipv6addr `(:value ,ipv6addr)) ,@(when required-p '(:required "required"))))) ((string= recordtype "cname") `((:name "canonical" :label ,(format nil "Canonical~a" (if required-p " *" "")) :field-type "text" ,@(when (sanitize-dns-filter-param canonical) `(:value ,canonical)) ,@(when required-p '(:required "required"))))) ((string= recordtype "ptr") `((:name "ptrdname" :label ,(format nil "PTR Dname~a" (if required-p " *" "")) :field-type "text" ,@(when (sanitize-dns-filter-param ptrdname) `(:value ,ptrdname)) ,@(when required-p '(:required "required"))) (:name "ipv4addr" :label ,(format nil "IPv4 Address~a" (if required-p " *" "")) :field-type "text" ,@(when ipv4addr `(:value ,ipv4addr)) ,@(when required-p '(:required "required")))))) (:label ,button-label :field-type "button" :onclick ,action)))) (defun make-ttl-form (form-name action button-label &key required-p ref) (make-form form-name nil required-p `((:name "ref" :label "Ref" :field-type ,(if required-p "hidden" "text") ,@(when (sanitize-dns-filter-param ref) `(:value ,ref)) ,@(when required-p '(:required "required"))) (:name "ttl" :label ,(format nil "TTL~a" (if required-p " *" "")) :field-type "text" ,@(when required-p '(:required "required"))) (:label ,button-label :field-type "button" :onclick ,action)))) (defun handle-dns () (with-service (instance dns-service) (setf (title instance) "Select Record Type") (setf (form instance) (make-form "dns-select-recordtype-form" nil nil '((:name "recordtype" :field-type "select" :required "required" :onchange "on_dns_select_recordtype_changed()" :options ((:label "A" :value "a") (:label "AAAA" :value "aaaa") (:label "CNAME" :value "cname") (:label "PTR" :value "ptr")))))))) (defun handle-dns-login-get () (with-service (instance dns-login-service) (setf (title instance) (cond ((string= (getf (dns *webapp*) :backend-type) "infoblox") "Provide Infoblox Credentials") ((string= (getf (dns *webapp*) :backend-type) "nsupdate") "Provide Path to nsupdate Keyfile"))) (setf (form instance) (make-form "dns-login-get-form" nil t (cond ((string= (getf (dns *webapp*) :backend-type) "infoblox") '((:name "username" :label "Username *" :field-type "text" :required "required") (:name "pwd" :label "Password *" :field-type "password" :required "required") (:label "Login" :field-type "button" :onclick "on_dns_login_get_clicked()"))) ((string= (getf (dns *webapp*) :backend-type) "nsupdate") '((:name "keypath" :label "Key Path *" :field-type "text" :required "required") (:label "Login" :field-type "button" :onclick "on_dns_login_get_clicked()")))))))) (defun handle-dns-login-post (username pwd keypath) (declare (special username pwd keypath)) (with-service (instance dns-search-service) (loop for param in (sb-introspect:function-lambda-list 'handle-dns-login-post) do (when (symbol-value param) (setf (session-value (intern (symbol-name param) :keyword)) (symbol-value param)))) (setf (message instance) "Credentials accepted."))) (defun handle-dns-headers (recordtype) (with-service (instance dns-headers-service) (with-dns (dns) (let ((dns-record (make-dns-record dns recordtype))) (setf (headers instance) (mapcar (lambda (slot) (slot-to-param dns-record slot)) (map-slot-names dns-record))))))) (defun handle-dns-api-search-get (recordtype) (with-service (instance dns-search-service) (setf (title instance) (format nil "Filter ~a Records" (string-upcase recordtype))) (setf (form instance) (make-dns-form "dns-api-search-get-form" "on_dns_api_search_get_clicked()" "Search" :recordtype recordtype)))) (defun handle-dns-api-search-post (recordtype ref name ipv4addr ipv6addr canonical ptrdname) (with-service (instance dns-search-service) (with-dns (dns) (let ((results (get-dns-records dns recordtype ref name ipv4addr ipv6addr canonical ptrdname))) (cond ((eq results 'unauth-error) (setf (authmsg instance) "Authentication failed")) ((not (listp results)) (setf (errormsg instance) results)) (t (setf (results instance) results))))))) (defun handle-dns-api-add-get (recordtype) (with-service (instance dns-add-service) (setf (title instance) (format nil "DNS - Add a(n) ~a Record" (string-upcase recordtype))) (setf (form instance) (make-dns-form "dns-api-add-get-form" "on_dns_api_add_get_clicked()" "Add" :required-p t :recordtype recordtype)))) (defun handle-dns-api-add-post (recordtype name ipv4addr ipv6addr canonical ptrdname) (declare (special recordtype name ipv4addr ipv6addr canonical ptrdname)) (with-service (instance dns-add-service) (with-dns (dns) (let ((dns-record (make-dns-record dns recordtype))) (loop for param in (intersect-dns-record-function-args dns-record 'handle-dns-api-add-post) do (setf (slot-value dns-record (param-to-slot dns-record param)) (sanitize-dns-filter-param (symbol-value param)))) (let ((results (add-dns-record dns dns-record))) (if results (setf (message instance) (format nil "Record added successfully. _ref: ~a" results)) (setf (errormsg instance) (format nil "Error while adding record.")))))))) (defun handle-dns-api-modify-get (recordtype ref name ipv4addr ipv6addr canonical ptrdname) (with-service (instance dns-add-service) (setf (title instance) (format nil "DNS - Modify a(n) ~a Record" (string-upcase recordtype))) (setf (form instance) (make-dns-form "dns-api-modify-get-form" "on_dns_api_modify_get_clicked()" "Modify" :required-p t :recordtype recordtype :ref ref :name name :ipv4addr ipv4addr :ipv6addr ipv6addr :canonical canonical :ptrdname ptrdname)))) (defun handle-dns-api-modify-post (recordtype ref name ipv4addr ipv6addr canonical ptrdname) (declare (special recordtype ref name ipv4addr ipv6addr canonical ptrdname)) (with-service (instance dns-modify-service) (with-dns (dns) (let ((dns-record (make-dns-record dns recordtype))) (loop for param in (intersect-dns-record-function-args dns-record 'handle-dns-api-modify-post) do (setf (slot-value dns-record (param-to-slot dns-record param)) (sanitize-dns-filter-param (symbol-value param)))) (let ((results (modify-dns-record dns dns-record))) (if results (setf (message instance) (format nil "Record modified successfully. _ref: ~a" results)) (setf (errormsg instance) (format nil "Error while modifying record.")))))))) (defun handle-dns-api-delete-post (recordtype ref) (declare (special recordtype ref)) (with-service (instance dns-add-service) (with-dns (dns) (let ((dns-record (make-dns-record dns recordtype))) (loop for param in (intersect-dns-record-function-args dns-record 'handle-dns-api-delete-post) do (setf (slot-value dns-record (param-to-slot dns-record param)) (sanitize-dns-filter-param (symbol-value param)))) (let ((results (delete-dns-record dns dns-record))) (if results (setf (message instance) "Record deleted successfully.") (setf (errormsg instance) (format nil "Error while deleting record.")))))))) (defun handle-dns-api-ttl-get (recordtype ref name) (with-service (instance dns-ttl-service) (setf (title instance) (format nil "DNS - Set the TTL on ~a" name)) (setf (form instance) (make-ttl-form "dns-api-ttl-get-form" "on_dns_api_ttl_get_clicked()" "Modify TTL" :required-p t :ref ref)))) (defun handle-dns-api-ttl-post (recordtype ref ttl) (declare (special recordtype ref ttl)) (with-service (instance dns-ttl-service) (with-dns (dns) (let ((dns-record (make-dns-record dns recordtype))) (loop for param in (intersect-dns-record-function-args dns-record 'handle-dns-api-ttl-post) do (setf (slot-value dns-record (param-to-slot dns-record param)) (sanitize-dns-filter-param (symbol-value param)))) (let ((results (modify-dns-record-ttl dns dns-record))) (if results (setf (message instance) "Record modified successfully.") (setf (errormsg instance) (format nil "Error while TTLing record."))))))))