feat(lisp/dns): Check in very early DNS-over-HTTPS client r/448

This includes very barebones support for querying TXT and MX records
right now. The returned structure is not turned into a more convenient
format and error handling is, well, NIL.

3 files changed, 45 insertions, 0 deletions

diff --git a/default.nix b/default.nix
index ad9e332cbf..cda18ee7f3 100644
--- a/default.nix
+++ b/default.nix
@@ -32,6 +32,7 @@ let
     fun           = readTree ./fun;
     nix           = readTree ./nix;
     ops           = readTree ./ops;
+    lisp          = readTree ./lisp;
     presentations = readTree ./presentations;
     third_party   = readTree ./third_party;
     tools         = readTree ./tools;
diff --git a/lisp/dns/default.nix b/lisp/dns/default.nix
new file mode 100644
index 0000000000..c41b02f97c
--- /dev/null
+++ b/lisp/dns/default.nix
@@ -0,0 +1,15 @@
+{ pkgs, ... }:
+
+pkgs.nix.buildLisp.library {
+  name = "dns";
+
+  deps = with pkgs.third_party.lisp; [
+    alexandria
+    cl-json
+    drakma
+  ];
+
+  srcs = [
+    ./resolver.lisp
+  ];
+}
diff --git a/lisp/dns/resolver.lisp b/lisp/dns/resolver.lisp
new file mode 100644
index 0000000000..774be525cb
--- /dev/null
+++ b/lisp/dns/resolver.lisp
@@ -0,0 +1,29 @@
+;; Initial implementation is a simple client for
+;; https://developers.google.com/speed/public-dns/docs/doh/json
+
+(defpackage #:dns
+  (:documentation "Simple DNS resolver in Common Lisp")
+  (:use #:cl)
+  (:export #:lookup-txt #:lookup-mx))
+
+(defvar *doh-base-url* "https://dns.google/resolve"
+  "Base URL of the service providing DNS-over-HTTP(S). Defaults to the
+  Google-hosted API.")
+
+(defun lookup-generic (name type)
+  (multiple-value-bind (body)
+      (drakma:http-request *doh-base-url*
+                           :decode-content t
+                           :want-stream t
+                           :parameters `(("type" . ,type)
+                                         ("name" . ,name)
+                                         ("ct" . "application/x-javascript")))
+    (cl-json:decode-json body)))
+
+(defun lookup-txt (name)
+  "Look up the TXT records at NAME."
+  (lookup-generic name "TXT"))
+
+(defun lookup-mx (name)
+  "Look up the MX records at NAME."
+  (lookup-generic name "MX"))