1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
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."))))))))
|
