Refactor to avoid non-api call (#230)

Author: jeroen

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: gert
 Title: Simple Git Client for R
-Version: 2.0.2
+Version: 2.1.0
 Authors@R: c(
     person("Jeroen", "Ooms", role = c("aut", "cre"), email = "jeroen@berkeley.edu",
       comment = c(ORCID = "0000-0002-4035-0289")),

NEWS

@@ -1,6 +1,7 @@
-2.0.2
+2.1.0
   - Workaround for accidental API change in libgit2 1.8.0
-  - Disable a non-api call in R >= 4.5.0 for now
+  - Refactor authentication callbacks to work around new "non-api"
+    calls in R >= 4.5.0. Hopefully no breakage.
 
 2.0.1
   - Fix a printf warning for cran

R/credentials.R

@@ -3,28 +3,30 @@
 #' @importFrom askpass askpass
 make_key_cb <- function(ssh_key = NULL, host = NULL, password = askpass){
   function(){
-    if(is.null(ssh_key)){
-      ssh_key <- try(ssh_key_info(host = host, auto_keygen = FALSE)$key)
-      if(inherits(ssh_key, "try-error"))
-        return(NULL)
-    }
-    key <- tryCatch(ssh_read_key(ssh_key, password = password), error = function(e){
-      stop(sprintf("Unable to load key: %s", ssh_key), call. = FALSE)
-    })
-    # NB: need to add ID for buggy libssh2: https://github.com/libgit2/libgit2/issues/5162
-    writeLines(paste(write_ssh(key$pubkey), "git@localhost"), tmp_pub <- tempfile())
+    try({
+      if(is.null(ssh_key)){
+        ssh_key <- try(ssh_key_info(host = host, auto_keygen = FALSE)$key)
+        if(inherits(ssh_key, "try-error"))
+          return(NULL)
+      }
+      key <- tryCatch(ssh_read_key(ssh_key, password = password), error = function(e){
+        stop(sprintf("Unable to load key: %s", ssh_key), call. = FALSE)
+      })
+      # NB: need to add ID for buggy libssh2: https://github.com/libgit2/libgit2/issues/5162
+      writeLines(paste(write_ssh(key$pubkey), "git@localhost"), tmp_pub <- tempfile())
 
-    # NB: pkcs1 is the only format that works on all libssh2 configurations
-    tmp_key <- if(inherits(key, c("rsa", "dsa", "ecdsa"))){
-      write_pkcs1(key, tempfile())
-    } else {
-      write_openssh_pem(key, tempfile())
-    }
-    if(.Platform$OS.type == "unix"){
-      Sys.chmod(tmp_pub, '0644')
-      Sys.chmod(tmp_key, '0400')
-    }
-    c(tmp_pub, tmp_key, "")
+      # NB: pkcs1 is the only format that works on all libssh2 configurations
+      tmp_key <- if(inherits(key, c("rsa", "dsa", "ecdsa"))){
+        write_pkcs1(key, tempfile())
+      } else {
+        write_openssh_pem(key, tempfile())
+      }
+      if(.Platform$OS.type == "unix"){
+        Sys.chmod(tmp_pub, '0644')
+        Sys.chmod(tmp_key, '0400')
+      }
+      c(tmp_pub, tmp_key, "")
+    })
   }
 }
 

src/clone.c

@@ -81,11 +81,19 @@ static char* get_password(SEXP cb, const char *url, const char **username, int r
 static int get_key_files(SEXP cb, auth_key_data *out, int verbose){
   if(!Rf_isFunction(cb))
     Rf_error("cb must be a function");
-  int err;
+  int err = 0;
   SEXP call = PROTECT(Rf_lcons(cb, R_NilValue));
   SEXP res = PROTECT(verbose ? R_tryEval(call, R_GlobalEnv, &err) :
                        R_tryEvalSilent(call, R_GlobalEnv, &err));
+  if(res && Rf_inherits(res, "try-error")){
+    static char custom_callback_error[1000] = {0};
+    snprintf(custom_callback_error, 999, "SSH authentication failure: %s", CHAR(STRING_ELT(res, 0)));
+    giterr_set_str(GIT_ERROR_CALLBACK, custom_callback_error);
+    UNPROTECT(2);
+    return -1;
+  }
   if(err || !Rf_isString(res)){
+    giterr_set_str(GIT_ERROR_CALLBACK, "Failed to read local SSH key from callback function");
     UNPROTECT(2);
     return -1;
   }
@@ -171,7 +179,7 @@ static int auth_callback(git_cred **cred, const char *url, const char *username,
   auth_callback_data_t *cb_data = payload;
   const char * ssh_user = username ? username : "git";
   int verbose = cb_data->verbose;
-  char custom_callback_error[1000] = "Authentication failure";
+  git_error_clear();
 
 #if AT_LEAST_LIBGIT2(0, 20)
 
@@ -200,11 +208,6 @@ static int auth_callback(git_cred **cred, const char *url, const char *username,
                                key_data.key_path, key_data.pass_phrase)){
         print_if_verbose("Trying to authenticate '%s' using provided ssh-key...\n", ssh_user);
         return 0;
-#if R_VERSION < 263424
-        //TODO: better fallback for this non-API call in R 4.5....
-      } else if(R_curErrorBuf()){
-        snprintf(custom_callback_error, 999, "SSH authentication failure: %s", R_curErrorBuf());
-#endif
       }
     }
 
@@ -230,6 +233,7 @@ static int auth_callback(git_cred **cred, const char *url, const char *username,
       char *pass = get_password(cb_data->getcred, url, &username, cb_data->retries);
       if(!username || !pass){
         print_if_verbose("Credential lookup failed\n");
+        giterr_set_str(GIT_ERROR_CALLBACK, "HTTPS Authentication failure");
         goto failure;
       } else {
         return git_cred_userpass_plaintext_new(cred, username, pass);
@@ -238,7 +242,6 @@ static int auth_callback(git_cred **cred, const char *url, const char *username,
   }
   print_if_verbose("All authentication methods failed\n");
 failure:
-  giterr_set_str(GIT_ERROR_CALLBACK, custom_callback_error);
   return GIT_EAUTH;
 }