From 8be7c5d959951dfafaf3fcaebe860a64ee3d8f7f Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Sun, 28 Nov 2021 16:55:46 -0700 Subject: initail commit --- lisp/service/dns-service.lisp | 223 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 223 insertions(+) create mode 100644 lisp/service/dns-service.lisp (limited to 'lisp/service/dns-service.lisp') diff --git a/lisp/service/dns-service.lisp b/lisp/service/dns-service.lisp new file mode 100644 index 0000000..5783574 --- /dev/null +++ b/lisp/service/dns-service.lisp @@ -0,0 +1,223 @@ +;;; -*- 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.")))))))) -- cgit v1.3