summaryrefslogtreecommitdiff
path: root/lisp/webapps/dns-admin
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/webapps/dns-admin')
-rw-r--r--lisp/webapps/dns-admin/clojurescript/dnsadmin/.gitignore14
-rw-r--r--lisp/webapps/dns-admin/clojurescript/dnsadmin/README.md14
-rw-r--r--lisp/webapps/dns-admin/clojurescript/dnsadmin/project.clj11
-rw-r--r--lisp/webapps/dns-admin/clojurescript/dnsadmin/src/core.cljs673
-rw-r--r--lisp/webapps/dns-admin/conf/options.lisp7
-rw-r--r--lisp/webapps/dns-admin/conf/options.lisp.example7
-rw-r--r--lisp/webapps/dns-admin/site.lisp103
-rw-r--r--lisp/webapps/dns-admin/static/images/add.pngbin0 -> 1832 bytes
-rw-r--r--lisp/webapps/dns-admin/static/images/clock.pngbin0 -> 1723 bytes
-rw-r--r--lisp/webapps/dns-admin/static/images/delete.pngbin0 -> 1121 bytes
-rw-r--r--lisp/webapps/dns-admin/static/images/edit.pngbin0 -> 1034 bytes
l---------lisp/webapps/dns-admin/static/js/cljs1
12 files changed, 830 insertions, 0 deletions
diff --git a/lisp/webapps/dns-admin/clojurescript/dnsadmin/.gitignore b/lisp/webapps/dns-admin/clojurescript/dnsadmin/.gitignore
new file mode 100644
index 0000000..c754477
--- /dev/null
+++ b/lisp/webapps/dns-admin/clojurescript/dnsadmin/.gitignore
@@ -0,0 +1,14 @@
+target
+classes
+resources
+checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+.lein-*
+.nrepl-port
+.hgignore
+.hg
+profiles.clj
+figwheel_server.log
diff --git a/lisp/webapps/dns-admin/clojurescript/dnsadmin/README.md b/lisp/webapps/dns-admin/clojurescript/dnsadmin/README.md
new file mode 100644
index 0000000..549a339
--- /dev/null
+++ b/lisp/webapps/dns-admin/clojurescript/dnsadmin/README.md
@@ -0,0 +1,14 @@
+# dns-admin
+
+A Clojure library designed to ... well, that part is up to you.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2017 FIXME
+
+Distributed under the Eclipse Public License either version 1.0 or (at
+your option) any later version.
diff --git a/lisp/webapps/dns-admin/clojurescript/dnsadmin/project.clj b/lisp/webapps/dns-admin/clojurescript/dnsadmin/project.clj
new file mode 100644
index 0000000..79940e3
--- /dev/null
+++ b/lisp/webapps/dns-admin/clojurescript/dnsadmin/project.clj
@@ -0,0 +1,11 @@
+(defproject dnsadmin "0.1.0-SNAPSHOT"
+ :description "FIXME"
+ :url "FIXME"
+ :license "public domain"
+ :dependencies [[org.clojure/clojure "LATEST"]
+ [org.clojure/clojurescript "LATEST"]
+ [cljs-ajax "LATEST"]
+ [prismatic/dommy "LATEST"]
+ [hiccups "LATEST"]]
+ :plugins [[lein-cljsbuild "LATEST"]]
+ :clean-targets ^{:protect false} [:target-path "out" "resources/public/cljs"])
diff --git a/lisp/webapps/dns-admin/clojurescript/dnsadmin/src/core.cljs b/lisp/webapps/dns-admin/clojurescript/dnsadmin/src/core.cljs
new file mode 100644
index 0000000..8b760de
--- /dev/null
+++ b/lisp/webapps/dns-admin/clojurescript/dnsadmin/src/core.cljs
@@ -0,0 +1,673 @@
+(ns dnsadmin.core
+ (:require-macros [hiccups.core :as hiccups :refer [html]])
+ (:require [ajax.core :refer [GET POST]]
+ [dommy.core :as dommy]
+ [hiccups.runtime :as hiccupsrt]))
+
+;; declarations
+
+(enable-console-print!)
+
+(declare null-or-empty-p)
+(declare reduce-checkboxes)
+(declare template-message)
+(declare maybe-errormsg)
+(declare maybe-message)
+(declare notifications)
+(declare auth-notifications)
+(declare template-generic-form)
+(declare template-dns)
+(declare handler-dns)
+(declare render-dns)
+(declare navigate-to)
+(declare handler-location)
+(declare goto-location)
+(declare reset-app)
+(declare template-dns-login-get)
+(declare handler-dns-login-get)
+(declare render-dns-login-get)
+(declare on-dns-login-get-clicked)
+(declare handler-dns-login-post)
+(declare render-dns-login-post)
+(declare template-dns-headers)
+(declare handler-dns-headers)
+(declare render-dns-headers)
+(declare on-dns-select-recordtype-changed)
+(declare template-dns-api-search-get)
+(declare handler-dns-api-search-get)
+(declare render-dns-api-search-get)
+(declare on-dns-api-search-get-clicked)
+(declare template-dns-api-search-post-loading)
+(declare template-dns-api-search-post)
+(declare handler-dns-api-search-post)
+(declare render-dns-api-search-post)
+(declare on-dns-api-add-clicked)
+(declare template-dns-api-add-get)
+(declare handler-dns-api-add-get)
+(declare render-dns-api-add-get)
+(declare on-dns-add-get-clicked)
+(declare handler-dns-api-add-post)
+(declare render-dns-api-add-post)
+(declare on-dns-modify-api-clicked)
+(declare template-dns-api-modify-get)
+(declare handler-dns-api-modify-get)
+(declare render-dns-api-modify-get)
+(declare on-dns-api-modify-post-clicked)
+(declare handler-dns-api-modify-post)
+(declare render-dns-api-modify-post)
+(declare on-dns-api-delete-clicked)
+(declare handler-dns-api-delete-post)
+(declare render-dns-api-delete-post)
+(declare on-dns-api-ttl-clicked)
+(declare template-dns-api-ttl-get)
+(declare handler-dns-api-ttl-get)
+(declare render-dns-api-ttl-get)
+(declare on-dns-api-ttl-post-clicked)
+(declare handler-dns-api-ttl-post)
+(declare render-dns-api-ttl-post)
+
+(def jquery (js* "$"))
+
+(defn null-or-empty-p [arg]
+ (or (not arg)
+ (= arg "")))
+
+(defn reduce-checkboxes [selector]
+ "Reduces the names of all checked checkboxes to a pipe-separated
+ list. Assumes that the checkboxes are named via the convention
+ `chk_something-more'. The important thing is the underscore
+ separating the throwaway prefix and the remaining useful
+ bit. `selector' will likely be something like: [id^='chk_']"
+ (reduce (fn [x y]
+ (cond (and x y) (str x "|" y)
+ (and x (not y)) x
+ (and (not x) y) y
+ :else ""))
+ (map (fn [elem]
+ (let [this (jquery (str "#" (dommy/attr elem :id)))]
+ (when (-> this (.prop "checked"))
+ (second (clojure.string/split (-> this (.prop "id")) "_")))))
+ (.toArray (jquery selector)))))
+
+;; notifications
+
+(hiccups/defhtml template-authmsg [authmsg]
+ [:div {:class "alert alert-danger"} authmsg])
+
+(hiccups/defhtml template-errormsg [errormsg]
+ [:div {:class "alert alert-danger"} errormsg])
+
+(hiccups/defhtml template-message [message]
+ [:div {:class "alert alert-success"} message])
+
+(defn maybe-authmsg [jsonobj]
+ (let [authmsg (get jsonobj "authmsg")]
+ (cond (null-or-empty-p authmsg)
+ (do
+ (dommy/set-style! (dommy/sel1 :#authmsg) :display "none")
+ (dommy/set-html! (dommy/sel1 :#authmsg) "")
+ true)
+ :else
+ (do
+ (dommy/set-style! (dommy/sel1 :#authmsg) :display "block")
+ (dommy/set-html! (dommy/sel1 :#authmsg)
+ (template-authmsg authmsg))
+ false))))
+
+(defn maybe-errormsg [jsonobj]
+ (let [errormsg (get jsonobj "errormsg")]
+ (cond (null-or-empty-p errormsg)
+ (do
+ (dommy/set-style! (dommy/sel1 :#errormsg) :display "none")
+ (dommy/set-html! (dommy/sel1 :#errormsg) "")
+ true)
+ :else
+ (do
+ (dommy/set-style! (dommy/sel1 :#errormsg) :display "block")
+ (dommy/set-html! (dommy/sel1 :#errormsg)
+ (template-errormsg errormsg))
+ false))))
+
+(defn maybe-message [jsonobj]
+ (let [message (get jsonobj "message")]
+ (cond (null-or-empty-p message)
+ (do
+ (dommy/set-style! (dommy/sel1 :#message) :display "none")
+ (dommy/set-html! (dommy/sel1 :#message) ""))
+ :else
+ (do
+ (dommy/set-style! (dommy/sel1 :#message) :display "block")
+ (dommy/set-html! (dommy/sel1 :#message)
+ (template-message message))))
+ true))
+
+(defn notifications [jsonobj]
+ (let [authmsg-result (maybe-authmsg jsonobj)
+ errormsg-result (maybe-errormsg jsonobj)
+ message-result (maybe-message jsonobj)]
+ (and authmsg-result errormsg-result message-result)))
+
+(defn auth-notifications [jsonobj]
+ (let [result (notifications jsonobj)]
+ (cond (get jsonobj "authmsg")
+ (render-dns-login-get))
+ result))
+
+;; forms
+
+(hiccups/defhtml template-generic-form [jsonobj]
+ [:div {:id "form-errormsg"}]
+ [:form {:name (get jsonobj "name")
+ :id (get jsonobj "name")
+ :method (get jsonobj "httpMethod")
+ :action (when (get jsonobj "action")
+ (str "javascript:" (namespace ::x) "." (get jsonobj "action")))}
+ (for [form-field (get jsonobj "formFields")]
+ (cond (= (get form-field "fieldType") "button")
+ [:div {:class "form-group row"}
+ [:div {:class "offset-sm-2 col-sm-10"}
+ [:button {:class "btn btn-primary"
+ :data-dismiss (get jsonobj "dismiss")
+ :type (cond (get form-field "onclick") "button" :else "submit")
+ :onclick (when (get form-field "onclick")
+ (str (namespace ::x) "." (get form-field "onclick")))}
+ (get form-field "label")]]]
+ (= (get form-field "fieldType") "hidden")
+ [:input {:name (get form-field "name")
+ :id (get form-field "name")
+ :value (get form-field "value")
+ :type (get form-field "fieldType")}]
+ (= (get form-field "fieldType") "checkbox")
+ [:div {:class "form-check"}
+ [:input {:type "checkbox"
+ :class "form-check-input"
+ :name (get form-field "name")
+ :id (get form-field "name")
+ :value (get form-field "value")
+ :checked (get form-field "checked")
+ :required (get form-field "required")}]
+ [:label {:class "form-check-label"
+ :for (get form-field "name")}
+ (get form-field "label")]]
+ (= (get form-field "fieldType") "radio")
+ [:div {:class "form-check"}
+ [:input {:type "radio"
+ :class "form-check-input"
+ :name (get form-field "name")
+ :id (get form-field "name")
+ :value (get form-field "value")
+ :checked (get form-field "checked")
+ :required (get form-field "required")}]
+ [:label {:class "form-check-label"
+ :for (get form-field "name")}
+ (get form-field "label")]]
+ (= (get form-field "fieldType") "select")
+ [:div {:class "form-group"}
+ [:label {:for (get form-field "name")}
+ (get form-field "label")]
+ [:select {:class "form-control"
+ :name (get form-field "name")
+ :id (get form-field "name")
+ :required (get form-field "required")
+ :onchange (when (get form-field "onchange")
+ (str (namespace ::x) "." (get form-field "onchange")))}
+ (for [option (get form-field "options")]
+ [:option {:value (get option "value")}
+ (get option "label")])]]
+ :else
+ [:div {:class "form-group row"}
+ [:label {:for (get form-field "name")
+ :class "col-form-label col-sm-2"
+ :style "text-align: right"}
+ (get form-field "label")]
+ [:div {:class "col-sm-10"}
+ [:input {:name (get form-field "name")
+ :id (get form-field "name")
+ :value (get form-field "value")
+ :type (get form-field "fieldType")
+ :class "form-control"
+ :required (get form-field "required")}]]]))]
+ (when (get jsonobj "requiredP")
+ [:div "* Required"]))
+
+;; dns
+
+(hiccups/defhtml template-dns [jsonobj]
+ [:div {:class "container-fluid"}
+ [:div {:class "row"}
+ [:div {:class "col-2"}
+ [:h4 (get jsonobj "title")]
+ (template-generic-form (get jsonobj "form"))
+ [:div {:id "search"}]]
+ [:div {:class "col"}
+ [:div {:style "text-align: right"}
+ [:button {:class "btn btn-primary"
+ :type "button"
+ :onclick (str (namespace ::x) ".on_dns_api_add_clicked()")}
+ "Add New Record"]]
+ [:div {:id "results"}]]]]
+ [:div {:id "add"
+ :class "modal fade"
+ :role "dialog"}
+ [:div {:class "modal-dialog modal-lg"}
+ [:div {:class "modal-content"}
+ [:div {:class "modal-header"}
+ [:h5 {:class "modal-title"} "DNS - Add"]
+ [:button {:type "button"
+ :class "close"
+ :data-dismiss "modal"}
+ "×"]]
+ [:div {:id "add-body"
+ :class "modal-body"
+ :style "height: 460px;"}]
+ [:div {:class "modal-footer"}
+ [:button {:type "submit"
+ :class "btn btn-danger btn-default"
+ :data-dismiss "modal"}
+ [:span {:class "glyphicon glyphicon-remove"}]
+ "Cancel"]]]]]
+ [:div {:id "modify"
+ :class "modal fade"
+ :role "dialog"}
+ [:div {:class "modal-dialog modal-lg"}
+ [:div {:class "modal-content"}
+ [:div {:class "modal-header"}
+ [:h5 {:class "modal-title"} "DNS - Modify"]
+ [:button {:type "button"
+ :class "close"
+ :data-dismiss "modal"}
+ "×"]]
+ [:div {:id "modify-body"
+ :class "modal-body"
+ :style "height: 460px;"}]
+ [:div {:class "modal-footer"}
+ [:button {:type "submit"
+ :class "btn btn-danger btn-default"
+ :data-dismiss "modal"}
+ [:span {:class "glyphicon glyphicon-remove"}]
+ "Cancel"]]]]]
+ [:div {:id "ttl"
+ :class "modal fade"
+ :role "dialog"}
+ [:div {:class "modal-dialog modal-lg"}
+ [:div {:class "modal-content"}
+ [:div {:class "modal-header"}
+ [:h5 {:class "modal-title"} "DNS - TTL"]
+ [:button {:type "button"
+ :class "close"
+ :data-dismiss "modal"}
+ "×"]]
+ [:div {:id "ttl-body"
+ :class "modal-body"
+ :style "height: 200px;"}]
+ [:div {:class "modal-footer"}
+ [:button {:type "submit"
+ :class "btn btn-danger btn-default"
+ :data-dismiss "modal"}
+ [:span {:class "glyphicon glyphicon-remove"}]
+ "Cancel"]]]]]
+ [:div {:id "login"
+ :class "modal fade"
+ :role "dialog"}
+ [:div {:class "modal-dialog modal-lg"}
+ [:div {:class "modal-content"}
+ [:div {:class "modal-header"}
+ [:h5 {:class "modal-title"} "DNS - Authentication"]
+ [:button {:type "button"
+ :class "close"
+ :data-dismiss "modal"}
+ "×"]]
+ [:div {:id "login-body"
+ :class "modal-body"
+ :style "height: 460px;"}]
+ [:div {:class "modal-footer"}
+ [:button {:type "submit"
+ :class "btn btn-danger btn-default"
+ :data-dismiss "modal"}
+ [:span {:class "glyphicon glyphicon-remove"}]
+ "Cancel"]]]]])
+
+(defn handler-dns [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#body) (template-dns jsonobj))
+ (render-dns-api-search-get)
+ (render-dns-headers))))
+
+(defn render-dns []
+ (GET "/dns" {:handler handler-dns}))
+
+;; location
+
+(defn navigate-to [handler]
+ (dommy/set-html! (dommy/sel1 :#location) handler)
+ (cond (= handler "/dns") (render-dns)))
+
+(defn handler-location [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (navigate-to (get jsonobj "location"))
+ (notifications jsonobj)))
+
+(defn goto-location [location]
+ (POST "/location" {:format :raw
+ :params {:location location}
+ :handler handler-location}))
+
+(defn reset-app []
+ (set! (.-location js/document) "/"))
+
+;; dns-login-get
+
+(hiccups/defhtml template-dns-login-get [jsonobj]
+ [:h5 (get jsonobj "title")]
+ (template-generic-form (get jsonobj "form")))
+
+(defn handler-dns-login-get [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (dommy/set-html! (dommy/sel1 :#login-body) (template-dns-login-get jsonobj))
+ (.modal (jquery "#login"))))
+
+(defn render-dns-login-get []
+ (GET "/dns/login" {:handler handler-dns-login-get}))
+
+(defn on-dns-login-get-clicked []
+ (when (-> (jquery "#dns-login-get-form")
+ (.get "0")
+ (.checkValidity))
+ (.modal (jquery "#login") "hide")
+ (apply render-dns-login-post
+ (map (fn [field]
+ (when (jquery (str "#dns-login-get-form input[id=" field "]"))
+ (.val (jquery (str "#dns-login-get-form input[id=" field "]")))))
+ ["username" "pwd" "keypath"]))))
+
+;; dns-login-post
+
+(defn handler-dns-login-post [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (render-dns-api-search-post))))
+
+(defn render-dns-login-post [username pwd keypath]
+ (POST "/dns/login/post" {:format :raw
+ :params {:username username
+ :pwd pwd
+ :keypath keypath}
+ :handler handler-dns-login-post}))
+
+;; dns-headers
+
+(hiccups/defhtml template-dns-headers [jsonobj]
+ [:table {:class "table table-hover"}
+ [:thead
+ [:tr
+ (for [header (remove (fn [x] (= x "ttl")) (get jsonobj "headers"))]
+ [:th header])
+ [:th "TTL"]
+ [:th "Del"]]]])
+
+(defn handler-dns-headers [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-headers jsonobj)))))
+
+(defn render-dns-headers []
+ (POST "/dns/headers" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))}
+ :handler handler-dns-headers}))
+
+;; dns-api-search-get
+
+(defn on-dns-select-recordtype-changed []
+ (render-dns-api-search-get)
+ (render-dns-headers))
+
+(hiccups/defhtml template-dns-api-search-get [jsonobj]
+ [:h4 (get jsonobj "title")]
+ (template-generic-form (get jsonobj "form")))
+
+(defn handler-dns-api-search-get [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#search) (template-dns-api-search-get jsonobj)))))
+
+(defn render-dns-api-search-get []
+ (POST "/dns/api/search" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))}
+ :handler handler-dns-api-search-get}))
+
+(defn on-dns-api-search-get-clicked []
+ (when (-> (jquery "#dns-api-search-get-form")
+ (.get "0")
+ (.checkValidity))
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-api-search-post-loading))
+ (render-dns-api-search-post)))
+
+;; dns-api-search-post
+
+(hiccups/defhtml template-dns-api-search-post-loading []
+ [:h5 "Loading..."])
+
+(hiccups/defhtml template-dns-api-search-post [jsonobj]
+ (let [results (get jsonobj "results")
+ keys (remove (fn [x] (or (= x "Recordtype") (= x "ttl"))) (keys (first results)))]
+ [:table {:class "table table-hover"}
+ [:thead
+ [:tr
+ (for [key keys]
+ [:th key])
+ [:th "TTL"]
+ [:th "Del"]]]
+ [:tbody
+ (for [rec results]
+ (let [onclick (str (namespace ::x) ".on_dns_api_modify_clicked('" (get rec "_ref") "','" (get rec "name") "','" (get rec "ipv4Addr") "','" (get rec "ipv6Addr") "','" (get rec "canonical") "','" (get rec "ptrdname") "')")]
+ [:tr
+ (for [key keys]
+ [:td {:onclick onclick} (get rec key)])
+ [:td [:img {:src "/static/images/clock.png"
+ :onclick (str (namespace ::x) ".on_dns_api_ttl_clicked('" (get rec "_ref") "','" (get rec "name") "')")}]]
+ [:td [:img {:src "/static/images/delete.png"
+ :onclick (str (namespace ::x) ".on_dns_api_delete_clicked('" (get rec "_ref") "','" (get rec "name") "')")}]]]))]]))
+
+(defn handler-dns-api-search-post [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-api-search-post jsonobj)))))
+
+(defn render-dns-api-search-post []
+ (let [fields ["ref" "name" "ipv4addr" "ipv6addr" "canonical" "ptrdname"]
+ params (merge {:recordtype (dommy/value (dommy/sel1 :#recordtype))}
+ (into {} (map vector
+ (map (fn [field]
+ (keyword field))
+ fields)
+ (map (fn [field]
+ (when (jquery (str "#dns-api-search-get-form input[id=" field "]"))
+ (let [val (.val (jquery (str "#dns-api-search-get-form input[id=" field "]")))]
+ (cond (null-or-empty-p val) nil
+ :else val))))
+ fields))))]
+ (POST "/dns/api/search/post" {:format :raw
+ :params params
+ :handler handler-dns-api-search-post})))
+
+;; dns-api-add-get
+
+(defn on-dns-api-add-clicked []
+ (render-dns-api-add-get))
+
+(hiccups/defhtml template-dns-api-add-get [jsonobj]
+ [:h5 (get jsonobj "title")]
+ (template-generic-form (get jsonobj "form")))
+
+(defn handler-dns-api-add-get [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#add-body) (template-dns-api-add-get jsonobj))
+ (.modal (jquery "#add")))))
+
+(defn render-dns-api-add-get []
+ (POST "/dns/api/add" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))}
+ :handler handler-dns-api-add-get}))
+
+(defn on-dns-api-add-get-clicked []
+ (when (-> (jquery "#dns-api-add-get-form")
+ (.get "0")
+ (.checkValidity))
+ (cond (and (= (dommy/value (dommy/sel1 :#recordtype)) "a")
+ (let [ipv4addr (when (jquery "#dns-api-add-get-form input[id=ipv4addr]")
+ (.val (jquery "#dns-api-add-get-form input[id=ipv4addr]")))
+ ipv6addr (when (jquery "#dns-api-add-get-form input[id=ipv6addr]")
+ (.val (jquery "#dns-api-add-get-form input[id=ipv6addr]")))]
+ (and (null-or-empty-p ipv4addr)
+ (null-or-empty-p ipv6addr))))
+ (js/alert "One or both of the following fields must be populated: IPv4 Address, IPv6 Address")
+ :else
+ (do
+ (.modal (jquery "#add") "hide")
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-api-search-post-loading))
+ (apply render-dns-api-add-post
+ (map (fn [field]
+ (when (jquery (str "#dns-api-add-get-form input[id=" field "]"))
+ (.val (jquery (str "#dns-api-add-get-form input[id=" field "]")))))
+ ["name" "ipv4addr" "ipv6addr" "canonical" "ptrdname"]))))))
+
+;; dns-api-add-post
+
+(defn handler-dns-api-add-post [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (render-dns-api-search-post))))
+
+(defn render-dns-api-add-post [name ipv4addr ipv6addr canonical ptrdname]
+ (POST "/dns/api/add/post" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))
+ :name name
+ :ipv4addr ipv4addr
+ :ipv6addr ipv6addr
+ :canonical canonical
+ :ptrdname ptrdname}
+ :handler handler-dns-api-add-post}))
+
+;; dns-api-modify-get
+
+(defn on-dns-api-modify-clicked [ref name ipv4addr ipv6addr canonical ptrdname]
+ (render-dns-api-modify-get ref name ipv4addr ipv6addr canonical ptrdname))
+
+(hiccups/defhtml template-dns-api-modify-get [jsonobj]
+ [:h5 (get jsonobj "title")]
+ (template-generic-form (get jsonobj "form")))
+
+(defn handler-dns-api-modify-get [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#modify-body) (template-dns-api-modify-get jsonobj))
+ (.modal (jquery "#modify")))))
+
+(defn render-dns-api-modify-get [ref name ipv4addr ipv6addr canonical ptrdname]
+ (POST "/dns/api/modify" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))
+ :ref ref
+ :name name
+ :ipv4addr ipv4addr
+ :ipv6addr ipv6addr
+ :canonical canonical
+ :ptrdname ptrdname}
+ :handler handler-dns-api-modify-get}))
+
+(defn on-dns-api-modify-get-clicked [ref name ipv4addr ipv6addr canonical ptrdname]
+ (when (-> (jquery "#dns-api-modify-get-form")
+ (.get "0")
+ (.checkValidity))
+ (.modal (jquery "#modify") "hide")
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-api-search-post-loading))
+ (apply render-dns-api-modify-post
+ (map (fn [field]
+ (when (jquery (str "#dns-api-modify-get-form input[id=" field "]"))
+ (.val (jquery (str "#dns-api-modify-get-form input[id=" field "]")))))
+ ["ref" "name" "ipv4addr" "ipv6addr" "canonical" "ptrdname"]))))
+
+;; dns-api-modify-post
+
+(defn handler-dns-api-modify-post [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (render-dns-api-search-post))))
+
+(defn render-dns-api-modify-post [ref name ipv4addr ipv6addr canonical ptrdname]
+ (POST "/dns/api/modify/post" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))
+ :ref ref
+ :name name
+ :ipv4addr ipv4addr
+ :ipv6addr ipv6addr
+ :canonical canonical
+ :ptrdname ptrdname}
+ :handler handler-dns-api-modify-post}))
+
+;; dns-api-delete-post
+
+(defn on-dns-api-delete-clicked [ref name]
+ (when (js/confirm (str "Are you sure that you want to delete the record for " name "?"))
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-api-search-post-loading))
+ (render-dns-api-delete-post ref)))
+
+(defn handler-dns-api-delete-post [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (render-dns-api-search-post))))
+
+(defn render-dns-api-delete-post [ref]
+ (POST "/dns/api/delete/post" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))
+ :ref ref}
+ :handler handler-dns-api-delete-post}))
+
+;; dns-api-ttl-get
+
+(defn on-dns-api-ttl-clicked [ref name]
+ (render-dns-api-ttl-get ref name))
+
+(hiccups/defhtml template-dns-api-ttl-get [jsonobj]
+ [:h5 (get jsonobj "title")]
+ (template-generic-form (get jsonobj "form")))
+
+(defn handler-dns-api-ttl-get [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (dommy/set-html! (dommy/sel1 :#ttl-body) (template-dns-api-ttl-get jsonobj))
+ (.modal (jquery "#ttl")))))
+
+(defn render-dns-api-ttl-get [ref name]
+ (POST "/dns/api/ttl" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))
+ :ref ref
+ :name name}
+ :handler handler-dns-api-ttl-get}))
+
+(defn on-dns-api-ttl-get-clicked [ref ttl]
+ (when (-> (jquery "#dns-api-ttl-get-form")
+ (.get "0")
+ (.checkValidity))
+ (.modal (jquery "#ttl") "hide")
+ (dommy/set-html! (dommy/sel1 :#results) (template-dns-api-search-post-loading))
+ (apply render-dns-api-ttl-post
+ (map (fn [field]
+ (when (jquery (str "#dns-api-ttl-get-form input[id=" field "]"))
+ (.val (jquery (str "#dns-api-ttl-get-form input[id=" field "]")))))
+ ["ref" "ttl"]))))
+
+;; dns-api-ttl-post
+
+(defn handler-dns-api-ttl-post [response]
+ (let [jsonobj (js->clj (js/JSON.parse response))]
+ (when (auth-notifications jsonobj)
+ (render-dns-api-search-post))))
+
+(defn render-dns-api-ttl-post [ref ttl]
+ (POST "/dns/api/ttl/post" {:format :raw
+ :params {:recordtype (dommy/value (dommy/sel1 :#recordtype))
+ :ref ref
+ :ttl ttl}
+ :handler handler-dns-api-ttl-post}))
diff --git a/lisp/webapps/dns-admin/conf/options.lisp b/lisp/webapps/dns-admin/conf/options.lisp
new file mode 100644
index 0000000..ddc02f2
--- /dev/null
+++ b/lisp/webapps/dns-admin/conf/options.lisp
@@ -0,0 +1,7 @@
+(:name "dns-admin"
+ :document-root "dns-admin"
+ :title "DNS Administration"
+ :meta-description "A website for administering DNS. Supports nsupdate and infoblox."
+ :dns (:label "CDS Infoblox"
+ :backend-type "infoblox"
+ :url "https://cdsinfdnsgm.nnodns.com/wapi/v2.6"))
diff --git a/lisp/webapps/dns-admin/conf/options.lisp.example b/lisp/webapps/dns-admin/conf/options.lisp.example
new file mode 100644
index 0000000..ddc02f2
--- /dev/null
+++ b/lisp/webapps/dns-admin/conf/options.lisp.example
@@ -0,0 +1,7 @@
+(:name "dns-admin"
+ :document-root "dns-admin"
+ :title "DNS Administration"
+ :meta-description "A website for administering DNS. Supports nsupdate and infoblox."
+ :dns (:label "CDS Infoblox"
+ :backend-type "infoblox"
+ :url "https://cdsinfdnsgm.nnodns.com/wapi/v2.6"))
diff --git a/lisp/webapps/dns-admin/site.lisp b/lisp/webapps/dns-admin/site.lisp
new file mode 100644
index 0000000..996eeea
--- /dev/null
+++ b/lisp/webapps/dns-admin/site.lisp
@@ -0,0 +1,103 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:dns-admin)
+
+(defmacro .base (&optional (onload-fn "goto_location('/dns')"))
+ `(html5
+ `(html
+ (head
+ ((meta :name "viewport" :content "width=device-width, initial-scale=1"))
+ ((meta :charset "utf-8"))
+ ((title) ,(title *webapp*))
+ ,@(mapcar (lambda (css)
+ `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin))))
+ '((:href "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/css/bootstrap.min.css" :integrity "sha384-Gn5384xqQ1aoWXA+058RXPxPg6fy4IWvTNh0E263XmFcJlSAwiGgFAW/dAiS6JXm" :crossorigin "anonymous")))
+ ,@(mapcar (lambda (js)
+ `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin))))
+ '((:src "https://code.jquery.com/jquery-3.2.1.slim.min.js" :integrity "sha384-KJ3o2DKtIkvYIK3UENzmM7KCkRr/rE9/Qpg6aAZGJwFDMVNA/GpGFF93hXpG5KkN" :crossorigin "anonymous")
+ (:src "https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.12.9/umd/popper.min.js" :integrity "sha384-ApNbgh9B+Y1QKtv3Rn7W3mgPxhU9K/ScQsAP7hUibX39j7fakFPskvXusvfa0b4Q" :crossorigin "anonymous")
+ (:src "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/js/bootstrap.min.js" :integrity "sha384-JZR6Spejh4U02d8jOt6vLEHfe/JQGiRRSQQxSfFWpi1MquVdAyjUar5+76PVCmYl" :crossorigin "anonymous")))
+ ((script :type "text/javascript" :src "/static/js/cljs/main.js")))
+ ((body :onload ,(format nil "dnsadmin.core.~a" ,onload-fn))
+ ((div :class "container-fluid")
+ ((div :class "row" :style "padding: 20px")
+ ((div :class "col")
+ ((div :class "page-header")
+ ((h2 :align "center") ,(title *webapp*))))))
+ ((div :id "location" :style "display: none"))
+ ((div :id "authmsg"))
+ ((div :id "errormsg"))
+ ((div :id "message"))
+ ((div :id "body"))
+ ((div :id "infoblox-creds" :class "modal fade" :role "dialog")
+ ((div :class "modal-dialog modal-lg")
+ ((div :class "modal-content")
+ ((div :class "modal-header")
+ ((h5 :class "modal-title") "Infoblox - Connection Parameters")
+ ((button :type "button" :class "close" :data-dismiss "modal") "×"))
+ ((div :id "infoblox-creds-body" :class "modal-body" :style "height: 460px;"))
+ ((div :class "modal-footer")
+ ((button :type "submit" :class "btn btn-danger btn-default" :data-dismiss "modal")
+ ((span :class "glyphicon glyphicon-remove") "Cancel"))))))))))
+
+(defmacro .location ()
+ `(handle-location location))
+
+(defmacro .dns ()
+ `(handle-dns))
+
+(defmacro .dns-headers ()
+ `(handle-dns-headers recordtype))
+
+(defmacro .dns-login-get ()
+ `(handle-dns-login-get))
+
+(defmacro .dns-login-post ()
+ `(handle-dns-login-post username pwd keypath))
+
+(defmacro .dns-api-search-get ()
+ `(handle-dns-api-search-get recordtype))
+
+(defmacro .dns-api-search-post ()
+ `(handle-dns-api-search-post recordtype ref name ipv4addr ipv6addr canonical ptrdname))
+
+(defmacro .dns-api-add-get ()
+ `(handle-dns-api-add-get recordtype))
+
+(defmacro .dns-api-add-post ()
+ `(handle-dns-api-add-post recordtype name ipv4addr ipv6addr canonical ptrdname))
+
+(defmacro .dns-api-modify-get ()
+ `(handle-dns-api-modify-get recordtype ref name ipv4addr ipv6addr canonical ptrdname))
+
+(defmacro .dns-api-modify-post ()
+ `(handle-dns-api-modify-post recordtype ref name ipv4addr ipv6addr canonical ptrdname))
+
+(defmacro .dns-api-delete-post ()
+ `(handle-dns-api-delete-post recordtype ref))
+
+(defmacro .dns-api-ttl-get ()
+ `(handle-dns-api-ttl-get recordtype ref name))
+
+(defmacro .dns-api-ttl-post ()
+ `(handle-dns-api-ttl-post recordtype ref ttl))
+
+;; hunchentoot fails to differentiate between :get and :post to the
+;; same URL. So we work around it in the URLs but fix it in the
+;; downstream macro and function names.
+(define-endpoint :get "/" () .base)
+(define-endpoint :post "/location" ((location :parameter-type 'string)) .location)
+(define-endpoint :get "/dns" () .dns)
+(define-endpoint :post "/dns/headers" ((recordtype :parameter-type 'string)) .dns-headers)
+(define-endpoint :get "/dns/login" () .dns-login-get)
+(define-endpoint :post "/dns/login/post" ((username :parameter-type 'string) (pwd :parameter-type 'string) (keypath :parameter-type 'string)) .dns-login-post)
+(define-endpoint :post "/dns/api/search" ((recordtype :parameter-type 'string)) .dns-api-search-get)
+(define-endpoint :post "/dns/api/search/post" ((recordtype :parameter-type 'string) (ref :parameter-type 'string) (name :parameter-type 'string) (ipv4addr :parameter-type 'string) (ipv6addr :parameter-type 'string) (canonical :parameter-type 'string) (ptrdname :parameter-type 'string)) .dns-api-search-post)
+(define-endpoint :post "/dns/api/add" ((recordtype :parameter-type 'string)) .dns-api-add-get)
+(define-endpoint :post "/dns/api/add/post" ((recordtype :parameter-type 'string) (name :parameter-type 'string) (ipv4addr :parameter-type 'string) (ipv6addr :parameter-type 'string) (canonical :parameter-type 'string) (ptrdname :parameter-type 'string)) .dns-api-add-post)
+(define-endpoint :post "/dns/api/modify" ((recordtype :parameter-type 'string) (ref :parameter-type 'string) (name :parameter-type 'string) (ipv4addr :parameter-type 'string) (ipv6addr :parameter-type 'string) (canonical :parameter-type 'string) (ptrdname :parameter-type 'string)) .dns-api-modify-get)
+(define-endpoint :post "/dns/api/modify/post" ((recordtype :parameter-type 'string) (ref :parameter-type 'string) (name :parameter-type 'string) (ipv4addr :parameter-type 'string) (ipv6addr :parameter-type 'string) (canonical :parameter-type 'string) (ptrdname :parameter-type 'string)) .dns-api-modify-post)
+(define-endpoint :post "/dns/api/delete/post" ((recordtype :parameter-type 'string) (ref :parameter-type 'string)) .dns-api-delete-post)
+(define-endpoint :post "/dns/api/ttl" ((recordtype :parameter-type 'string) (ref :parameter-type 'string) (name :parameter-type 'string)) .dns-api-ttl-get)
+(define-endpoint :post "/dns/api/ttl/post" ((recordtype :parameter-type 'string) (ref :parameter-type 'string) (ttl :parameter-type 'string)) .dns-api-ttl-post)
diff --git a/lisp/webapps/dns-admin/static/images/add.png b/lisp/webapps/dns-admin/static/images/add.png
new file mode 100644
index 0000000..1055df8
--- /dev/null
+++ b/lisp/webapps/dns-admin/static/images/add.png
Binary files differ
diff --git a/lisp/webapps/dns-admin/static/images/clock.png b/lisp/webapps/dns-admin/static/images/clock.png
new file mode 100644
index 0000000..66a95a7
--- /dev/null
+++ b/lisp/webapps/dns-admin/static/images/clock.png
Binary files differ
diff --git a/lisp/webapps/dns-admin/static/images/delete.png b/lisp/webapps/dns-admin/static/images/delete.png
new file mode 100644
index 0000000..b0de61d
--- /dev/null
+++ b/lisp/webapps/dns-admin/static/images/delete.png
Binary files differ
diff --git a/lisp/webapps/dns-admin/static/images/edit.png b/lisp/webapps/dns-admin/static/images/edit.png
new file mode 100644
index 0000000..550dacd
--- /dev/null
+++ b/lisp/webapps/dns-admin/static/images/edit.png
Binary files differ
diff --git a/lisp/webapps/dns-admin/static/js/cljs b/lisp/webapps/dns-admin/static/js/cljs
new file mode 120000
index 0000000..c6964c8
--- /dev/null
+++ b/lisp/webapps/dns-admin/static/js/cljs
@@ -0,0 +1 @@
+../../clojurescript/dnsadmin/resources/public/cljs \ No newline at end of file
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:34:43 +0000