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
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(in-package #:dns-admin)
(defclass dns-record (entity)
((*recordtype :initarg :*recordtype
:initform nil
:accessor *recordtype)
(name :initarg :name
:initform nil
:accessor name))
(:documentation "Base class for DNS records."))
(defclass dns-record-infoblox (dns-record)
((--ref :initarg :--ref
:initform nil
:accessor --ref)
(ttl :initarg :ttl
:initform nil
:accessor ttl))
(:documentation "Base class for DNS records of type infoblox."))
(defclass dns-record-infoblox-a (dns-record-infoblox)
((ipv-4-addr :initarg :ipv-4-addr
:initform nil
:accessor ipv-4-addr))
(:documentation "DNS A record of type infoblox."))
(defclass dns-record-infoblox-aaaa (dns-record-infoblox)
((ipv-6-addr :initarg :ipv-6-addr
:initform nil
:accessor ipv-6-addr))
(:documentation "DNS AAAA record of type infoblox."))
(defclass dns-record-infoblox-cname (dns-record-infoblox)
((canonical :initarg :canonical
:initform nil
:accessor canonical))
(:documentation "DNS CNAME record of type infoblox."))
(defclass dns-record-infoblox-ptr (dns-record-infoblox)
((ptrdname :initarg :ptrdname
:initform nil
:accessor ptrdname)
(ipv-4-addr :initarg :ipv-4-addr
:initform nil
:accessor ipv-4-addr))
(:documentation "DNS PTR record of type infoblox."))
(defun sanitize-dns-filter-param (param)
(cond ((intersection `(,param) '("" "null" "undefined") :test 'string=) nil)
(t param)))
(defmethod slot-to-param ((dns-record dns-record-infoblox) slot)
(cond ((eq slot '*recordtype) 'recordtype)
((eq slot '--ref) 'ref)
((eq slot 'ipv-4-addr) 'ipv4addr)
((eq slot 'ipv-6-addr) 'ipv6addr)
(t slot)))
(defmethod param-to-slot ((dns-record dns-record-infoblox) param)
(cond ((eq param 'recordtype) '*recordtype)
((eq param 'ref) '--ref)
((eq param 'ipv4addr) 'ipv-4-addr)
((eq param 'ipv6addr) 'ipv-6-addr)
(t param)))
(defmethod make-dns-record ((dns dns) recordtype)
(let* ((package (package-name #.*package*))
(dns-record-class (intern (string-upcase (format nil "dns-record-~a-~a" (backend-type dns) recordtype)) (find-package package))))
(make-instance dns-record-class :*recordtype recordtype)))
(defmethod intersect-dns-record-function-args ((dns-record dns-record) func-symbol)
(intersection (sb-introspect:function-lambda-list func-symbol)
(mapcar (lambda (slot)
(slot-to-param dns-record slot))
(map-slot-names dns-record))))
(defmethod search-filter-satisfied-p ((dns-record dns-record) rec)
(not (position nil (mapcar (lambda (slot)
(let ((slot-has-value-p (and (slot-value dns-record slot))))
(or (not slot-has-value-p)
(and slot-has-value-p
(match-it (slot-value dns-record slot) (slot-value rec slot))))))
(remove-if 'null (mapcar (lambda (s)
(when (slot-is-field-p s) s))
(map-slot-names dns-record)))))))
(defmacro define-dns-impl ((method-name action) &body macro-body)
;; dig @127.0.0.1 +dnssec ckons.org AXFR
(let ((endpoint (gensym)))
`(progn
(defgeneric ,method-name (dns dns-record-infoblox))
(defmethod ,method-name ((dns dns) (dns-record dns-record-infoblox))
(let ((,endpoint (format nil
"~a/~a?_return_as_object=1~a"
(url dns)
(if (intersection `(,,action) '(:get :post))
(format nil "record:~a" (*recordtype dns-record))
(--ref dns-record))
(if (and (eq (type-of dns-record) 'dns-record-infoblox-ptr)
(not (eq ,action :delete)))
"&_return_fields=name,ptrdname,ipv4addr,ipv6addr"
"")))
(parameters (if (slot-value dns-record 'ttl)
`(("use_ttl" . t) ("ttl" . ,(ttl dns-record)))
(remove-if 'null (mapcar (lambda (slot)
(when (and (not (eq ,action :get))
(not (eq slot '--ref))
(slot-is-field-p slot)
(slot-value dns-record slot))
`(,(string-downcase (symbol-name (slot-to-param dns-record slot))) . ,(slot-value dns-record slot))))
(map-slot-names dns-record))))))
(when (not (eq ,action :get))
(setf parameters (alist-to-json parameters)))
(multiple-value-bind (body status-code headers uri stream must-close reason)
(apply #'drakma-request `(,,endpoint
nil
:method ,,action
,@(when (not (eq ,action :get)) `(:content-type "application/json"))
,@(if (eq ,action :get)
`(:parameters ,parameters)
`(:content ,parameters))
:basic-authorization (,(session-value :username) ,(session-value :pwd))))
(declare (ignore headers uri stream must-close reason))
(cond ((or (= status-code 401) (= status-code 403))
(hunchentoot:require-authorization (name *webapp*)))
((< status-code 300)
,@macro-body)
(t
(format nil "Error response from infoblox.~%Method = [~a]~%Endpoint = [~a]~%Parameters = [~a]~%Response = [~a]" ',method-name ,endpoint parameters (flexi-streams:octets-to-string body :external-format :utf-8))))))))))
(defmethod get-dns-records ((dns dns) recordtype ref name ipv4addr ipv6addr canonical ptrdname)
(declare (special recordtype ref name ipv4addr ipv6addr canonical ptrdname))
(let ((dns-record (make-dns-record dns recordtype)))
(loop for param in (intersect-dns-record-function-args dns-record 'get-dns-records) do
(setf (slot-value dns-record (param-to-slot dns-record param)) (sanitize-dns-filter-param (symbol-value param))))
(get-dns-records-impl dns dns-record)))
(define-dns-impl (get-dns-records-impl :get)
(remove-if 'null (mapcar (lambda (rec)
(when (search-filter-satisfied-p dns-record rec) rec))
(json-to-object (type-of dns-record) (cdar (json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))))))
(defmethod add-dns-record ((dns dns) (dns-record dns-record))
(add-dns-record-impl dns dns-record))
(define-dns-impl (add-dns-record-impl :post)
(json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
(defmethod modify-dns-record ((dns dns) (dns-record dns-record))
(modify-dns-record-impl dns dns-record))
(define-dns-impl (modify-dns-record-impl :put)
(json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
(defmethod modify-dns-record-ttl ((dns dns) (dns-record dns-record))
(modify-dns-record-ttl-impl dns dns-record))
(define-dns-impl (modify-dns-record-ttl-impl :put)
(json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
(defmethod delete-dns-record ((dns dns) (dns-record dns-record))
(delete-dns-record-impl dns dns-record))
(define-dns-impl (delete-dns-record-impl :delete)
(json:decode-json-from-string (flexi-streams:octets-to-string body :external-format :utf-8)))
|
