Use typed errors

jeroen · Oct 29, 2024 · 33f4dc6 · 33f4dc6
1 parent 2ef40cf
commit 33f4dc6
Show file tree

Hide file tree

Showing 6 changed files with 216 additions and 31 deletions.
diff --git a/R/errcodes.R b/R/errcodes.R
@@ -0,0 +1,36 @@
+# This file is autogenerated using make-errorcodes.R
+libcurl_error_codes <- 
+c("CURLE_UNSUPPORTED_PROTOCOL", "CURLE_FAILED_INIT", "CURLE_URL_MALFORMAT", 
+"CURLE_NOT_BUILT_IN", "CURLE_COULDNT_RESOLVE_PROXY", "CURLE_COULDNT_RESOLVE_HOST", 
+"CURLE_COULDNT_CONNECT", "CURLE_WEIRD_SERVER_REPLY", "CURLE_REMOTE_ACCESS_DENIED", 
+"CURLE_FTP_ACCEPT_FAILED", "CURLE_FTP_WEIRD_PASS_REPLY", "CURLE_FTP_ACCEPT_TIMEOUT", 
+"CURLE_FTP_WEIRD_PASV_REPLY", "CURLE_FTP_WEIRD_227_FORMAT", "CURLE_FTP_CANT_GET_HOST", 
+"CURLE_HTTP2", "CURLE_FTP_COULDNT_SET_TYPE", "CURLE_PARTIAL_FILE", 
+"CURLE_FTP_COULDNT_RETR_FILE", "CURLE_OBSOLETE20", "CURLE_QUOTE_ERROR", 
+"CURLE_HTTP_RETURNED_ERROR", "CURLE_WRITE_ERROR", "CURLE_OBSOLETE24", 
+"CURLE_UPLOAD_FAILED", "CURLE_READ_ERROR", "CURLE_OUT_OF_MEMORY", 
+"CURLE_OPERATION_TIMEDOUT", "CURLE_OBSOLETE29", "CURLE_FTP_PORT_FAILED", 
+"CURLE_FTP_COULDNT_USE_REST", "CURLE_OBSOLETE32", "CURLE_RANGE_ERROR", 
+"CURLE_HTTP_POST_ERROR", "CURLE_SSL_CONNECT_ERROR", "CURLE_BAD_DOWNLOAD_RESUME", 
+"CURLE_FILE_COULDNT_READ_FILE", "CURLE_LDAP_CANNOT_BIND", "CURLE_LDAP_SEARCH_FAILED", 
+"CURLE_OBSOLETE40", "CURLE_FUNCTION_NOT_FOUND", "CURLE_ABORTED_BY_CALLBACK", 
+"CURLE_BAD_FUNCTION_ARGUMENT", "CURLE_OBSOLETE44", "CURLE_INTERFACE_FAILED", 
+"CURLE_OBSOLETE46", "CURLE_TOO_MANY_REDIRECTS", "CURLE_UNKNOWN_OPTION", 
+"CURLE_SETOPT_OPTION_SYNTAX", "CURLE_OBSOLETE50", "CURLE_OBSOLETE51", 
+"CURLE_GOT_NOTHING", "CURLE_SSL_ENGINE_NOTFOUND", "CURLE_SSL_ENGINE_SETFAILED", 
+"CURLE_SEND_ERROR", "CURLE_RECV_ERROR", "CURLE_OBSOLETE57", "CURLE_SSL_CERTPROBLEM", 
+"CURLE_SSL_CIPHER", "CURLE_PEER_FAILED_VERIFICATION", "CURLE_BAD_CONTENT_ENCODING", 
+"CURLE_OBSOLETE62", "CURLE_FILESIZE_EXCEEDED", "CURLE_USE_SSL_FAILED", 
+"CURLE_SEND_FAIL_REWIND", "CURLE_SSL_ENGINE_INITFAILED", "CURLE_LOGIN_DENIED", 
+"CURLE_TFTP_NOTFOUND", "CURLE_TFTP_PERM", "CURLE_REMOTE_DISK_FULL", 
+"CURLE_TFTP_ILLEGAL", "CURLE_TFTP_UNKNOWNID", "CURLE_REMOTE_FILE_EXISTS", 
+"CURLE_TFTP_NOSUCHUSER", "CURLE_OBSOLETE75", "CURLE_OBSOLETE76", 
+"CURLE_SSL_CACERT_BADFILE", "CURLE_REMOTE_FILE_NOT_FOUND", "CURLE_SSH", 
+"CURLE_SSL_SHUTDOWN_FAILED", "CURLE_AGAIN", "CURLE_SSL_CRL_BADFILE", 
+"CURLE_SSL_ISSUER_ERROR", "CURLE_FTP_PRET_FAILED", "CURLE_RTSP_CSEQ_ERROR", 
+"CURLE_RTSP_SESSION_ERROR", "CURLE_FTP_BAD_FILE_LIST", "CURLE_CHUNK_FAILED", 
+"CURLE_NO_CONNECTION_AVAILABLE", "CURLE_SSL_PINNEDPUBKEYNOTMATCH", 
+"CURLE_SSL_INVALIDCERTSTATUS", "CURLE_HTTP2_STREAM", "CURLE_RECURSIVE_API_CALL", 
+"CURLE_AUTH_ERROR", "CURLE_HTTP3", "CURLE_QUIC_CONNECT_ERROR", 
+"CURLE_PROXY", "CURLE_SSL_CLIENTCERT", "CURLE_UNRECOVERABLE_POLL", 
+"CURLE_TOO_LARGE", "CURLE_ECH_REQUIRED")
diff --git a/R/utilities.R b/R/utilities.R
@@ -49,3 +49,22 @@ trimws <- function(x) {
 is_string <- function(x){
   is.character(x) && length(x)
 }
+
+# Callback for typed libcurl errors
+raise_libcurl_error <- function(errnum, message, errbuf = NULL, source_url = NULL){
+  error_code <- libcurl_error_codes[errnum]
+  if(length(url)){
+    host <- curl_parse_url(source_url)$host
+    if(length(host) && nchar(host))
+      message <- sprintf('%s [%s]', message, host)
+  }
+  if(length(errbuf) && nchar(errbuf)){
+    message <- sprintf('%s: %s', message, errbuf)
+  }
+  cl <- sys.call(-1)
+  e <- structure(
+    class = c(error_code, "libcurl_error", "error", "condition"),
+    list(message = message, call = cl)
+  )
+  stop(e)
+}
diff --git a/src/utils.c b/src/utils.c
@@ -38,39 +38,31 @@ void reset_errbuf(reference *ref){
 }
 
 void assert(CURLcode res){
-  if(res != CURLE_OK)
-    Rf_error("%s", curl_easy_strerror(res));
-}
-
-static char * parse_host(const char * input){
-  static char buf[8000] = {0};
-  char *url = buf;
-  strncpy(url, input, 7999);
-
-  char *ptr = NULL;
-  if((ptr = strstr(url, "://")))
-    url = ptr + 3;
-  if((ptr = strchr(url, '/')))
-    *ptr = 0;
-  if((ptr = strchr(url, '#')))
-    *ptr = 0;
-  if((ptr = strchr(url, '?')))
-    *ptr = 0;
-  if((ptr = strchr(url, '@')))
-    url = ptr + 1;
-  return url;
+  if(res == CURLE_OK)
+    return;
+  SEXP code = PROTECT(Rf_ScalarInteger(res));
+  SEXP message = PROTECT(make_string(curl_easy_strerror(res)));
+  SEXP expr = PROTECT(Rf_install("raise_libcurl_error"));
+  SEXP call = PROTECT(Rf_lang3(expr, code, message));
+  Rf_eval(call, R_FindNamespace(Rf_mkString("curl")));
+  UNPROTECT(4);
+  Rf_error("Failed to raise gert S3 error (%s)", curl_easy_strerror(res));
 }
 
 void assert_status(CURLcode res, reference *ref){
-  // Customize better error message for timeoutsS
-  if(res == CURLE_OPERATION_TIMEDOUT || res == CURLE_SSL_CACERT){
-    const char *url = NULL;
-    if(curl_easy_getinfo(ref->handle, CURLINFO_EFFECTIVE_URL, &url) == CURLE_OK){
-      Rf_error("%s: [%s] %s", curl_easy_strerror(res), parse_host(url), ref->errbuf);
-    }
-  }
-  if(res != CURLE_OK)
-    Rf_error("%s", strlen(ref->errbuf) ? ref->errbuf : curl_easy_strerror(res));
+  if(res == CURLE_OK)
+    return;
+  const char *source_url = NULL;
+  curl_easy_getinfo(ref->handle, CURLINFO_EFFECTIVE_URL, &source_url);
+  SEXP url = PROTECT(make_string(source_url));
+  SEXP code = PROTECT(Rf_ScalarInteger(res));
+  SEXP message = PROTECT(make_string(curl_easy_strerror(res)));
+  SEXP errbuf = PROTECT(make_string(ref->errbuf));
+  SEXP expr = PROTECT(Rf_install("raise_libcurl_error"));
+  SEXP call = PROTECT(Rf_lang5(expr, code, message, errbuf, url));
+  Rf_eval(call, R_FindNamespace(Rf_mkString("curl")));
+  UNPROTECT(6);
+  Rf_error("Failed to raise gert S3 error (%s)", curl_easy_strerror(res));
 }
 
 void massert(CURLMcode res){

diff --git a/tests/testthat/test-handle.R b/tests/testthat/test-handle.R
@@ -134,7 +134,7 @@ test_that("Custom vector options", {
 
 test_that("Timeout error includes hostname", {
   h <- new_handle(timeout = 1L)
-  expect_error(curl_fetch_memory('https://httpbin.org/delay/10', handle = h), 'Timeout was reached: [httpbin.org] ', fixed = TRUE)
+  expect_error(curl_fetch_memory('https://httpbin.org/delay/10', handle = h), 'Timeout was reached [httpbin.org]', fixed = TRUE)
 })
 
 test_that("Platform specific features", {

diff --git a/tools/errorcodes.txt b/tools/errorcodes.txt
@@ -0,0 +1,128 @@
+CURLE_OK = 0,
+CURLE_UNSUPPORTED_PROTOCOL,    /* 1 */
+CURLE_FAILED_INIT,             /* 2 */
+CURLE_URL_MALFORMAT,           /* 3 */
+CURLE_NOT_BUILT_IN,            /* 4 - [was obsoleted in August 2007 for 7.17.0, reused in April 2011 for 7.21.5] */
+CURLE_COULDNT_RESOLVE_PROXY,   /* 5 */
+CURLE_COULDNT_RESOLVE_HOST,    /* 6 */
+CURLE_COULDNT_CONNECT,         /* 7 */
+CURLE_WEIRD_SERVER_REPLY,      /* 8 */
+CURLE_REMOTE_ACCESS_DENIED,    /* 9 a service was denied by the server
+                                  due to lack of access - when login fails
+                                  this is not returned. */
+CURLE_FTP_ACCEPT_FAILED,       /* 10 - [was obsoleted in April 2006 for
+                                  7.15.4, reused in Dec 2011 for 7.24.0]*/
+CURLE_FTP_WEIRD_PASS_REPLY,    /* 11 */
+CURLE_FTP_ACCEPT_TIMEOUT,      /* 12 - timeout occurred accepting server
+                                  [was obsoleted in August 2007 for 7.17.0,
+                                  reused in Dec 2011 for 7.24.0]*/
+CURLE_FTP_WEIRD_PASV_REPLY,    /* 13 */
+CURLE_FTP_WEIRD_227_FORMAT,    /* 14 */
+CURLE_FTP_CANT_GET_HOST,       /* 15 */
+CURLE_HTTP2,                   /* 16 - A problem in the http2 framing layer.
+                                  [was obsoleted in August 2007 for 7.17.0,
+                                  reused in July 2014 for 7.38.0] */
+CURLE_FTP_COULDNT_SET_TYPE,    /* 17 */
+CURLE_PARTIAL_FILE,            /* 18 */
+CURLE_FTP_COULDNT_RETR_FILE,   /* 19 */
+CURLE_OBSOLETE20,              /* 20 - NOT USED */
+CURLE_QUOTE_ERROR,             /* 21 - quote command failure */
+CURLE_HTTP_RETURNED_ERROR,     /* 22 */
+CURLE_WRITE_ERROR,             /* 23 */
+CURLE_OBSOLETE24,              /* 24 - NOT USED */
+CURLE_UPLOAD_FAILED,           /* 25 - failed upload "command" */
+CURLE_READ_ERROR,              /* 26 - could not open/read from file */
+CURLE_OUT_OF_MEMORY,           /* 27 */
+CURLE_OPERATION_TIMEDOUT,      /* 28 - the timeout time was reached */
+CURLE_OBSOLETE29,              /* 29 - NOT USED */
+CURLE_FTP_PORT_FAILED,         /* 30 - FTP PORT operation failed */
+CURLE_FTP_COULDNT_USE_REST,    /* 31 - the REST command failed */
+CURLE_OBSOLETE32,              /* 32 - NOT USED */
+CURLE_RANGE_ERROR,             /* 33 - RANGE "command" did not work */
+CURLE_HTTP_POST_ERROR,         /* 34 */
+CURLE_SSL_CONNECT_ERROR,       /* 35 - wrong when connecting with SSL */
+CURLE_BAD_DOWNLOAD_RESUME,     /* 36 - could not resume download */
+CURLE_FILE_COULDNT_READ_FILE,  /* 37 */
+CURLE_LDAP_CANNOT_BIND,        /* 38 */
+CURLE_LDAP_SEARCH_FAILED,      /* 39 */
+CURLE_OBSOLETE40,              /* 40 - NOT USED */
+CURLE_FUNCTION_NOT_FOUND,      /* 41 - NOT USED starting with 7.53.0 */
+CURLE_ABORTED_BY_CALLBACK,     /* 42 */
+CURLE_BAD_FUNCTION_ARGUMENT,   /* 43 */
+CURLE_OBSOLETE44,              /* 44 - NOT USED */
+CURLE_INTERFACE_FAILED,        /* 45 - CURLOPT_INTERFACE failed */
+CURLE_OBSOLETE46,              /* 46 - NOT USED */
+CURLE_TOO_MANY_REDIRECTS,      /* 47 - catch endless re-direct loops */
+CURLE_UNKNOWN_OPTION,          /* 48 - User specified an unknown option */
+CURLE_SETOPT_OPTION_SYNTAX,    /* 49 - Malformed setopt option */
+CURLE_OBSOLETE50,              /* 50 - NOT USED */
+CURLE_OBSOLETE51,              /* 51 - NOT USED */
+CURLE_GOT_NOTHING,             /* 52 - when this is a specific error */
+CURLE_SSL_ENGINE_NOTFOUND,     /* 53 - SSL crypto engine not found */
+CURLE_SSL_ENGINE_SETFAILED,    /* 54 - can not set SSL crypto engine as
+                                  default */
+CURLE_SEND_ERROR,              /* 55 - failed sending network data */
+CURLE_RECV_ERROR,              /* 56 - failure in receiving network data */
+CURLE_OBSOLETE57,              /* 57 - NOT IN USE */
+CURLE_SSL_CERTPROBLEM,         /* 58 - problem with the local certificate */
+CURLE_SSL_CIPHER,              /* 59 - could not use specified cipher */
+CURLE_PEER_FAILED_VERIFICATION, /* 60 - peer's certificate or fingerprint
+                                   was not verified fine */
+CURLE_BAD_CONTENT_ENCODING,    /* 61 - Unrecognized/bad encoding */
+CURLE_OBSOLETE62,              /* 62 - NOT IN USE since 7.82.0 */
+CURLE_FILESIZE_EXCEEDED,       /* 63 - Maximum file size exceeded */
+CURLE_USE_SSL_FAILED,          /* 64 - Requested FTP SSL level failed */
+CURLE_SEND_FAIL_REWIND,        /* 65 - Sending the data requires a rewind
+                                  that failed */
+CURLE_SSL_ENGINE_INITFAILED,   /* 66 - failed to initialise ENGINE */
+CURLE_LOGIN_DENIED,            /* 67 - user, password or similar was not
+                                  accepted and we failed to login */
+CURLE_TFTP_NOTFOUND,           /* 68 - file not found on server */
+CURLE_TFTP_PERM,               /* 69 - permission problem on server */
+CURLE_REMOTE_DISK_FULL,        /* 70 - out of disk space on server */
+CURLE_TFTP_ILLEGAL,            /* 71 - Illegal TFTP operation */
+CURLE_TFTP_UNKNOWNID,          /* 72 - Unknown transfer ID */
+CURLE_REMOTE_FILE_EXISTS,      /* 73 - File already exists */
+CURLE_TFTP_NOSUCHUSER,         /* 74 - No such user */
+CURLE_OBSOLETE75,              /* 75 - NOT IN USE since 7.82.0 */
+CURLE_OBSOLETE76,              /* 76 - NOT IN USE since 7.82.0 */
+CURLE_SSL_CACERT_BADFILE,      /* 77 - could not load CACERT file, missing
+                                  or wrong format */
+CURLE_REMOTE_FILE_NOT_FOUND,   /* 78 - remote file not found */
+CURLE_SSH,                     /* 79 - error from the SSH layer, somewhat
+                                  generic so the error message will be of
+                                  interest when this has happened */
+
+CURLE_SSL_SHUTDOWN_FAILED,     /* 80 - Failed to shut down the SSL
+                                  connection */
+CURLE_AGAIN,                   /* 81 - socket is not ready for send/recv,
+                                  wait till it is ready and try again (Added
+                                  in 7.18.2) */
+CURLE_SSL_CRL_BADFILE,         /* 82 - could not load CRL file, missing or
+                                  wrong format (Added in 7.19.0) */
+CURLE_SSL_ISSUER_ERROR,        /* 83 - Issuer check failed.  (Added in
+                                  7.19.0) */
+CURLE_FTP_PRET_FAILED,         /* 84 - a PRET command failed */
+CURLE_RTSP_CSEQ_ERROR,         /* 85 - mismatch of RTSP CSeq numbers */
+CURLE_RTSP_SESSION_ERROR,      /* 86 - mismatch of RTSP Session Ids */
+CURLE_FTP_BAD_FILE_LIST,       /* 87 - unable to parse FTP file list */
+CURLE_CHUNK_FAILED,            /* 88 - chunk callback reported error */
+CURLE_NO_CONNECTION_AVAILABLE, /* 89 - No connection available, the
+                                  session will be queued */
+CURLE_SSL_PINNEDPUBKEYNOTMATCH, /* 90 - specified pinned public key did not
+                                   match */
+CURLE_SSL_INVALIDCERTSTATUS,   /* 91 - invalid certificate status */
+CURLE_HTTP2_STREAM,            /* 92 - stream error in HTTP/2 framing layer
+                                  */
+CURLE_RECURSIVE_API_CALL,      /* 93 - an api function was called from
+                                  inside a callback */
+CURLE_AUTH_ERROR,              /* 94 - an authentication function returned an
+                                  error */
+CURLE_HTTP3,                   /* 95 - An HTTP/3 layer problem */
+CURLE_QUIC_CONNECT_ERROR,      /* 96 - QUIC connection error */
+CURLE_PROXY,                   /* 97 - proxy handshake error */
+CURLE_SSL_CLIENTCERT,          /* 98 - client-side certificate required */
+CURLE_UNRECOVERABLE_POLL,      /* 99 - poll/select returned fatal error */
+CURLE_TOO_LARGE,               /* 100 - a value/data met its maximum */
+CURLE_ECH_REQUIRED,            /* 101 - ECH tried but failed */
+CURL_LAST /* never use! */
diff --git a/tools/make-errorcodes.R b/tools/make-errorcodes.R
@@ -0,0 +1,10 @@
+lines <- readLines('tools/errorcodes.txt')
+errors <- grep('^CURLE', lines, value = TRUE)[-1]
+error_codes <- sub(",.*", "", errors)
+stopifnot(error_codes[100] == "CURLE_TOO_LARGE")
+out <- file('R/errcodes.R', 'w')
+writeLines("# This file is autogenerated using make-errorcodes.R", out)
+writeLines("libcurl_error_codes <- ", out)
+dput(error_codes, out)
+close(out)
+