summaryrefslogtreecommitdiff
path: root/lisp/dns/dns.lisp
blob: f0dfeda7900b67c379f1247b7f5accf68a024f91 (plain)
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
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))

(in-package #:dns-admin)

(defclass dns ()
  ((label :initarg :label
          :initform nil
          :accessor label)
   (backend-type :initarg :backend-type
                 :initform nil
                 :accessor backend-type))
  (:documentation ""))

(defclass dns-infoblox (dns)
  ((url :initarg :url
        :initform nil
        :accessor url)
   (username :initarg :username
             :initform nil
             :accessor username)
   (password :initarg :password
             :initform nil
             :accessor password))
  (:documentation "Used to provide an object-oriented interface to the
DNS options in the webapp config file."))

(defclass dns-nsupdate (dns)
  ((hostname :initarg :hostname
             :initform nil
             :accessor hostname)
   (forward-zone :initarg :forward-zone
                 :initform nil
                 :accessor forward-zone)
   (reverse-zone :initarg :reverse-zone
                 :initform nil
                 :accessor reverse-zone)
   (dnssec-key :initarg :dnssec-key
               :initform nil
               :accessor dnssec-key
               :documentation "This is a filepath, not the actual contents of the key."))
  (:documentation ""))

(defmethod initialize-instance :after ((dns dns) &key config)
  (loop for slot in (map-slot-names dns) do
       (setf (slot-value dns slot) (getf config (intern (symbol-name slot) :keyword)))))

(defmacro with-dns ((dns-name) &body body)
  (let ((package (package-name #.*package*)))
    `(let* ((config (dns *webapp*))
            (dns-class (intern (string-upcase (concatenate 'string "dns-" (getf config :backend-type))) (find-package ,package)))
            (,dns-name (make-instance dns-class :config config)))
       ,@body)))