Addresses #27: Adds support for making SSL connections to redis via hiredis 1.0.0+

R/config.R

@@ -65,12 +65,15 @@ redis_config <- function(..., config = list(...)) {
   ##   2 arg and char/int, unnamed (assume host/port?)
   defaults <- list(
                 url = Sys_getenv("REDIS_URL", NULL),
-                scheme = "redis",
+                scheme = Sys_getenv("REDIS_CONNECTION_SCHEME", "redis"),
                 host = Sys_getenv("REDIS_HOST", "127.0.0.1"),
                 port = as.integer(Sys_getenv("REDIS_PORT", 6379L)),
                 path = NULL,
                 password = NULL,
-                db = NULL)
+                db = NULL,
+				CApath = Sys_getenv("REDIS_SSL_CA_PATH", NULL),
+				certPath = Sys_getenv("REDIS_SSL_CERT_PATH", NULL),
+				keyPath = Sys_getenv("REDIS_SSL_KEY_PATH", NULL))
   dots <- list(...)
   if (length(dots) > 0L && !identical(dots, config)) {
     warning("Ignoring dots in favour of config")

R/redis.R

@@ -5,6 +5,9 @@
 redis_connect <- function(config) {
   if (config$scheme == "redis") {
     ptr <- redis_connect_tcp(config$host, config$port)
+  } else if (config$scheme == "rediss")  {
+	ptr <- redis_connect_tcp_ssl(config$host, config$port, config$CApath,
+			                     config$certPath, config$keyPath)
   } else {
     ptr <- redis_connect_unix(config$path)
   }
@@ -21,6 +24,11 @@ redis_connect_tcp <- function(host, port) {
   .Call(Credux_redis_connect, host, as.integer(port))
 }
 
+redis_connect_tcp_ssl <- function(host, port, CApath, certPath, keyPath) {
+	.Call(Credux_redis_connect_ssl, host, as.integer(port), 
+			CApath, certPath, keyPath)
+}
+
 redis_connect_unix <- function(path) {
   .Call(Credux_redis_connect_unix, path)
 }

src/Makevars.win

@@ -1,6 +1,6 @@
 # -*- makefile -*-
-PKG_CPPFLAGS=-I../windows/hiredis-0.9.2/include/hiredis -DSTRICT_R_HEADERS
-PKG_LIBS=-L../windows/hiredis-0.9.2/lib${R_ARCH} -lhiredis -lws2_32
+PKG_CPPFLAGS=-I../windows/hiredis-1.0.0/include/hiredis -DSTRICT_R_HEADERS
+PKG_LIBS=-L../windows/hiredis-1.0.0/lib${R_ARCH} -lhiredis -lhiredis_ssl -lssl -lcrypto -lcrypt32 -lws2_32
 
 all: clean winlibs
 

src/connection.c

@@ -22,6 +22,61 @@ SEXP redux_redis_connect(SEXP host, SEXP port) {
   return extPtr;
 }
 
+SEXP redux_redis_connect_ssl(SEXP host, SEXP port, SEXP CApath, 
+                             SEXP CERTpath, SEXP KEYpath) {
+
+  // hiredis SSL connection context and error var
+  redisSSLContext *redis_ssl_context;
+  redisSSLContextError redis_ssl_error;
+
+  // Initialise OpenSSL
+  redisInitOpenSSL();
+
+  // Set up the SSL connection parameters
+  redis_ssl_context = redisCreateSSLContext(
+    CHAR(STRING_ELT(CApath, 0)),
+    NULL, /* not providing path to trusted certs */
+    CHAR(STRING_ELT(CERTpath, 0)), 
+    CHAR(STRING_ELT(KEYpath, 0)), 
+    CHAR(STRING_ELT(host, 0)),
+    &redis_ssl_error);
+
+  if(redis_ssl_context == NULL || redis_ssl_error != 0) {
+    error("Failed to create SSL context: %s\n",
+      (redis_ssl_error != 0) ? 
+        redisSSLContextGetError(redis_ssl_error) : "Unknown error");
+  }
+
+  // Initiate a connection with redis
+  redisContext *context = redisConnect(CHAR(STRING_ELT(host, 0)),
+                                       INTEGER(port)[0]);
+  if (context == NULL) {
+    error("Creating context failed catastrophically [tcp_ssl]"); // # nocov
+  }
+  if (context->err != 0) {
+    const char * errstr = string_duplicate(context->errstr);
+    redisFree(context);
+
+    error("Failed to create context: %s", errstr);
+  }
+
+  // Now we have a connection established, we can negotiate the SSL connection
+  if (redisInitiateSSLWithContext(context, redis_ssl_context) != REDIS_OK) {
+        redisFreeSSLContext(redis_ssl_context);
+        if (context->err != 0) {
+          const char * errstr_ssl = string_duplicate(context->errstr);
+          redisFree(context);
+          error("Failed to initialize SSL connection: %s\n", errstr_ssl);
+        }
+        redisFree(context);
+        error("Failed to initialize SSL connection\n");
+  }
+  SEXP extPtr = PROTECT(R_MakeExternalPtr(context, host, R_NilValue));
+  R_RegisterCFinalizer(extPtr, redis_finalize);
+  UNPROTECT(1);
+  return extPtr;
+}
+
 SEXP redux_redis_connect_unix(SEXP path) {
   redisContext *context = redisConnectUnix(CHAR(STRING_ELT(path, 0)));
   if (context == NULL) {

src/connection.h

@@ -1,9 +1,12 @@
 #include <R.h>
 #include <Rinternals.h>
 #include <hiredis.h>
+#include <hiredis_ssl.h>
 #include <stdbool.h>
 
 SEXP redux_redis_connect(SEXP host, SEXP port);
+SEXP redux_redis_connect_ssl(SEXP host, SEXP port, 
+                             SEXP CApath, SEXP certPath, SEXP keyPath);
 SEXP redux_redis_connect_unix(SEXP path);
 
 SEXP redux_redis_command(SEXP extPtr, SEXP cmd);

src/registration.c

@@ -6,6 +6,7 @@
 
 static const R_CallMethodDef callMethods[] = {
   {"Credux_redis_connect",       (DL_FUNC) &redux_redis_connect,        2},
+  {"Credux_redis_connect_ssl",   (DL_FUNC) &redux_redis_connect_ssl,    5},
   {"Credux_redis_connect_unix",  (DL_FUNC) &redux_redis_connect_unix,   1},
 
   {"Credux_redis_command",       (DL_FUNC) &redux_redis_command,        2},

tools/winlibs.R

@@ -1,6 +1,6 @@
-if (!file.exists("../windows/hiredis-0.9.2/include/hiredis/hiredis.h")) {
+if (!file.exists("../windows/hiredis-1.0.0/include/hiredis/hiredis.h")) {
   if (getRversion() < "3.3.0") setInternet2()
-  download.file("https://github.com/rwinlib/hiredis/archive/v0.9.2.zip", "lib.zip", quiet = TRUE)
+  download.file("https://github.com/rwinlib/hiredis/archive/v1.0.0.zip", "lib.zip", quiet = TRUE)
   dir.create("../windows", showWarnings = FALSE)
   unzip("lib.zip", exdir = "../windows")
   unlink("lib.zip")