diff --git a/DESCRIPTION b/DESCRIPTION index aa03742..7a9fefe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,15 +1,14 @@ Package: clandnstine Type: Package Title: Perform Secure-by-default 'DNS' Queries -Version: 0.1.0 -Date: 2019-01-18 +Version: 0.2.0 +Date: 2019-05-26 Authors@R: c( person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5670-2640")) ) Maintainer: Bob Rudis -Description: Something something 'DNS. Something something 'TLS'. - Something something 'getdns API/library'. +Description: Perform and process 'DNS over TLS' and 'DNS over HTTPS' queries. SystemRequirements: C++11; libgetdns v1.5.1 or higher URL: https://gitlab.com/hrbrmstr/clandnstine BugReports: https://gitlab.com/hrbrmstr/clandnstine/issues @@ -24,7 +23,9 @@ Imports: jsonlite, Rcpp, magrittr, - glue + glue, + httr, + R6 Roxygen: list(markdown = TRUE) RoxygenNote: 6.1.1 LinkingTo: diff --git a/NAMESPACE b/NAMESPACE index a3663c5..355e09f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,8 @@ S3method(print,gctx) S3method(print,gdns_response) export("%>%") +export(doh_post) +export(doh_servers) export(gdns_context) export(gdns_get_address) export(gdns_get_hosts) @@ -24,6 +26,8 @@ export(gdns_set_tls_ca_path) export(gdns_set_transports) export(gdns_update_resolvers) export(is_gctx) +import(R6) +import(httr) importFrom(Rcpp,sourceCpp) importFrom(glue,glue_data) importFrom(jsonlite,fromJSON) diff --git a/R/DNSHeader-class.R b/R/DNSHeader-class.R new file mode 100644 index 0000000..3e50dfb --- /dev/null +++ b/R/DNSHeader-class.R @@ -0,0 +1,83 @@ +R6Class( + + classname = "DNSHeader", + + public = list( + + q = NULL, + a = NULL, + id = NULL, + auth = NULL, + bitmap = 0L, + qr = NULL, + opcode = NULL, + aa = NULL, + tc = NULL, + rd = NULL, + ra = NULL, + z = NULL, + ad = NULL, + ar = NULL, + cd = NULL, + rcode = NULL, + + set_rd = function(val) { + + bits(self$bitmap, 8) <- as.integer(val) + + }, + + initialize = function(id = NULL, bitmap = NULL, q = 0L, + a = 0L, auth = 0L, ar = 0L, ...) { + + self$id <- id %||% sample(0:65535, 1) + + self$bitmap <- bitmap %||% 0L + if (is.null(bitmap)) self$set_rd(1L) + + self$q <- q + self$a <- a + self$auth <- auth + self$ar <- ar + + valid <- c("qr", "opcode", "aa", "tc", "rd", "ra", "z", "ad", "cd", "rcode") + + args <- list(...) + args <- setNames(args, tolower(colnames(args))) + args <- Filter(Negate(is.null), args[valid]) + + for (n in names(args)) self[[n]] <- args[[n]] + + }, + + parse = function(buf, buf_pos = 1L) { + + self$id <- readBin(buf[buf_pos:(buf_pos+1)], "int", size = 2, endian = "big") + self$bitmap <- readBin(buf[(buf_pos+2):(buf_pos+3)], "int", size = 2, endian = "big") + self$q <- readBin(buf[(buf_pos+4):(buf_pos+5)], "int", size = 2, endian = "big") + self$a <- readBin(buf[(buf_pos+6):(buf_pos+7)], "int", size = 2, endian = "big") + self$auth <- readBin(buf[(buf_pos+8):(buf_pos+9)], "int", size = 2, endian = "big") + self$ar <- readBin(buf[(buf_pos+10):(buf_pos+11)], "int", size = 2, endian = "big") + + attr(self, "buflen") <- 12L + + self + + }, + + pack = function() { + + c( + writeBin(as.integer(self$id), raw(), size = 2, endian = "big"), + writeBin(as.integer(self$bitmap), raw(), size = 2, endian = "big"), + writeBin(as.integer(self$q), raw(), size = 2, endian = "big"), + writeBin(as.integer(self$a), raw(), size = 2, endian = "big"), + writeBin(as.integer(self$auth), raw(), size = 2, endian = "big"), + writeBin(as.integer(self$ar), raw(), size = 2, endian = "big") + ) + + } + + ) + +) -> DNSHeader diff --git a/R/DNSLabel-class.R b/R/DNSLabel-class.R new file mode 100644 index 0000000..06a712b --- /dev/null +++ b/R/DNSLabel-class.R @@ -0,0 +1,43 @@ +R6Class( + + classname = "DNSLabel", + + public = list( + + label = NULL, + + initialize = function(label) { + + if (inherits(label, "DNSLabel")) { + + self$label <- label$label + + } else if (length(label) > 1) { + + self$label <- as.character(label) + + } else if (is.character(label)) { + label <- sub("\\.$", "", label) + self$label <- unlist(strsplit(label, "\\."), use.names = FALSE) + } + + }, + + encode = function() { + + sz <- nchar(self$label) + out <- raw() + for (i in seq_along(self$label)) { + out <- c(out, as.raw(sz[[i]]), charToRaw(self$label[[i]])) + } + c(out, as.raw(0x00)) + + }, + + parse = function(buf, buf_pos) { + + } + + ) + +) -> DNSLabel diff --git a/R/DNSQuestion-class.R b/R/DNSQuestion-class.R new file mode 100644 index 0000000..0238ef7 --- /dev/null +++ b/R/DNSQuestion-class.R @@ -0,0 +1,51 @@ +R6Class( + + classname = "DNSQuestion", + + public = list( + + qname = NULL, + qtype = NULL, + qclass = NULL, + + initialize = function(qname = NULL, qtype = 1L, qclass = 1L) { + + if (inherits(qname, "DNSLabel")) { + self$qname <- qname + } else { + if (length(qname)) self$qname <- DNSLabel$new(qname) + } + + self$qtype <- qtype + self$qclass <- qclass + + }, + + pack = function() { + c( + self$qname$encode(), + writeBin(as.integer(self$qtype), raw(), size = 2, endian = "big"), + writeBin(as.integer(self$qclass), raw(), size = 2, endian = "big") + ) + }, + + parse = function(buf, buf_pos = 1L) { + + ret <- DNSLabel$new()$parse(buf, buf_pos) + + self$qname <- ret + + buf_pos <- buf_pos + attr(ret, "buflen") + + self$qtype <- readBin(buf[buf_pos:(buf_pos+1)], "int", size = 2, endian = "big") + self$qclass <- readBin(buf[(buf_pos+2):(buf_pos+3)], "int", size = 2, endian = "big") + + attr(self, "buflen") <- attr(ret, "buflen") + 4L + + self + + } + + ) + +) -> DNSQuestion diff --git a/R/DNSRecord-class.R b/R/DNSRecord-class.R new file mode 100644 index 0000000..7548d14 --- /dev/null +++ b/R/DNSRecord-class.R @@ -0,0 +1,90 @@ +R6Class( + + classname = "DNSRecord", + + public = list( + + header = NULL, + questions = list(), + rr = list(), + auth = list(), + ar = list(), + + initialize = function(header = NULL, questions = NULL, + rr = NULL, q = NULL, a = NULL, + auth = NULL, ar = NULL) { + + self$header <- header %||% DNSHeader$new() + self$questions <- questions %||% list() + self$rr <- rr %||% list() + self$auth <- auth %||% list() + self$ar <- ar %||% list() + + if (length(q)) self$questions <- append(self$questions, q) + if (length(a)) self$rr <- append(self$rr, a) + + self$set_header_qa() + + }, + + question = function(qname, qtype = "A", qclass = "IN") { + DNSRecord$new( + q = DNSQuestion$new( + qname = qname, + qtype = .qtype[toupper(qtype)], + qclass = .class[toupper(qclass)] + ) + ) + }, + + parse = function(buf, buf_pos = 1L) { + + #self$header <- NULL + self$questions <- list() + self$rr <- list() + self$auth <- list() + self$ar <- list() + + buf_pos <- 1L + + ret <- DNSHeader$new()$parse(buf) + + self$header <- ret + + buf_pos <- attr(ret, "buflen") + 1L + + message(buf_pos) + + self$questions <- lapply(1:self$header$q, function(.idx) { + + ret <- DNSQuestion$new()$parse(buf, buf_pos) + buf_pos <<- buf_pos + attr(ret, "buflen") + ret + + }) + + self + + }, + + # Reset header q/a/auth/ar counts to match numver of records (normally done transparently) + + set_header_qa = function() { + self$header$q <- length(self$questions) + self$header$a <- length(self$rr) + self$header$auth <- length(self$auth) + self$header$ar <- length(self$ar) + }, + + pack = function() { + out <- self$header$pack() + for (q in self$questions) out <- c(out, q$pack()) + out + } + + ), + + private = list( + ) + +) -> DNSRecord diff --git a/R/RcppExports.R b/R/RcppExports.R index d88e055..242a805 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -137,6 +137,10 @@ int_gdns_get_root_servers <- function(gctx) { .Call(`_clandnstine_int_gdns_get_root_servers`, gctx) } +int_dns_wire_to_list <- function(buf) { + .Call(`_clandnstine_int_dns_wire_to_list`, buf) +} + #' Test whether an object is an external pointer #' #' @param x object to test diff --git a/R/clandnstine-package.R b/R/clandnstine-package.R index 5a19be4..fb468d8 100644 --- a/R/clandnstine-package.R +++ b/R/clandnstine-package.R @@ -1,4 +1,4 @@ -#' Perform Secure-by-default 'DNS' Queries +#' Perform Secure-by-Default 'DNS' Queries #' #' Something something 'DNS. Something something 'TLS'. #' Something something 'getdns API/library'. @@ -11,6 +11,7 @@ #' @docType package #' @author Bob Rudis (bob@@rud.is) #' @keywords internal +#' @import httr R6 #' @importFrom glue glue_data #' @importFrom jsonlite fromJSON #' @useDynLib clandnstine, .registration = TRUE diff --git a/R/doh-query.R b/R/doh-query.R new file mode 100644 index 0000000..f9dead7 --- /dev/null +++ b/R/doh-query.R @@ -0,0 +1,46 @@ +#' Make a DoH Request (POST/wireformat) +#' +#' Issue a `POST` wireformat query of type `type` for `name` to +#' the DoH endpoint specified at `server_path`. +#' +#' @param name name to query for +#' @param type DNS query type (defaults to "`A`") +#' @param server_path full URL path to the DoH server quer endpoint (defaults to Quad9). +#' @return `NULL` (if the query failed) or a `data.frame` (tibble) +#' @references +#' @export +#' @examples +#' doh_post("rud.is", "A") +doh_post <- function(name, type = "A", server_path = "https://dns.quad9.net/dns-query") { + + DNSRecord$new()$question( + qname = tolower(name[1]), + qtype = toupper(type[1]), + qclass = "IN" + ) -> q + + # now, send it off to the server + + httr::POST( + url = server_path[1], + httr::add_headers( + `Content-Type` = "application/dns-message", + `Accept` = "application/dns-message" + ), + encode = "raw", + body = q$pack() + ) -> res + + httr::stop_for_status(res) + + res <- int_dns_wire_to_list(httr::content(res, as = "raw")) + + if (length(res)) { + out <- jsonlite::fromJSON(res) + # class(out) <- c("gdns_response", "list") + out + } else { + NULL + } + +} diff --git a/R/globals.R b/R/globals.R new file mode 100644 index 0000000..723910c --- /dev/null +++ b/R/globals.R @@ -0,0 +1,118 @@ +c( + 'A' = 1L, 'NS' = 2L, 'CNAME' = 5L, 'SOA' = 6L, 'PTR' = 12L, 'HINFO' = 13L, + 'MX' = 15L, 'TXT' = 16L, 'RP' = 17L, 'AFSDB' = 18L, 'SIG' = 24L, + 'KEY' = 25L, 'AAAA' = 28L, 'LOC' = 29, 'SRV' = 33L, 'NAPTR' = 35L, + 'KX' = 36L, 'CERT' = 37L, 'A6' = 38L, 'DNAME' = 39L, 'OPT' = 41, + 'APL' = 42L, 'DS' = 43L, 'SSHFP' = 44L, 'IPSECKEY' = 45L, 'RRSIG' = 46L, + 'NSEC' = 47L, 'DNSKEY' = 48L, 'DHCID' = 49L, 'NSEC3' = 50L, + 'NSEC3PARAM' = 51L, 'TLSA' = 52L, 'HIP' = 55L, 'CDS' = 59L, + 'CDNSKEY' = 60L, 'OPENPGPKEY' = 61L, 'SPF' = 99L, 'TKEY' = 249L, + 'TSIG' = 250L, 'IXFR' = 251L, 'AXFR' = 252L, 'ANY' = 255L, + 'URI' = 256L, 'CAA' = 257L, 'TA' = 32768L, 'DLV' = 32769L +) -> .qtype + +c( + 'IN' = 1L, + 'CS' = 2L, + 'CH' = 3L, + 'Hesiod' = 4L, + 'None' = 254L, + '*' = 255L +) -> .class + +.qr <- c('QUERY' = 0, 'RESPONSE' = 1) + +c( + 'NOERROR' = 0L, + 'FORMERR' = 1L, + 'SERVFAIL' = 2L, + 'NXDOMAIN' = 3L, + 'NOTIMP' = 4L, + 'REFUSED' = 5L, + 'YXDOMAIN' = 6L, + 'YXRRSET' = 7L, + 'NXRRSET' = 8L, + 'NOTAUTH' = 9L, + 'NOTZONE' = 10L +) -> .rcode + +c( + 'QUERY' = 0L, + 'IQUERY' = 1L, + 'STATUS' = 2L, + 'UPDATE' = 5L +) -> .opcode + +#' Built-in list of DoH Servers +#' +#' The `url` element has the URL for `GET`/`POST` requests and +#' the `extra_params` element has any needed query parameters +#' for `GET` requests. +#' +#' The list so far. +#' - `google`: +#' - `cloudflare`: +#' - `quad9`: +#' - `securedns_eu`: +#' - `dnswarden_adblock`: +#' - `dnswarden_uncensored`: +#' - `cleanbrowsing_security`: +#' - `cleanbrowsing_family`: +#' - `cleanbrowsing_adult`: +#' - `power_dns`: +#' - `appliedprivacy`: +#' +#' @docType data +#' @export +list( + google = list( + url = "https://dns.google.com/experimental", + extra_params = list() + ), + cloudflare = list( + url = "https://cloudflare-dns.com/dns-query", + extra_params = list( + cd = "false", + do = "true", + ct = "application/dns-json" + ) + ), + quad9 = list( + url = "https://dns.quad9.net/dns-query", + extra_params = list() + ), + securedns_eu = list( + url = "https://doh.securedns.eu/dns-query", + extra_params = list( + edns_client_subnet = NULL + ) + ), + dnswarden_adblock = list( + url = "https://doh.dnswarden.com/adblock", + extra_params = list() + ), + dnswarden_uncensored = list( + url = "https://doh.dnswarden.com/uncensored", + extra_params = list() + ), + cleanbrowsing_security = list( + url = "https://doh.cleanbrowsing.org/doh/security-filter/", + extra_params = list(cd = "false") + ), + cleanbrowsing_family = list( + url = "https://doh.cleanbrowsing.org/doh/family-filter/", + extra_params = list() + ), + cleanbrowsing_adult = list( + url = "https://doh.cleanbrowsing.org/doh/adult-filter/", + extra_params = list() + ), + power_dns = list( + url = "https://doh.powerdns.org", + extra_params = list() + ), + appliedprivacy = list( + url = "https://doh.appliedprivacy.net/query", + extra_params = list() + ) +) -> doh_servers \ No newline at end of file diff --git a/R/utils-infix-helpers.R b/R/utils-infix-helpers.R new file mode 100644 index 0000000..11e792d --- /dev/null +++ b/R/utils-infix-helpers.R @@ -0,0 +1,4 @@ +`%l0%` <- function(x, y) if (length(x) == 0) y else x +`%||%` <- function(x, y) if (is.null(x)) y else x +`%@%` <- function(x, name) attr(x, name, exact = TRUE) +`%nin%` <- function(x, table) match(x, table, nomatch = 0) == 0 diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..264fee3 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,9 @@ +"bits" <- function(object, bit) { + (object %/% (2^bit)) %% 2 +} + +"bits<-" <- function(object, bit, value) { + mask <- 2^bit + object <- object+(value - ((object %/% mask) %% 2))*mask + object +} diff --git a/README.Rmd b/README.Rmd index 62d8e52..7a1337f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -18,7 +18,7 @@ Perform Secure-by-default 'DNS' Queries ## Description -Something something 'DNS. Something something 'TLS'. Something something 'getdns API/library'. +Perform and process 'DNS over TLS' and 'DNS over HTTPS' queries. ## NOTE @@ -35,15 +35,15 @@ I've gotten this running on macOS and Ubuntu 16.04. For the latter I had to ensu ## TODO/WAT -I finally grok the getdns api so the package api is going to change wildly and fast. The default mode will be to perform queries using DNS over TLS but also supports UDP and TCP transports. +I finally grok the getdns api so the package api is going to change wildly and fast. The default mode will be to perform queries using DNS over TLS but also supports UDP and TCP transports along with support for DNS over HTTPS. ## Why? -Well, for starters, to help research DNS over TLS servers. Plus, for fun! +Well, for starters, to help research DNS over TLS/DNS over HTTPS servers. Plus, for fun! -If you're asking "Why DNS over TLS at all?" then "faux" privacy. Why "faux"? Well, _something_ is handing your query and that something knows your IP address and what you looked for. So, you're relying on the good faith, honest nature and technical capability of the destination server to not mess with you. I don't trust Cloudflare or Google and am witholding judgement on Quad9 either way (they've been doing good things and are less "look at how cool we are" than CF is). +If you're asking "Why DNS over TLS/HTTPS at all?" then "faux" privacy. Why "faux"? Well, _something_ is handing your query and that something knows your IP address and what you looked for. So, you're relying on the good faith, honest nature and technical capability of the destination server to not mess with you. I don't trust Cloudflare or Google and am witholding judgement on Quad9 either way (they've been doing good things and are less "look at how cool we are" than CF is). -Also "faux" in that you're going to be using a standard port (853) and a TLS session for the queries so your internet provider will know you're doing _something_ and the current, sorry state of SSL certificates, certificate authorities, and authoritarian companies and regimes combined means confidentiality and integrity are always kinda in question unless done super-well. +Also "faux" in that you're going to be using (for DoT) a standard port (853) and a TLS session for the queries so your internet provider will know you're doing _something_ and the current, sorry state of SSL certificates, certificate authorities, and authoritarian companies and regimes combined means confidentiality and integrity are always kinda in question unless done super-well. ## What's Different About This vs Regular DNS? @@ -85,6 +85,13 @@ It's stupid slow, consumes more CPU and bandwidth but forces adversaries to work The following functions are implemented: +### DNS over HTTPS + +- `doh_post`: Make a DoH Request (POST/wireformat) +- `doh_servers`: Built-in list of DoH servers. + +### DNS over TLS + - `gdns_context`: Create a gdns DNS over TLS context and populate it with a resolver for use in resolution functions - `gdns_get_address`: Resolve a host to an addrss - `gdns_get_resolution_type`: Get the current resolution type setting @@ -106,7 +113,9 @@ The following functions are implemented: ## Installation ```{r install-ex, eval=FALSE} -devtools::install_git("https://gitlab.com/hrbrmstr/clandnstine.git") +devtools::install_git("https://git.sr.ht/~hrbrmstr/clandnstine") +# or +devtools::install_gitlab("hrbrmstr/clandnstine.git") # or devtools::install_github("hrbrmstr/clandnstine") ``` @@ -155,6 +164,12 @@ sort(unlist(leno$replies_tree$answer[[1]]$rdata$txt_strings)) Yep. Advertising even in DNS `TXT` records (see item number 8). +### DOH + +```{r doh} +str(doh_post("rud.is")$answer) +``` + ## clandnstine Metrics ```{r cloc, echo=FALSE} diff --git a/README.md b/README.md index 540bf35..2f32770 100644 --- a/README.md +++ b/README.md @@ -11,8 +11,7 @@ Perform Secure-by-default ‘DNS’ Queries ## Description -Something something ‘DNS. Something something ’TLS’. Something something -‘getdns API/library’. +Perform and process ‘DNS over TLS’ and ‘DNS over HTTPS’ queries. ## NOTE @@ -29,7 +28,7 @@ install. I’ve gotten this running on macOS and Ubuntu 16.04. For the latter I had to ensure `libidn2-0-dev` and `libunbound-dev` were installed then had -to grab the 1.5.1 tarball (e.g. `aria2c +to grab the 1.5.1 tarball (e.g. `aria2c https://getdnsapi.net/releases/getdns-1-5-1/getdns-1.5.1.tar.gz`), extract it and `config`/`make`/`make install` (plus `ldconfig` after). @@ -37,33 +36,33 @@ extract it and `config`/`make`/`make install` (plus `ldconfig` after). I finally grok the getdns api so the package api is going to change wildly and fast. The default mode will be to perform queries using DNS -over TLS but also supports UDP and TCP transports. +over TLS but also supports UDP and TCP transports along with support for +DNS over HTTPS. ## Why? -Well, for starters, to help research DNS over TLS servers. Plus, for -fun\! +Well, for starters, to help research DNS over TLS/DNS over HTTPS +servers. Plus, for fun\! -If you’re asking “Why DNS over TLS at all?” then “faux” privacy. Why -“faux”? Well, *something* is handing your query and that something +If you’re asking “Why DNS over TLS/HTTPS at all?” then “faux” privacy. +Why “faux”? Well, *something* is handing your query and that something knows your IP address and what you looked for. So, you’re relying on the good faith, honest nature and technical capability of the destination server to not mess with you. I don’t trust Cloudflare or Google and am witholding judgement on Quad9 either way (they’ve been doing good things and are less “look at how cool we are” than CF is). -Also “faux” in that you’re going to be using a standard port (853) and a -TLS session for the queries so your internet provider will know you’re -doing *something* and the current, sorry state of SSL certificates, -certificate authorities, and authoritarian companies and regimes -combined means confidentiality and integrity are always kinda in +Also “faux” in that you’re going to be using (for DoT) a standard port +(853) and a TLS session for the queries so your internet provider will +know you’re doing *something* and the current, sorry state of SSL +certificates, certificate authorities, and authoritarian companies and +regimes combined means confidentiality and integrity are always kinda in question unless done super-well. ## What’s Different About This vs Regular DNS? Well, if we lookup the addresses for `yahoo.com` the old-fashioned way -it’s cleartext UDP on the - wire: +it’s cleartext UDP on the wire: 1 0.000000 10.1.10.57 → 10.1.10.200 DNS 80 Standard query 0x8af8 A yahoo.com OPT 2 0.003297 10.1.10.200 → 10.1.10.57 DNS 176 Standard query response 0x8af8 A yahoo.com A 72.30.35.10 A 98.138.219.231 A 72.30.35.9 A 98.137.246.7 A 98.138.219.232 A 98.137.246.8 OPT @@ -76,8 +75,7 @@ server forwards all queries to a custom DNS over TLS server since I really don’t trust any of the providers when it comes down to it. So, in reality for me, it’s even slower than the below — at least initially). -This is the same query via DNS over -TLS +This is the same query via DNS over TLS ``` 1 0.000000 10.1.10.57 → 9.9.9.9 TCP 78 52128 → 853 [SYN] Seq=0 Win=65535 Len=0 MSS=1460 WS=64 TSval=602885491 TSecr=0 SACK_PERM=1 TFO=R @@ -111,6 +109,13 @@ to work pretty hard to try to figure out what you’re looking for. The following functions are implemented: +### DNS over HTTPS + + - `doh_post`: Make a DoH Request (POST/wireformat) + - `doh_servers`: Built-in list of DoH servers. + +### DNS over TLS + - `gdns_context`: Create a gdns DNS over TLS context and populate it with a resolver for use in resolution functions - `gdns_get_address`: Resolve a host to an addrss @@ -146,7 +151,9 @@ The following functions are implemented: ## Installation ``` r -devtools::install_git("https://gitlab.com/hrbrmstr/clandnstine.git") +devtools::install_git("https://git.sr.ht/~hrbrmstr/clandnstine") +# or +devtools::install_gitlab("hrbrmstr/clandnstine.git") # or devtools::install_github("hrbrmstr/clandnstine") ``` @@ -158,7 +165,7 @@ library(clandnstine) # current version packageVersion("clandnstine") -## [1] '0.1.0' +## [1] '0.2.0' ``` ### Get an address(es) from a name: @@ -186,7 +193,7 @@ gdns_lib_version() ## (gdns_get_address(x, "rud.is")) -## [1] "2604:a880:800:10::6bc:2001" "104.236.112.222" +## [1] "2602:ff16:3::4dfb:9ac5" "172.93.49.183" (gdns_get_address(x, "yahoo.com")) ## [1] "2001:4998:58:1836::10" "2001:4998:58:1836::11" "2001:4998:c:1023::4" "2001:4998:c:1023::5" @@ -204,32 +211,48 @@ str(leno <- gdns_query(x, "lenovo.com", "txt"), 1) ## List of 5 ## $ answer_type : int 800 ## $ canonical_name: chr "lenovo.com." -## $ replies_full : int [1, 1:600] 165 144 129 128 0 1 0 8 0 0 ... +## $ replies_full : int [1, 1:762] 34 114 129 128 0 1 0 10 0 0 ... ## $ replies_tree :'data.frame': 1 obs. of 7 variables: ## $ status : int 900 ## - attr(*, "class")= chr [1:2] "gdns_response" "list" sort(unlist(leno$replies_tree$answer[[1]]$rdata$txt_strings)) -## [1] "a82c74b37aa84e7c8580f0e32f4d795d" -## [2] "ece42d7743c84d6889abda7011fe6f53" -## [3] "facebook-domain-verification=1r2am7c2bhzrxpqyt0mda0djoquqsi" -## [4] "google-site-verification=VxW_e6r_Ka7A518qfX2MmIMHGnkpGbnACsjSxKFCBw0" -## [5] "iHzQJvsKnyGP2Nm2qBgL3fyBJ0CC9z4GkY/flfk4EzLP8lPxWHDDPKqZWm1TkeF5kEIL+NotYOF1wo7JtUDXXw==" -## [6] "qh7hdmqm4lzs85p704d6wsybgrpsly0j" -## [7] "v=spf1 include:spf.messagelabs.com include:_netblocks.eloqua.com ~all" -## [8] "Visit www.lenovo.com/think for information about Lenovo products and services" +## [1] "a82c74b37aa84e7c8580f0e32f4d795d" +## [2] "ece42d7743c84d6889abda7011fe6f53" +## [3] "facebook-domain-verification=1r2am7c2bhzrxpqyt0mda0djoquqsi" +## [4] "google-site-verification=nGgukcp60rC-gFxMOJw1NHH0B4VnSchRrlfWV-He_tE" +## [5] "google-site-verification=sHIlSlj0U6UnCDkfHp1AolWgVEvDjWvc0TR4KaysD2c" +## [6] "google-site-verification=VxW_e6r_Ka7A518qfX2MmIMHGnkpGbnACsjSxKFCBw0" +## [7] "iHzQJvsKnyGP2Nm2qBgL3fyBJ0CC9z4GkY/flfk4EzLP8lPxWHDDPKqZWm1TkeF5kEIL+NotYOF1wo7JtUDXXw==" +## [8] "qh7hdmqm4lzs85p704d6wsybgrpsly0j" +## [9] "v=spf1 include:spf.messagelabs.com include:_netblocks.eloqua.com ~all" +## [10] "Visit www.lenovo.com/think for information about Lenovo products and services" ``` -Yep. Advertising even in DNS `TXT` records (see item number -8). +Yep. Advertising even in DNS `TXT` records (see item number 8). + +### DOH + +``` r +str(doh_post("rud.is")$answer) +## 'data.frame': 1 obs. of 5 variables: +## $ class: int 1 +## $ name : chr "rud.is." +## $ rdata:'data.frame': 1 obs. of 2 variables: +## ..$ ipv4_address: chr "172.93.49.183" +## ..$ rdata_raw :List of 1 +## .. ..$ : int 172 93 49 183 +## $ ttl : int 3600 +## $ type : int 1 +``` ## clandnstine Metrics | Lang | \# Files | (%) | LoC | (%) | Blank lines | (%) | \# Lines | (%) | | :--- | -------: | ---: | --: | ---: | ----------: | ---: | -------: | ---: | -| C++ | 3 | 0.21 | 608 | 0.65 | 196 | 0.62 | 138 | 0.27 | -| R | 10 | 0.71 | 306 | 0.33 | 68 | 0.22 | 280 | 0.54 | -| Rmd | 1 | 0.07 | 19 | 0.02 | 51 | 0.16 | 97 | 0.19 | +| C++ | 4 | 0.17 | 681 | 0.51 | 220 | 0.49 | 163 | 0.26 | +| R | 19 | 0.79 | 635 | 0.47 | 170 | 0.38 | 355 | 0.57 | +| Rmd | 1 | 0.04 | 21 | 0.02 | 56 | 0.13 | 105 | 0.17 | ## Code of Conduct diff --git a/man/clandnstine.Rd b/man/clandnstine.Rd index 1c415e0..4b54cdb 100644 --- a/man/clandnstine.Rd +++ b/man/clandnstine.Rd @@ -4,7 +4,7 @@ \name{clandnstine} \alias{clandnstine} \alias{clandnstine-package} -\title{Perform Secure-by-default 'DNS' Queries} +\title{Perform Secure-by-Default 'DNS' Queries} \description{ Something something 'DNS. Something something 'TLS'. Something something 'getdns API/library'. diff --git a/man/doh_post.Rd b/man/doh_post.Rd new file mode 100644 index 0000000..b162e68 --- /dev/null +++ b/man/doh_post.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doh-query.R +\name{doh_post} +\alias{doh_post} +\title{Make a DoH Request (POST/wireformat)} +\usage{ +doh_post(name, type = "A", + server_path = "https://dns.quad9.net/dns-query") +} +\arguments{ +\item{name}{name to query for} + +\item{type}{DNS query type (defaults to "\code{A}")} + +\item{server_path}{full URL path to the DoH server quer endpoint (defaults to Quad9).} +} +\value{ +\code{NULL} (if the query failed) or a \code{data.frame} (tibble) +} +\description{ +Issue a \code{POST} wireformat query of type \code{type} for \code{name} to +the DoH endpoint specified at \code{server_path}. +} +\examples{ +doh_post("rud.is", "A") +} +\references{ +\url{https://tools.ietf.org/id/draft-ietf-doh-dns-over-https-05.html} +} diff --git a/man/doh_servers.Rd b/man/doh_servers.Rd new file mode 100644 index 0000000..1b86393 --- /dev/null +++ b/man/doh_servers.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/globals.R +\docType{data} +\name{doh_servers} +\alias{doh_servers} +\title{Built-in list of DoH Servers} +\format{An object of class \code{list} of length 11.} +\usage{ +doh_servers +} +\description{ +The \code{url} element has the URL for \code{GET}/\code{POST} requests and +the \code{extra_params} element has any needed query parameters +for \code{GET} requests. +} +\details{ +The list so far. +\itemize{ +\item \code{google}: \url{https://dns.google.com/experimental} +\item \code{cloudflare}: \url{https://cloudflare-dns.com/dns-query} +\item \code{quad9}: \url{https://dns.quad9.net/dns-query} +\item \code{securedns_eu}: \url{https://doh.securedns.eu/dns-query} +\item \code{dnswarden_adblock}: \url{https://doh.dnswarden.com/adblock} +\item \code{dnswarden_uncensored}: \url{https://doh.dnswarden.com/uncensored} +\item \code{cleanbrowsing_security}: \url{https://doh.cleanbrowsing.org/doh/security-filter/} +\item \code{cleanbrowsing_family}: \url{https://doh.cleanbrowsing.org/doh/family-filter/} +\item \code{cleanbrowsing_adult}: \url{https://doh.cleanbrowsing.org/doh/adult-filter/} +\item \code{power_dns}: \url{https://doh.powerdns.org} +\item \code{appliedprivacy}: \url{https://doh.appliedprivacy.net/query} +} +} +\keyword{datasets} diff --git a/src/.vscode/ipch/fbe8796a0b446fa3/mmap_address.bin b/src/.vscode/ipch/fbe8796a0b446fa3/mmap_address.bin new file mode 100644 index 0000000..71307ab Binary files /dev/null and b/src/.vscode/ipch/fbe8796a0b446fa3/mmap_address.bin differ diff --git a/src/.vscode/ipch/fbe8796a0b446fa3/resolver.ipch b/src/.vscode/ipch/fbe8796a0b446fa3/resolver.ipch new file mode 100644 index 0000000..9a2a83d Binary files /dev/null and b/src/.vscode/ipch/fbe8796a0b446fa3/resolver.ipch differ diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 24d8e77..9068532 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -188,6 +188,17 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// int_dns_wire_to_list +CharacterVector int_dns_wire_to_list(SEXP buf); +RcppExport SEXP _clandnstine_int_dns_wire_to_list(SEXP bufSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type buf(bufSEXP); + rcpp_result_gen = Rcpp::wrap(int_dns_wire_to_list(buf)); + return rcpp_result_gen; +END_RCPP +} // check_is_xptr void check_is_xptr(SEXP s); RcppExport SEXP _clandnstine_check_is_xptr(SEXP sSEXP) { @@ -286,6 +297,7 @@ static const R_CallMethodDef CallEntries[] = { {"_clandnstine_gdns_set_tls_ca_path", (DL_FUNC) &_clandnstine_gdns_set_tls_ca_path, 2}, {"_clandnstine_gdns_set_tls_ca_file", (DL_FUNC) &_clandnstine_gdns_set_tls_ca_file, 2}, {"_clandnstine_int_gdns_get_root_servers", (DL_FUNC) &_clandnstine_int_gdns_get_root_servers, 1}, + {"_clandnstine_int_dns_wire_to_list", (DL_FUNC) &_clandnstine_int_dns_wire_to_list, 1}, {"_clandnstine_check_is_xptr", (DL_FUNC) &_clandnstine_check_is_xptr, 1}, {"_clandnstine_is_null_xptr_", (DL_FUNC) &_clandnstine_is_null_xptr_, 1}, {"_clandnstine_int_gdns_context", (DL_FUNC) &_clandnstine_int_gdns_context, 1}, diff --git a/src/from-wire.cpp b/src/from-wire.cpp new file mode 100644 index 0000000..9757339 --- /dev/null +++ b/src/from-wire.cpp @@ -0,0 +1,45 @@ +#include + +#include +#include + +#include + +using namespace Rcpp; + +// [[Rcpp::export]] +CharacterVector int_dns_wire_to_list(SEXP buf) { + + getdns_return_t r; + bool ok = true; + + getdns_dict *resp; + std::string out; + + r = getdns_wire2msg_dict(RAW(buf), LENGTH(buf), &resp); + + if (r == GETDNS_RETURN_GOOD) { + + char *charout = getdns_print_json_dict(resp, 0); + + if (charout) { + out = std::string(charout); + free(charout); + } else { + ok = false; + } + + } else { + ok = false; + } + + if (resp) getdns_dict_destroy(resp); + + if (ok) return(wrap(out)); else return(CharacterVector()); + +} + +// getdns_wire2rr_dict ( const uint8_t * wire, +// size_t wire_sz, +// getdns_dict ** rr_dict +// )