initail commit

1 files changed, 223 insertions, 0 deletions

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."))))))))