diff --git a/DESCRIPTION b/DESCRIPTION index 2135cd5b..a76a658b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,6 +26,7 @@ Imports: jsonlite, lifecycle, openssl (>= 2.0.0), + PKI, packrat (>= 0.6), renv (>= 1.0.0), rlang (>= 1.0.0), diff --git a/NEWS.md b/NEWS.md index 8d0b2cd3..e63be671 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # rsconnect (development version) +* Use internally computed SHA1 sums and PKI signing when SHA1 is disabled + in FIPS mode (#768, #1054) + # rsconnect 1.2.1 * Restore the `LC_TIME` locale after computing an RFC-2616 date. (#1035) diff --git a/R/http.R b/R/http.R index 467fa744..79f07ae7 100644 --- a/R/http.R +++ b/R/http.R @@ -501,9 +501,7 @@ signatureHeaders <- function(authInfo, method, path, file = NULL) { der = TRUE ) - # OpenSSL defaults to sha1 hash function (which is what we need) - rawsig <- openssl::signature_create(charToRaw(canonicalRequest), key = private_key) - signature <- openssl::base64_encode(rawsig) + signature <- signRequestPrivateKey(private_key, canonicalRequest) } else { stop("can't sign request: no shared secret or private key") } @@ -516,6 +514,20 @@ signatureHeaders <- function(authInfo, method, path, file = NULL) { headers } +signRequestPrivateKey <- function(private_key, canonicalRequest) { + # convert key into PKI format for signing, note this only accepts RSA, but + # that's what rsconnect generates already + pem <- openssl::write_pem(private_key) + pem_lines <- readLines(textConnection(pem)) + pki_key <- PKI::PKI.load.key(pem_lines, format = "PEM") + + # use sha1 digest and then sign. digest and PKI avoid using system openssl which + # can be problematic in strict FIPS environments + digested <- digest::digest(charToRaw(canonicalRequest), "sha1", serialize = FALSE, raw = TRUE) + rawsig <- PKI::PKI.sign(key = pki_key, digest = digested) + openssl::base64_encode(rawsig) +} + rfc2616Date <- function(time = Sys.time()) { # set locale to POSIX/C to ensure ASCII date old <- Sys.getlocale("LC_TIME") diff --git a/tests/testthat/_snaps/http.md b/tests/testthat/_snaps/http.md index 98543ef0..3b3530ff 100644 --- a/tests/testthat/_snaps/http.md +++ b/tests/testthat/_snaps/http.md @@ -22,7 +22,7 @@ Output List of 3 $ Date : chr "Thu, 09 Mar 2023 14:29:00 GMT" - $ X-Auth-Signature : chr "tqz4HGcSmuWKIGzIj42OEkwYZQzfJBdrUynlBQKSEEok2zMFZwsgEpEzU8PzpoeMEmcX5+Cr1IuDLLASz0ivAQ==" + $ X-Auth-Signature : chr "mk4e1sdK0Gy9Uex2nJMtkntdT/boQWRakSRB6iYw9hmP2zMHQjvynY+Kc5hqbGAK7tbzG52fC+5MQSOUapNKBF6GNnVe1cp2jFq4pmhEL2yhlkB"| __truncated__ $ X-Content-Checksum: chr "1B2M2Y8AsgTpgAmY7PhCfg==" # includes body in error if available diff --git a/tests/testthat/test-http.R b/tests/testthat/test-http.R index 39b42485..afbe3d94 100644 --- a/tests/testthat/test-http.R +++ b/tests/testthat/test-http.R @@ -22,13 +22,59 @@ test_that("authHeaders() picks correct method based on supplied fields", { ) # Dummy key created with - # openssl::base64_encode(openssl::ed25519_keygen()) - key <- "MC4CAQAwBQYDK2VwBCIEIDztfEgkp5CX7Jz0NCyrToaRW1L2tfmrWxNDgYyjO9bQ" + # openssl::base64_encode(openssl::rsa_keygen(2048L)) + key_string <- "-----BEGIN PRIVATE KEY----- +MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQC/eiSQAKXADslq +GGsbsQu2eEgEHD06BtUhaeU1nvsY7a6u12xpG0OAGYWhnGhR+1K/3qoZQQNmN0MC +ZV0zhueREu3YaqtNwXbnbGCqp7tsLsx2cb2TZscmBNXkOLah2PlsBTfInNlKrpKH +wsMtsL7yruXwJ767ey8JujMAqO90jj57idfhkr4IU47EL8DiIHTOAYLddKe/d4AL +skoEFQM37SJ9JUwZUsvz2eqEXFPV4QrS93T79sA7QfH5zOYTLKPEDxV0U7AYUVKW +bBieVRlu3DIQfdsqXwYYzHUR+HBlxe1VowCS5p5c6coNLdb+RElcSSY2Gd06eBg0 +wSoxkyT3AgMBAAECggEAHmQinYCczkkKiv5pMbH+K+4XcB+TUDx5Y55NNR+Qtzoy +eanTmTMsmY5zeV076Zc8YRvUX8HD6ltnFWBFVMJaytn4SltT6TmFx+GZzjxlMRyU +c1BGSLkNbulhkaG2yyWHITAK1Jqgmovu0gGFvSDKjfZYpK+KRHOe2apmIfquVw9d +6CLm7swx30x8qFKEACc3iM/Mcc9uKOWn+NjVKqUVfU/9ZmNxmjZ9e3wkwieI1mSB +gq9q7fmCHHkGWbUkGMphgRyssaJbz+bn/Wz2uwevvtebkTOzvWtKhUGgDByCCCtq +J1ehPCjdRjylb6C5tLbyeng5QnYC7uZJmRsEOUwMEQKBgQD6PsHXwKJ8JRlDGu4G +JQ9fKzYA+B+No0GKtGuuRDD8tJouj5rb1dZt181UHUW/UtjNpz8j8l1RN2gPcu/v +VjwSXDcZHohv4cgQfRCN47wREEEb/LP/fhxIt2H320vh5qvwdJJoGvGoJfR5vO1X +ysdIPBajIgnEo4U7cawaNfeS1QKBgQDD4WgXUb0AYvK6lggVVqgNzxxMQRWCQSGb +y4RISHlC2TpftpbLFdr6fHuf8bzGq462xG5MFMMGBsbESXKNW18QA+uIBIDwttaj +AfQ4+PNu4m+2Ump+RcGu2MYoBJoxjMx00Ba76cEMF0+X+RO4zcfwZ6Y869Fakq+D +7rn4ZetGmwKBgQCMtgsjeUMkUWwCCrt6ow4gslh8dQixCPKKvuapp9hv0FG+CqvG +H1iijSz8tjUI3tnf0cI0QUztpR0TSsrVpoTCwi2NJ1kKqEdp1hkf38VZRu2FgjPo +Xw4iaVNiHmJt1NorrDDC7xuhNC5i4bQHoJMr7/W+px4c/uGkykc+ucfLPQKBgQCG +/E/KOibgHFAfawLZCaW4FnDuz68t2wp5HY/kbCU8fwxuJxrVixMjqSNcfq9TzagE +pWtI/MnE3midnevWJBBnrfvi+Q+OUsGpBdCybkT7tgm8ACGpMRMfFf3AWCOWX+wJ +19jC2HyTg4DzPs9rfEv7jMIPm4bjPtC7P4li94FiXwKBgBTh5tPUEvG0chZvqRT2 +g0vvWgJGF52FCXBij3dnNl1eNRQYbDI+hNbZYcHCKHKaOoDWaqYhyjLk6Tz0LhLe +XWAlOP6tE2UbEgi10wyaEI9EyfXg1mgiHlSg+oZMCx05TUE6PrzddS6qUOJfN7P3 +a3hEFijsjg/+FDMr+iAVzjry +-----END PRIVATE KEY-----" + key <- openssl::base64_encode(openssl::read_key(key_string)) expect_snapshot({ str(authHeaders(list(secret = "123"), url, "GET")) str(authHeaders(list(private_key = key), url, "GET")) }) + + # and that signRequestPrivateKey() is the same as openssl equivalent + # authHeaders does this conversion internally + private_key <- openssl::read_key( + openssl::base64_decode(key), + der = TRUE + ) + + # an alternative implementation with openssl + signRequestPrivateKeyOpenSSL <- function(private_key, canonicalRequest) { + rawsig <- openssl::signature_create(charToRaw(canonicalRequest), key = private_key) + openssl::base64_encode(rawsig) + } + + expect_identical( + signRequestPrivateKey(private_key, url), + signRequestPrivateKeyOpenSSL(private_key, url) + ) }) test_that("can add user specific headers", {