R/credentials.R

In gert: Simple Git Client for R

#' @importFrom openssl write_ssh write_pem write_pkcs1 write_openssh_pem
#' @importFrom credentials ssh_key_info git_credential_forget ssh_read_key
#' @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())

    # 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, "")
  }
}

#' @importFrom credentials git_credential_ask
make_cred_cb <- function(password = askpass, verbose = TRUE){
  if(!is.character(password) && !is.function(password)){
    stop("Password parameter must be string or callback function")
  }
  function(url, username, retries){
    # Case of hardcoded (string) password
    if(is.character(password)){
      if(!length(username) || is.na(username)){
        stop("To use a hardcoded password, include your username in the URL like 'https://jerry@github.com")
      }
      return(c(username, password))
    }

    # Look for GITHUB_PAT variable
    if(retries < 2){
      github_pat <- Sys.getenv('GITHUB_PAT')
      if(nchar(github_pat) > 0 && grepl('^https?://([^/]*@)?github.com', url)){
        return(c("git", github_pat))
      }
    }

    # Retrieve a password from the credential manager
    if(retries > 2){
      try(git_credential_forget(url))
    }
    cred <- try(git_credential_ask(url, verbose = verbose), silent = !verbose)
    if(inherits(cred, 'git_credential')){
      return(c(cred$username, cred$password))
    }

    # If that doesn't work try to manually prompt
    if(!length(username) || is.na(username)){
      password(sprintf("Please enter username for %s", url))
    }
    pwd <- password(sprintf("Please enter a PAT or password for %s", url))
    as.character(c(username, pwd))
  }
}

remote_to_host <- function(repo, remote){
  rms <- git_remote_list(repo = repo)
  url <- rms[rms$name == remote, ]$url
  if(length(url)){
    url_to_host(url)
  }
}

url_to_host <- function(url){
  credentials:::parse_url(url, allow_ssh = TRUE)[['host']]
}