context xptr working

DESCRIPTION

@@ -23,7 +23,8 @@ Depends:
 Imports:
     httr,
     jsonlite,
-    Rcpp
+    Rcpp,
+    magrittr
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 6.1.1
 LinkingTo: 

NAMESPACE

@@ -1,7 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,gctx)
+export("%>%")
+export(gdns_get_address)
+export(gdns_resolver)
 export(get_address)
 import(httr)
 importFrom(Rcpp,sourceCpp)
 importFrom(jsonlite,fromJSON)
+importFrom(magrittr,"%>%")
 useDynLib(clandnstine, .registration = TRUE)

R/RcppExports.R

@@ -14,3 +14,46 @@ get_address <- function(host, resolver = "9.9.9.9") {
     .Call(`_clandnstine_get_address`, host, resolver)
 }
 
+#' Test whether an object is an external pointer
+#'
+#' @param x object to test
+check_is_xptr <- function(s) {
+    invisible(.Call(`_clandnstine_check_is_xptr`, s))
+}
+
+#' Test whether an external pointer is null
+#'
+#' @param x object to test
+is_null_xptr_ <- function(s) {
+    .Call(`_clandnstine_is_null_xptr_`, s)
+}
+
+#' Create a gdns DNS over TLS context and populate it with a resolver
+#' for use in resolution functions
+#'
+#' @param resolver length 1 <chr> of a valid DNS over TLS resolver;
+#'        Defaults to Quad9 (`9.9.9.9`).
+#' @export
+#' @examples
+#' x <- gdns_resolver()
+gdns_resolver <- function(resolver = "9.9.9.9") {
+    .Call(`_clandnstine_gdns_resolver`, resolver)
+}
+
+#' Resolve a host to an addrss
+#'
+#' @param gctx gdns resolver context created with [gdns_resolver()]
+#' @param host to lookup
+#' @export
+#' @examples
+#' x <- gdns_resolver()
+#' gdns_get_address(x, "yahoo.com")
+#' x %>% gdns_get_address("yahoo.com")
+gdns_get_address <- function(gctx, host) {
+    .Call(`_clandnstine_gdns_get_address`, gctx, host)
+}
+
+int_get_resolvers <- function(gctx) {
+    .Call(`_clandnstine_int_get_resolvers`, gctx)
+}
+

R/print-context.R

@@ -0,0 +1,13 @@
+#' Printer for gdns contexts
+#'
+#' @param x gdns context object
+#' @param ... unused
+#' @keywords internal
+#' @export
+print.gctx <- function(x, ...) {
+  if (is_null_xptr_(x)) {
+    cat("<gdns resolver context (INVALID)>\n")
+  } else {
+    cat("<gdns resolver context; resolvers: ", int_get_resolvers(x) ,">\n", sep="")
+  }
+}

R/utils-pipe.R

@@ -0,0 +1,11 @@
+#' Pipe operator
+#'
+#' See \code{magrittr::\link[magrittr]{\%>\%}} for details.
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+NULL

man/check_is_xptr.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RcppExports.R
+\name{check_is_xptr}
+\alias{check_is_xptr}
+\title{Test whether an object is an external pointer}
+\usage{
+check_is_xptr(s)
+}
+\arguments{
+\item{x}{object to test}
+}
+\description{
+Test whether an object is an external pointer
+}

man/clandnstine.Rd

@@ -4,8 +4,12 @@
 \name{clandnstine}
 \alias{clandnstine}
 \alias{clandnstine-package}
-\title{...}
+\title{Perform 'DNS' over 'TLS' Queries}
 \description{
+Something something 'DNS. Something something 'TLS'.
+Something something 'getdns API/library'.
+}
+\details{
 \itemize{
 \item URL: \url{https://gitlab.com/hrbrmstr/clandnstine}
 \item BugReports: \url{https://gitlab.com/hrbrmstr/clandnstine/issues}

man/gdns_get_address.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RcppExports.R
+\name{gdns_get_address}
+\alias{gdns_get_address}
+\title{Resolve a host to an addrss}
+\usage{
+gdns_get_address(gctx, host)
+}
+\arguments{
+\item{gctx}{gdns resolver context created with \code{\link[=gdns_resolver]{gdns_resolver()}}}
+
+\item{host}{to lookup}
+}
+\description{
+Resolve a host to an addrss
+}
+\examples{
+x <- gdns_resolver()
+gdns_get_address(x, "yahoo.com")
+x \%>\% gdns_get_address("yahoo.com")
+}

man/gdns_resolver.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RcppExports.R
+\name{gdns_resolver}
+\alias{gdns_resolver}
+\title{Create a gdns DNS over TLS context and populate it with a resolver
+for use in resolution functions}
+\usage{
+gdns_resolver(resolver = "9.9.9.9")
+}
+\arguments{
+\item{resolver}{length 1 <chr> of a valid DNS over TLS resolver;
+Defaults to Quad9 (\code{9.9.9.9}).}
+}
+\description{
+Create a gdns DNS over TLS context and populate it with a resolver
+for use in resolution functions
+}
+\examples{
+x <- gdns_resolver()
+}

man/is_null_xptr_.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RcppExports.R
+\name{is_null_xptr_}
+\alias{is_null_xptr_}
+\title{Test whether an external pointer is null}
+\usage{
+is_null_xptr_(s)
+}
+\arguments{
+\item{x}{object to test}
+}
+\description{
+Test whether an external pointer is null
+}

man/pipe.Rd

@@ -0,0 +1,12 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils-pipe.R
+\name{\%>\%}
+\alias{\%>\%}
+\title{Pipe operator}
+\usage{
+lhs \%>\% rhs
+}
+\description{
+See \code{magrittr::\link[magrittr]{\%>\%}} for details.
+}
+\keyword{internal}

man/print.gctx.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/print-context.R
+\name{print.gctx}
+\alias{print.gctx}
+\title{Printer for gdns contexts}
+\usage{
+\method{print}{gctx}(x, ...)
+}
+\arguments{
+\item{x}{gdns context object}
+
+\item{...}{unused}
+}
+\description{
+Printer for gdns contexts
+}
+\keyword{internal}

src/RcppExports.cpp

@@ -17,9 +17,69 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// check_is_xptr
+void check_is_xptr(SEXP s);
+RcppExport SEXP _clandnstine_check_is_xptr(SEXP sSEXP) {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXP >::type s(sSEXP);
+    check_is_xptr(s);
+    return R_NilValue;
+END_RCPP
+}
+// is_null_xptr_
+SEXP is_null_xptr_(SEXP s);
+RcppExport SEXP _clandnstine_is_null_xptr_(SEXP sSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXP >::type s(sSEXP);
+    rcpp_result_gen = Rcpp::wrap(is_null_xptr_(s));
+    return rcpp_result_gen;
+END_RCPP
+}
+// gdns_resolver
+SEXP gdns_resolver(std::string resolver);
+RcppExport SEXP _clandnstine_gdns_resolver(SEXP resolverSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< std::string >::type resolver(resolverSEXP);
+    rcpp_result_gen = Rcpp::wrap(gdns_resolver(resolver));
+    return rcpp_result_gen;
+END_RCPP
+}
+// gdns_get_address
+CharacterVector gdns_get_address(SEXP gctx, std::string host);
+RcppExport SEXP _clandnstine_gdns_get_address(SEXP gctxSEXP, SEXP hostSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXP >::type gctx(gctxSEXP);
+    Rcpp::traits::input_parameter< std::string >::type host(hostSEXP);
+    rcpp_result_gen = Rcpp::wrap(gdns_get_address(gctx, host));
+    return rcpp_result_gen;
+END_RCPP
+}
+// int_get_resolvers
+CharacterVector int_get_resolvers(SEXP gctx);
+RcppExport SEXP _clandnstine_int_get_resolvers(SEXP gctxSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXP >::type gctx(gctxSEXP);
+    rcpp_result_gen = Rcpp::wrap(int_get_resolvers(gctx));
+    return rcpp_result_gen;
+END_RCPP
+}
 
 static const R_CallMethodDef CallEntries[] = {
     {"_clandnstine_get_address", (DL_FUNC) &_clandnstine_get_address, 2},
+    {"_clandnstine_check_is_xptr", (DL_FUNC) &_clandnstine_check_is_xptr, 1},
+    {"_clandnstine_is_null_xptr_", (DL_FUNC) &_clandnstine_is_null_xptr_, 1},
+    {"_clandnstine_gdns_resolver", (DL_FUNC) &_clandnstine_gdns_resolver, 1},
+    {"_clandnstine_gdns_get_address", (DL_FUNC) &_clandnstine_gdns_get_address, 2},
+    {"_clandnstine_int_get_resolvers", (DL_FUNC) &_clandnstine_int_get_resolvers, 1},
     {NULL, NULL, 0}
 };
 

src/clandnstine-main.cpp

@@ -59,7 +59,7 @@ CharacterVector get_address(std::string host, std::string resolver = "9.9.9.9")
       r = getdns_list_get_dict(addrs, i, &cur_addr);
       r = getdns_dict_get_bindata(cur_addr, "address_data", &address);
 
-      if (address->size == 4 || address->size == 16) { // this is unlikely
+      if (address->size == 4 || address->size == 16) { // this is unlikely to be bad
         char *addr_str = getdns_display_ip_address(address);
         out.push_back(addr_str);
         if (addr_str) free(addr_str);

src/resolver.cpp

@@ -0,0 +1,192 @@
+#include <Rcpp.h>
+#include <getdns/getdns.h>
+#include <getdns/getdns_extra.h>
+#include <arpa/inet.h>
+using namespace Rcpp;
+
+//' Test whether an object is an external pointer
+//'
+//' @param x object to test
+// [[Rcpp::export]]
+void check_is_xptr(SEXP s) {
+  if (TYPEOF(s) != EXTPTRSXP) {
+    Rf_error("expected an externalptr");
+  }
+}
+
+//' Test whether an external pointer is null
+//'
+//' @param x object to test
+// [[Rcpp::export]]
+SEXP is_null_xptr_(SEXP s) {
+  check_is_xptr(s);
+  return Rf_ScalarLogical(R_ExternalPtrAddr(s) == NULL);
+}
+
+static void gctx_finalizer(SEXP ptr) {
+  if(!R_ExternalPtrAddr(ptr)) return;
+  getdns_context *ctxt = (getdns_context *)R_ExternalPtrAddr(ptr);
+  if (ptr) getdns_context_destroy(ctxt);
+  R_ClearExternalPtr(ptr); /* not really needed */
+}
+
+//' Create a gdns DNS over TLS context and populate it with a resolver
+//' for use in resolution functions
+//'
+//' @param resolver length 1 <chr> of a valid DNS over TLS resolver;
+//'        Defaults to Quad9 (`9.9.9.9`).
+//' @export
+//' @examples
+//' x <- gdns_resolver()
+// [[Rcpp::export]]
+SEXP gdns_resolver(std::string resolver = "9.9.9.9") {
+
+  bool ok = false;
+  SEXP ptr;
+  getdns_return_t r;
+  getdns_context *ctxt = NULL;
+
+  getdns_dict *resolver_dict = getdns_dict_create();
+  r = getdns_str2dict(resolver.c_str(), &resolver_dict);
+
+  getdns_list *resolver_list = getdns_list_create();
+  r = getdns_list_set_dict(resolver_list, 0, resolver_dict);
+
+  getdns_transport_list_t tls_transport[] = { GETDNS_TRANSPORT_TLS };
+
+  if ((r = getdns_context_create(&ctxt, 1))) {
+  } else if ((r = getdns_context_set_dns_transport_list(ctxt, 1, tls_transport))) {
+  } else if ((r = getdns_context_set_upstream_recursive_servers(ctxt, resolver_list))) {
+  } else if ((r = getdns_context_set_resolution_type(ctxt, GETDNS_RESOLUTION_STUB))) {
+  } else {
+    ok = true;
+  }
+
+  if (ok) {
+    ptr = R_MakeExternalPtr(ctxt, Rf_install("gctx"), R_NilValue);
+    R_RegisterCFinalizerEx(ptr, gctx_finalizer, TRUE);
+    Rf_setAttrib(ptr, Rf_install("class"), Rf_mkString("gctx"));
+    return(ptr);
+  } else {
+    return(R_NilValue);
+  }
+
+}
+
+//' Resolve a host to an addrss
+//'
+//' @param gctx gdns resolver context created with [gdns_resolver()]
+//' @param host to lookup
+//' @export
+//' @examples
+//' x <- gdns_resolver()
+//' gdns_get_address(x, "yahoo.com")
+//' x %>% gdns_get_address("yahoo.com")
+// [[Rcpp::export]]
+CharacterVector gdns_get_address(SEXP gctx, std::string host) {
+
+  uint32_t err;
+  size_t sz;
+  getdns_return_t r;
+  getdns_dict *resp = NULL;
+  getdns_list *addrs;
+  std::vector< std::string > out;
+  bool ok = false;
+
+  getdns_context *ctxt = (getdns_context *)R_ExternalPtrAddr(gctx);
+
+  if (gctx == NULL) return(CharacterVector());
+
+  if ((r = getdns_address_sync(ctxt, host.c_str(), NULL, &resp))) {
+  } else if ((r = getdns_dict_get_int(resp, "status", &err))) {
+  } else if (err != GETDNS_RESPSTATUS_GOOD) {
+  } else if ((r = getdns_dict_get_list(resp, "just_address_answers", &addrs))) {
+  } else if (r != GETDNS_RETURN_GOOD) {
+  } else if ((r = getdns_list_get_length(addrs, &sz))) {
+  } else {
+    ok = true;
+  }
+
+  if (ok) {
+
+    out.reserve(sz);
+
+    for (size_t i = 0; i < sz; ++i) {
+
+      getdns_dict *cur_addr;
+      getdns_bindata *address;
+
+      r = getdns_list_get_dict(addrs, i, &cur_addr);
+      r = getdns_dict_get_bindata(cur_addr, "address_data", &address);
+
+      if (address->size == 4 || address->size == 16) { // this is unlikely to be bad
+        char *addr_str = getdns_display_ip_address(address);
+        out.push_back(addr_str);
+        if (addr_str) free(addr_str);
+      }
+
+    }
+
+    out.shrink_to_fit();
+
+  }
+
+  if (resp) getdns_dict_destroy(resp);
+
+  if (ok) return(wrap(out)); else return(CharacterVector());
+
+}
+
+// [[Rcpp::export]]
+CharacterVector int_get_resolvers(SEXP gctx) {
+
+  bool ok = false;
+  size_t sz;
+  getdns_list *addrs;
+  std::vector< std::string > out;
+
+  getdns_context *ctxt = (getdns_context *)R_ExternalPtrAddr(gctx);
+  if (gctx == NULL) return(CharacterVector());
+
+  getdns_return_t r;
+
+  if ((r = getdns_context_get_upstream_recursive_servers(ctxt, &addrs))) {
+  } else if (r != GETDNS_RETURN_GOOD) {
+  } else if ((r = getdns_list_get_length(addrs, &sz))) {
+  } else {
+    ok = true;
+  }
+
+  if (ok) {
+
+    out.reserve(sz);
+
+    for (size_t i = 0; i < sz; ++i) {
+
+      getdns_dict *cur_addr;
+      getdns_bindata *address;
+
+      r = getdns_list_get_dict(addrs, i, &cur_addr);
+      r = getdns_dict_get_bindata(cur_addr, "address_data", &address);
+
+      if (address->size == 4 || address->size == 16) { // this is unlikely to be bad
+        char *addr_str = getdns_display_ip_address(address);
+        out.push_back(addr_str);
+        if (addr_str) free(addr_str);
+      }
+
+    }
+
+    out.shrink_to_fit();
+
+  }
+
+  if (addrs) getdns_list_destroy(addrs);
+
+  if (ok) return(wrap(out)); else return(CharacterVector());
+
+}
+
+
+
+

tests/testthat/test-clandnstine.R

@@ -1,6 +1,7 @@
-context("minimal package functionality")
+context("basic wrapper works")
 test_that("we can do something", {
 
-  #expect_that(some_function(), is_a("data.frame"))
+  x <- get_address("example.com")
+  expect_true(all(c("2606:2800:220:1:248:1893:25c8:1946", "93.184.216.34") %in% x))
 
 })