Plan dev DNS and DNS-01 changes from Namecheap observations

dag/extdeps/acme/dns01.dag

@@ -0,0 +1,18 @@
+module extdeps.acme.dns01
+
+import std.types { String, Bool }
+import extdeps.external_authority { ExternalAuthority }
+import extdeps.uri { Uri, Https }
+
+data extdeps_external_authority_anchor: ExternalAuthority = ExternalAuthority {
+  uri: Uri { scheme: Https, locator: "www.rfc-editor.org/rfc/rfc8555#section-8.4" }
+}
+
+// The TXT value is the unpadded base64url encoding of a SHA-256 digest (32
+// octets): 43 characters; the last sextet has two zero padding bits. This is
+// not the ACME challenge token or key authorization, and validates no order.
+fn acme_dns01_txt_value_valid(s: String) -> Bool {
+  string_length(s: s) == 43
+    && all(s.chars(), c => (c >= 65 && c <= 90) || (c >= 97 && c <= 122) || (c >= 48 && c <= 57) || c == 45 || c == 95)
+    && string_contains(s: "AEIMQUYcgkosw048", pattern: char_at(s: s, pos: 42))
+}

dag/extdeps/http/client.dag

@@ -168,6 +168,18 @@ service http.Client {
     }
   }
 
+  operation GetQueryStdinWithin {
+    input { url: NonEmptyStr, query: String, connect_seconds: NonEmptyStr, max_seconds: NonEmptyStr }
+    output { success: Bool from "exit_success", body: String from "stdout" }
+    readonly
+    transport shell {
+      argv: ["curl", "--disable", "-sS", "--connect-timeout", "{connect_seconds}", "--max-time", "{max_seconds}", "--get", "--data-binary", "@-", "-w", "\n%\{http_code\}", "{url}"]
+      stdin: query
+    }
+    exit { 0 => Unit nonzero => String "bounded GET with stdin query did not complete" }
+    mock_response { 0 => { success: false, body: "" } "hermetic: no live HTTP endpoint" }
+  }
+
   operation PostStdinWithin {
     input { url: NonEmptyStr, request_body: String, connect_seconds: NonEmptyStr, max_seconds: NonEmptyStr }
     output {

dag/extdeps/languages/xml/read.dag

@@ -0,0 +1,153 @@
+module extdeps.languages.xml.read
+
+import std.types { String, Int, Bool, List }
+import std.algebra { trim }
+import extdeps.external_authority { ExternalAuthority }
+import extdeps.uri { Uri, Https }
+
+data extdeps_external_authority_anchor: ExternalAuthority = ExternalAuthority { uri: Uri { scheme: Https, locator: "www.w3.org/TR/xml/" } }
+
+// A bounded XML subset reader, not a general XML processor. It rejects DTDs,
+// external entities, numeric references, comments, CDATA and processing
+// instructions other than the initial XML declaration. Unsupported input refuses;
+// it is never stripped into an apparently successful provider response.
+type XmlAttribute { name: String, value: String }
+type XmlElement { name: String, attributes: List<XmlAttribute>, children: List<XmlElement>, text: String }
+type XmlRead = XmlParsed { element: XmlElement, next: Int } | XmlRefused
+
+type XmlTextRead = XmlTextParsed { value: String, next: Int } | XmlTextRefused
+type XmlStartRead = XmlStartParsed { attributes: List<XmlAttribute>, next: Int, closed: Bool } | XmlStartRefused
+
+fn xml_at(s: String, i: Int) -> String {
+  if i < 0 || i >= string_length(s: s) { "" } else { substring(s: s, start: i, end: i + 1) }
+}
+fn xml_has(s: String, i: Int, prefix: String) -> Bool {
+  i >= 0 && i + string_length(s: prefix) <= string_length(s: s) && substring(s: s, start: i, end: i + string_length(s: prefix)) == prefix
+}
+fn xml_valid_character(c: String) -> Bool {
+  all(c |> chars, cp => cp == 9 || cp == 10 || cp == 13 || (cp >= 32 && cp <= 55295) || (cp >= 57344 && cp <= 65533) || (cp >= 65536 && cp <= 1114111))
+}
+fn xml_space(c: String) -> Bool { c == " " || c == "\t" || c == "\r" || c == "\n" }
+fn xml_skip(s: String, i: Int) -> Int {
+  if i < string_length(s: s) && xml_space(c: xml_at(s: s, i: i)) { xml_skip(s: s, i: i + 1) } else { i }
+}
+fn xml_name_first(c: String) -> Bool {
+  c != "" && string_contains(s: "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_", pattern: c)
+}
+fn xml_name_char(c: String) -> Bool {
+  xml_name_first(c: c) || (c != "" && string_contains(s: "0123456789-.:", pattern: c))
+}
+fn xml_name_end(s: String, i: Int) -> Int {
+  if xml_name_char(c: xml_at(s: s, i: i)) { xml_name_end(s: s, i: i + 1) } else { i }
+}
+fn xml_entity(s: String, i: Int) -> XmlTextRead {
+  if xml_has(s: s, i: i, prefix: "&amp;") { XmlTextParsed { value: "&", next: i + 5 } }
+  else if xml_has(s: s, i: i, prefix: "&lt;") { XmlTextParsed { value: "<", next: i + 4 } }
+  else if xml_has(s: s, i: i, prefix: "&gt;") { XmlTextParsed { value: ">", next: i + 4 } }
+  else if xml_has(s: s, i: i, prefix: "&quot;") { XmlTextParsed { value: "\"", next: i + 6 } }
+  else if xml_has(s: s, i: i, prefix: "&apos;") { XmlTextParsed { value: "'", next: i + 6 } }
+  else { XmlTextRefused }
+}
+fn xml_text_until(s: String, i: Int, stop: String, acc: String, remaining: Int) -> XmlTextRead {
+  if remaining <= 0 || i >= string_length(s: s) { XmlTextRefused }
+  else {
+    let c = xml_at(s: s, i: i)
+    if c == stop { XmlTextParsed { value: acc, next: i } }
+    else if c == "<" || !xml_valid_character(c: c) || (stop != "<" && (c == "\n" || c == "\r" || c == "\t")) || xml_has(s: s, i: i, prefix: "]]>") { XmlTextRefused }
+    else if c == "&" {
+      match xml_entity(s: s, i: i) {
+        XmlTextRefused => XmlTextRefused
+        XmlTextParsed { value, next } => xml_text_until(s: s, i: next, stop: stop, acc: concat(acc, value), remaining: remaining - 1)
+      }
+    } else { xml_text_until(s: s, i: i + 1, stop: stop, acc: concat(acc, c), remaining: remaining - 1) }
+  }
+}
+fn xml_attributes(s: String, i: Int, attrs: List<XmlAttribute>, remaining: Int) -> XmlStartRead {
+  let p = xml_skip(s: s, i: i)
+  if remaining <= 0 { XmlStartRefused }
+  else if xml_has(s: s, i: p, prefix: "/>") { XmlStartParsed { attributes: attrs, next: p + 2, closed: true } }
+  else if xml_at(s: s, i: p) == ">" { XmlStartParsed { attributes: attrs, next: p + 1, closed: false } }
+  else if p == i || !xml_name_first(c: xml_at(s: s, i: p)) { XmlStartRefused }
+  else {
+    let end = xml_name_end(s: s, i: p)
+    let name = substring(s: s, start: p, end: end)
+    let eq = xml_skip(s: s, i: end)
+    let q = xml_skip(s: s, i: eq + 1)
+    let quote = xml_at(s: s, i: q)
+    if attrs.any(a => a.name == name) || xml_at(s: s, i: eq) != "=" || (quote != "\"" && quote != "'") { XmlStartRefused }
+    else {
+      match xml_text_until(s: s, i: q + 1, stop: quote, acc: "", remaining: 16384) {
+        XmlTextRefused => XmlStartRefused
+        XmlTextParsed { value, next } => xml_attributes(s: s, i: next + 1, attrs: concat(attrs, [XmlAttribute { name: name, value: value }]), remaining: remaining - 1)
+      }
+    }
+  }
+}
+fn xml_body(s: String, i: Int, name: String, attrs: List<XmlAttribute>, children: List<XmlElement>, text: String, depth: Int, remaining: Int) -> XmlRead {
+  if remaining <= 0 || i >= string_length(s: s) { XmlRefused }
+  else if xml_has(s: s, i: i, prefix: "</") {
+    let end = xml_name_end(s: s, i: i + 2)
+    let close = xml_skip(s: s, i: end)
+    if substring(s: s, start: i + 2, end: end) != name || xml_at(s: s, i: close) != ">" { XmlRefused }
+    else { XmlParsed { element: XmlElement { name: name, attributes: attrs, children: children, text: text }, next: close + 1 } }
+  } else if xml_at(s: s, i: i) == "<" {
+    match xml_element(s: s, i: i, depth: depth - 1) {
+      XmlRefused => XmlRefused
+      XmlParsed { element, next } => xml_body(s: s, i: next, name: name, attrs: attrs, children: concat(children, [element]), text: text, depth: depth, remaining: remaining - 1)
+    }
+  } else {
+    match xml_text_until(s: s, i: i, stop: "<", acc: "", remaining: 16384) {
+      XmlTextRefused => XmlRefused
+      XmlTextParsed { value, next } => xml_body(s: s, i: next, name: name, attrs: attrs, children: children, text: concat(text, value), depth: depth, remaining: remaining - 1)
+    }
+  }
+}
+fn xml_element(s: String, i: Int, depth: Int) -> XmlRead {
+  if depth <= 0 || xml_at(s: s, i: i) != "<" || !xml_name_first(c: xml_at(s: s, i: i + 1)) { XmlRefused }
+  else {
+    let end = xml_name_end(s: s, i: i + 1)
+    let name = substring(s: s, start: i + 1, end: end)
+    match xml_attributes(s: s, i: end, attrs: [], remaining: 64) {
+      XmlStartRefused => XmlRefused
+      XmlStartParsed { attributes, next, closed } =>
+        if closed { XmlParsed { element: XmlElement { name: name, attributes: attributes, children: [], text: "" }, next: next } }
+        else { xml_body(s: s, i: next, name: name, attrs: attributes, children: [], text: "", depth: depth, remaining: 4096) }
+    }
+  }
+}
+fn xml_prolog_end(s: String, i: Int, remaining: Int) -> Int {
+  if remaining <= 0 || i >= string_length(s: s) { -1 }
+  else if xml_has(s: s, i: i, prefix: "?>") { i + 2 }
+  else if xml_at(s: s, i: i) == "<" { -1 }
+  else { xml_prolog_end(s: s, i: i + 1, remaining: remaining - 1) }
+}
+fn xml_declaration_valid(s: String, start: Int, end: Int) -> Bool {
+  if end < start + 8 { false }
+  else {
+    let declaration = join(["<xml ", substring(s: s, start: start + 6, end: end - 2), "/>"], "")
+    match xml_element(s: declaration, i: 0, depth: 1) {
+      XmlRefused => false
+      XmlParsed { element: e, next } => next == string_length(s: declaration) && xml_attribute(e: e, name: "version") == "1.0"
+        && all(e.attributes, a => a.name == "version" || (a.name == "encoding" && (a.value == "UTF-8" || a.value == "utf-8")) || (a.name == "standalone" && (a.value == "yes" || a.value == "no")))
+    }
+  }
+}
+fn read_xml_subset(s: String) -> XmlRead {
+  if string_length(s: s) > 262144 { XmlRefused }
+  else {
+    let first = xml_skip(s: s, i: 0)
+    let start = if xml_has(s: s, i: first, prefix: "<?xml ") { xml_prolog_end(s: s, i: first + 6, remaining: 256) } else { first }
+    if start < 0 || (xml_has(s: s, i: first, prefix: "<?xml ") && !xml_declaration_valid(s: s, start: first, end: start)) { XmlRefused }
+    else {
+      match xml_element(s: s, i: xml_skip(s: s, i: start), depth: 16) {
+        XmlRefused => XmlRefused
+        XmlParsed { element, next } => if xml_skip(s: s, i: next) == string_length(s: s) { XmlParsed { element: element, next: next } } else { XmlRefused }
+      }
+    }
+  }
+}
+fn xml_attribute(e: XmlElement, name: String) -> String {
+  match e.attributes.filter(a => a.name == name).first() { Present { value: a } => a.value Absent => "" }
+}
+fn xml_children(e: XmlElement, name: String) -> List<XmlElement> { e.children.filter(c => c.name == name) }
+fn xml_leaf(e: XmlElement) -> Bool { count(e.children) == 0 }

dag/extdeps/namecheap/client.dag

@@ -0,0 +1,72 @@
+module extdeps.namecheap.client
+
+import std.types { String, NonEmptyStr, Secret, Bool }
+import extdeps.uri { uri_percent_encode_component, UriPercentComponentEncoded, UriPercentComponentRefused }
+import extdeps.external_authority { ExternalAuthority }
+import extdeps.uri { Uri, Https }
+import extdeps.http.client
+import extdeps.namecheap.read_hosts { NamecheapHostsRead, NamecheapHostsObserved, NamecheapHostsRefused, namecheap_read_hosts }
+
+data extdeps_external_authority_anchor: ExternalAuthority = ExternalAuthority { uri: Uri { scheme: Https, locator: "www.namecheap.com/support/api/methods/domains-dns/get-hosts/" } }
+
+// GET query travels on stdin, never in argv. This interface exposes only getHosts;
+// there is no caller-supplied command and no mutation operation.
+fn namecheap_get_hosts(account: NonEmptyStr, credential: Secret, client_ipv4: NonEmptyStr, sld: NonEmptyStr, tld: NonEmptyStr) -> NamecheapHostsRead {
+  match uri_percent_encode_component(value: credential as NonEmptyStr) {
+    UriPercentComponentRefused { cause: _ } => NamecheapHostsRefused { reason: "Namecheap credential cannot be encoded" }
+    UriPercentComponentEncoded(key_wire) =>
+      match uri_percent_encode_component(value: account) {
+        UriPercentComponentRefused { cause: _ } => NamecheapHostsRefused { reason: "Namecheap account cannot be encoded" }
+        UriPercentComponentEncoded(account_wire) =>
+          match uri_percent_encode_component(value: client_ipv4) {
+            UriPercentComponentRefused { cause: _ } => NamecheapHostsRefused { reason: "Namecheap client address cannot be encoded" }
+            UriPercentComponentEncoded(ip_wire) =>
+              match uri_percent_encode_component(value: sld) {
+                UriPercentComponentRefused { cause: _ } => NamecheapHostsRefused { reason: "Namecheap domain cannot be encoded" }
+                UriPercentComponentEncoded(sld_wire) =>
+                  match uri_percent_encode_component(value: tld) {
+                    UriPercentComponentRefused { cause: _ } => NamecheapHostsRefused { reason: "Namecheap domain suffix cannot be encoded" }
+                    UriPercentComponentEncoded(tld_wire) => {
+                      let query = join(["ApiUser=", account_wire as String, "&UserName=", account_wire as String, "&ApiKey=", key_wire as String,
+                        "&ClientIp=", ip_wire as String, "&SLD=", sld_wire as String, "&TLD=", tld_wire as String,
+                        "&Command=namecheap.domains.dns.getHosts"], "")
+                      let got = http.Client.GetQueryStdinWithin(url: "https://api.namecheap.com/xml.response" as NonEmptyStr, query: query,
+                        connect_seconds: "5" as NonEmptyStr, max_seconds: "30" as NonEmptyStr)
+                      let n = string_length(s: got.body)
+                      if !got.success || n < 4 || substring(s: got.body, start: n - 4, end: n) != "\n200" {
+                        NamecheapHostsRefused { reason: "Namecheap getHosts transport did not return HTTP 200" }
+                      } else {
+                        namecheap_read_hosts_for_publication(body: substring(s: got.body, start: 0, end: n - 4),
+                          domain: join([sld as String, ".", tld as String], ""), credential: credential, key_wire: key_wire as String)
+                      }
+                    }
+                  }
+              }
+          }
+      }
+  }
+}
+
+fn namecheap_contains_credential(value: String, credential: Secret, key_wire: String) -> Bool {
+  string_contains(s: value, pattern: credential as String) || string_contains(s: value, pattern: key_wire)
+}
+
+// Raw exclusion and decoded exclusion protect different representations. Refuse
+// the whole observation; never redact a field and call the snapshot complete.
+fn namecheap_read_hosts_for_publication(body: String, domain: String, credential: Secret, key_wire: String) -> NamecheapHostsRead {
+  if (credential as String) == "" || key_wire == "" || namecheap_contains_credential(value: body, credential: credential, key_wire: key_wire) {
+    NamecheapHostsRefused { reason: "Namecheap response contains credential material; refusing to publish it" }
+  } else {
+    match namecheap_read_hosts(body: body, domain: domain) {
+      NamecheapHostsRefused { reason } => NamecheapHostsRefused { reason: reason }
+      NamecheapHostsObserved { domain: observed_domain, hosts, result_fields } =>
+        if namecheap_contains_credential(value: observed_domain, credential: credential, key_wire: key_wire)
+          || result_fields.any(f => namecheap_contains_credential(value: f.name, credential: credential, key_wire: key_wire) || namecheap_contains_credential(value: f.value, credential: credential, key_wire: key_wire))
+          || hosts.any(h => h.fields.any(f => namecheap_contains_credential(value: f.name, credential: credential, key_wire: key_wire) || namecheap_contains_credential(value: f.value, credential: credential, key_wire: key_wire))) {
+          NamecheapHostsRefused { reason: "Namecheap decoded response contains credential material; refusing to publish it" }
+        } else {
+          NamecheapHostsObserved { domain: observed_domain, hosts: hosts, result_fields: result_fields }
+        }
+    }
+  }
+}

dag/extdeps/namecheap/read_hosts.dag

@@ -0,0 +1,69 @@
+module extdeps.namecheap.read_hosts
+
+import std.types { String, List, Bool }
+import std.algebra { trim }
+import std.decimal { decimal_digits_only }
+import extdeps.languages.xml.read { XmlElement, XmlAttribute, XmlParsed, XmlRefused, read_xml_subset, xml_attribute, xml_children, xml_leaf }
+import extdeps.external_authority { ExternalAuthority }
+import extdeps.uri { Uri, Https }
+
+data extdeps_external_authority_anchor: ExternalAuthority = ExternalAuthority { uri: Uri { scheme: Https, locator: "www.namecheap.com/support/api/methods/domains-dns/get-hosts/" } }
+
+type NamecheapObservedHost { fields: List<XmlAttribute> }
+type NamecheapHostsRead = NamecheapHostsObserved { domain: String, hosts: List<NamecheapObservedHost>, result_fields: List<XmlAttribute> } | NamecheapHostsRefused { reason: String }
+
+fn nc_namespace_inherited(e: XmlElement) -> Bool {
+  !e.attributes.any(a => a.name == "xmlns" || string_contains(s: a.name, pattern: ":"))
+    && all(e.children, c => nc_namespace_inherited(e: c))
+}
+fn nc_host_valid(e: XmlElement) -> Bool {
+  e.name == "Host" && xml_leaf(e: e) && trim(s: e.text) == ""
+    && xml_attribute(e: e, name: "Name") != ""
+    && xml_attribute(e: e, name: "Type") != ""
+    && xml_attribute(e: e, name: "Address") != ""
+    && xml_attribute(e: e, name: "HostId") != ""
+    && decimal_digits_only(s: xml_attribute(e: e, name: "TTL")) && xml_attribute(e: e, name: "TTL") != ""
+}
+fn nc_result(e: XmlElement, domain: String) -> NamecheapHostsRead {
+  if xml_attribute(e: e, name: "Domain") != domain || xml_attribute(e: e, name: "IsUsingOurDNS") != "true" || trim(s: e.text) != "" {
+    NamecheapHostsRefused { reason: "Namecheap result does not confirm the requested domain on its DNS" }
+  } else if !all(e.children, h => nc_host_valid(e: h) && count(e.children.filter(other => xml_attribute(e: other, name: "HostId") == xml_attribute(e: h, name: "HostId"))) == 1) {
+    NamecheapHostsRefused { reason: "Namecheap host records are incomplete or contain unsupported result elements" }
+  } else {
+    NamecheapHostsObserved { domain: domain, hosts: map(e.children, h => NamecheapObservedHost { fields: h.attributes }), result_fields: e.attributes }
+  }
+}
+fn nc_command(e: XmlElement, domain: String) -> NamecheapHostsRead {
+  if xml_attribute(e: e, name: "Type") != "namecheap.domains.dns.getHosts" || count(e.children) != 1 || trim(s: e.text) != "" {
+    NamecheapHostsRefused { reason: "Namecheap command response is ambiguous or names another command" }
+  } else {
+    match e.children.first() {
+      Present { value: result } => if result.name == "DomainDNSGetHostsResult" { nc_result(e: result, domain: domain) } else { NamecheapHostsRefused { reason: "Namecheap result is not getHosts" } }
+      Absent => NamecheapHostsRefused { reason: "Namecheap result is missing" }
+    }
+  }
+}
+fn namecheap_read_hosts(body: String, domain: String) -> NamecheapHostsRead {
+  match read_xml_subset(s: body) {
+    XmlRefused => NamecheapHostsRefused { reason: "Namecheap returned malformed or unsupported XML" }
+    XmlParsed { element: root, next: _ } =>
+      let errors = xml_children(e: root, name: "Errors")
+      let commands = xml_children(e: root, name: "CommandResponse")
+      let requested = xml_children(e: root, name: "RequestedCommand")
+      if root.name != "ApiResponse" || xml_attribute(e: root, name: "Status") != "OK"
+        || xml_attribute(e: root, name: "xmlns") != "http://api.namecheap.com/xml.response"
+        || trim(s: root.text) != ""
+        || count(errors) != 1 || !all(errors, e => xml_leaf(e: e) && trim(s: e.text) == "")
+        || !all(xml_children(e: root, name: "Warnings"), e => xml_leaf(e: e) && trim(s: e.text) == "")
+        || count(requested) != 1 || !all(requested, e => xml_leaf(e: e) && trim(s: e.text) == "namecheap.domains.dns.getHosts")
+        || count(commands) != 1 || !all(root.children, c => nc_namespace_inherited(e: c))
+        || !all(root.children, c => c.name == "Errors" || c.name == "Warnings" || c.name == "RequestedCommand" || c.name == "CommandResponse" || c.name == "Server" || c.name == "GMTTimeDifference" || c.name == "ExecutionTime") {
+        NamecheapHostsRefused { reason: "Namecheap did not return an unambiguous successful getHosts envelope" }
+      } else {
+        match commands.first() {
+          Present { value: command } => nc_command(e: command, domain: domain)
+          Absent => NamecheapHostsRefused { reason: "Namecheap command response is missing" }
+        }
+      }
+  }
+}