add SHA-256 support

git-svn-id: https://svn.r-project.org/R/trunk@87178 00db46b3-68df-0310-9c12-caf00c1e9a41

doc/NEWS.Rd

@@ -91,6 +91,9 @@
       \item \code{md5sum()} can be used to compute an MD5 hash of a raw
       vector of bytes by using the \code{bytes=} argument instead
       of \code{files=}. The two arguments are mutually exclusive.
+
+      \item Added \code{sha256sum()} analogous to \code{md5sum()},
+      but implementing the SHA-256 hashing algorithm.
     }
   }
 

src/library/tools/NAMESPACE

@@ -22,7 +22,7 @@ export("Adobe_glyphs", "HTMLheader", "Rcmd", "Rd2HTML", "pkg2HTML", "Rd2ex",
        "makevars_site", "makevars_user",
        "matchConcordance",
        nonS3methods,
-       "make_translations_pkg", "md5sum",
+       "make_translations_pkg", "md5sum", "sha256sum",
        package.dependencies,# R/package.dependencies.R man/package.dependencies.Rd
        getDepList, pkgDepends, installFoundDepends,# R/pkgDepends.R man/getDepList.Rd man/installFoundDepends.Rd
        vignetteDepends, # deprecated, too as it calls  getDepList()

src/library/tools/R/sha256.R

@@ -0,0 +1,109 @@
+#  File src/library/tools/R/sha256.R
+#  Part of the R package, https://www.R-project.org
+#
+#  Copyright (C) 1995-2024 The R Core Team
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  A copy of the GNU General Public License is available at
+#  https://www.R-project.org/Licenses/
+
+sha256sum <- function(files, bytes) {
+    if (!missing(files) && !missing(bytes))
+        stop("files and bytes are mutually exclusive")
+    if (!missing(bytes)) {
+        if (!is.raw(bytes)) stop("bytes must be a raw vector")
+        .Call(C_Rsha256, bytes)
+    } else {
+        files <- path.expand(files)
+        structure(.Call(C_Rsha256, files), names=files)
+    }
+}
+
+# The following fns are neither used nor exported - for now.
+
+.installSHA256sums <- function(pkgDir, outDir = pkgDir)
+{
+    dot <- getwd()
+    if (is.null(dot))
+        stop("current working directory cannot be ascertained")
+    setwd(pkgDir)
+    x <- sha256sum(dir(".", recursive=TRUE))
+    setwd(dot)
+    x <- x[names(x) != "SHA256"]
+    cat(paste(x, names(x), sep=" *"), sep="\n",
+        file=file.path(outDir, "SHA256"))
+}
+
+checkSHA256sums <- function(package, dir)
+{
+    if(missing(dir)) dir <- find.package(package, quiet = TRUE)
+    if(length(dir) != 1L) return(NA)
+    sha256file <- file.path(dir, "SHA256")
+    if(!file.exists(sha256file)) return(NA)
+    inlines <- readLines(sha256file)
+    ## now split on the first space.
+    xx <- sub("^([0-9a-fA-F]*)(.*)", "\\1", inlines)
+    nmxx <- names(xx) <- sub("^[0-9a-fA-F]* [ |*](.*)", "\\1", inlines)
+    dot <- getwd()
+    if (is.null(dot))
+        stop("current working directory cannot be ascertained")
+    setwd(dir)
+    x <- sha256sum(dir(dir, recursive = TRUE))
+    setwd(dot)
+    x <- x[names(x) != "SHA256"]
+    nmx <- names(x)
+    res <- TRUE
+    not.here <- (nmxx %notin% nmx)
+    if(any(not.here)) {
+        res <- FALSE
+        if (sum(not.here) > 1L)
+            cat("files", paste(sQuote(nmxx[not.here]), collapse = ", "),
+                "are missing\n", sep = " ")
+        else
+            cat("file", sQuote(nmxx[not.here]), "is missing\n", sep = " ")
+    }
+    nmxx <- nmxx[!not.here]
+    diff <- xx[nmxx] != x[nmxx]
+    if(any(diff)) {
+        res <- FALSE
+        files <- nmxx[diff]
+        if(length(files) > 1L)
+            cat("files", paste(sQuote(files), collapse = ", "),
+                "have the wrong SHA256 checksums\n", sep = " ")
+        else cat("file", sQuote(files), "has the wrong SHA256 checksum\n")
+    }
+    res
+}
+
+.hex.chars <- c("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f")
+
+hex2raw <- function(x) {
+  if (length(x) != 1L) stop("x must be a single string")
+  if (!nzchar(x)) return(raw(1L))
+  ## pad with 0 to full bytes
+  m <- match(strsplit(tolower(x),"")[[1L]], .hex.chars)
+  if (any(is.na(m))) stop("invalid hex string")
+  if (length(m) %% 2 == 1) m <- c(1L, m) ## add leading 0 for full byte
+  as.raw(colSums(matrix(m - 1L, 2) * c(16L, 1L)))
+}
+
+.pad <- function(x, n) if (length(x) < n) c(x, raw(n - length(x))) else x
+
+hmac <- function(key, x, hash, block) {
+  key <- .pad(if (length(key) > block) hex2raw(hash(key)) else key, block)
+  # HMAC := HASH( c( key ^ 0x5c, HASH( c( key ^ 0x36, x ) ) ) )
+  hash(c(xor(key, as.raw(0x5c)),
+       hex2raw(hash(c(xor(key, as.raw(0x36)), x)))))
+}
+
+hmac.sha256 <- function(key, x) hmac(key, x, function(x) sha256sum(bytes=x), 64L)
+hmac.md5 <- function(key, x) hmac(key, x, function(x) md5sum(bytes=x), 64L)

src/library/tools/man/md5sum.Rd

@@ -1,6 +1,6 @@
 % File src/library/tools/man/md5sum.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2014 R Core Team
+% Copyright 1995-2024 R Core Team
 % Distributed under GPL 2 or later
 
 \name{md5sum}
@@ -44,7 +44,7 @@ md5sum(files, bytes)
   a 2001 release of \code{glibc}.
 }
 \seealso{
-  \code{\link{checkMD5sums}}
+  \code{\link{checkMD5sums}}, \code{\link{sha256sum}}
 }
 \examples{
 as.vector(md5sum(dir(R.home(), pattern = "^COPY", full.names = TRUE)))

src/library/tools/man/sha256sum.Rd

@@ -0,0 +1,50 @@
+% File src/library/tools/man/sha256sum.Rd
+% Part of the R package, https://www.R-project.org
+% Copyright 1995-2024 R Core Team
+% Distributed under GPL 2 or later
+
+\name{sha256sum}
+\alias{sha256sum}
+\title{Compute SHA-256 Checksums}
+\description{
+  Compute the 32-byte SHA-256 hashes of one or more files, or a raw vector of bytes.
+}
+\usage{
+sha256sum(files, bytes)
+}
+\arguments{
+  \item{files}{character. The paths of file(s) whose contents are to be hashed.}
+  \item{bytes}{raw. Bytes to be hashed.
+    NB: \code{bytes} and \code{files} are mutually exclusive.}
+}
+\details{
+  A SHA-256 \sQuote{hash} or \sQuote{checksum} or \sQuote{message digest} is
+  a 256-bit summary of the file contents represented by 64 hexadecimal
+  digits.
+
+  On Windows all files are read in binary mode (as the \code{sha256sum}
+  utilities there do): on other OSes the files are read in the default
+  mode (almost always text mode where there is more than one).
+}
+\value{
+  A character vector of the same length as \code{files}, with names
+  equal to \code{files} (possibly expanded).  The elements will be
+  \code{NA} for non-existent or unreadable files, otherwise a
+  64-character string of hexadecimal digits.
+
+  For \code{bytes} the result is a single 64-character string.
+}
+\source{
+  The underlying C code was written by \I{Ulrich Drepper}, extracted from
+  the public domain version SHA-crypt.txt verison 0.6 (2016-8-31).
+}
+\seealso{
+  \code{\link{md5sum}}
+}
+\examples{
+as.vector(sha256sum(dir(R.home(), pattern = "^COPY", full.names = TRUE)))
+sha256sum(bytes=raw())
+sha256sum(bytes=charToRaw("abc"))
+}
+\keyword{utilities}
+

src/library/tools/src/Makefile.in

@@ -14,7 +14,7 @@ R_SHARE_DIR = $(R_HOME)/share
 R_INCLUDE_DIR = $(R_HOME)/include
 
 SOURCES_C = text.c init.c Rmd5.c md5.c signals.c install.c getfmts.c http.c \
-  gramLatex.c gramRd.c pdscan.c
+  gramLatex.c gramRd.c pdscan.c Rsha256.c sha256.c
 DEPENDS = $(SOURCES_C:.c=.d)
 OBJECTS = $(SOURCES_C:.c=.o)
 

src/library/tools/src/Makefile.win

@@ -12,7 +12,7 @@ subdir = src/library/$(pkg)/src
 R_HOME = $(top_builddir)
 
 SOURCES_C = text.c init.c Rmd5.c md5.c signals.c install.c getfmts.c http.c \
-  gramLatex.c gramRd.c pdscan.c
+  gramLatex.c gramRd.c pdscan.c Rsha256.c sha256.c
 DEPENDS = $(SOURCES_C:.c=.d)
 OBJECTS = $(SOURCES_C:.c=.o) ../../../gnuwin32/dllversion.o
 

src/library/tools/src/Rmd5.c

@@ -47,7 +47,7 @@ SEXP Rmd5(SEXP files)
     /* RAW mode: hash of one buffer instead of files */
     if (TYPEOF(files) == RAWSXP) {
 	/* there is really no failure possible, but just in case... */
-	if (!md5_buffer((char *) RAW(files), XLENGTH(files), resblock))
+	if (!md5_buffer((const char *) RAW(files), XLENGTH(files), resblock))
 	    return ScalarString(NA_STRING);
 	for(j = 0; j < 16; j++)
 	    snprintf (out+2*j, 33-2*j, "%02x", resblock[j]);

src/library/tools/src/Rsha256.c

@@ -0,0 +1,101 @@
+/*
+ *  R : A Computer Language for Statistical Data Analysis
+ *  Copyright (C) 2003-2024   The R Core Team.
+ *
+ *  This program is free software; you can redistribute it and/or modify
+ *  it under the terms of the GNU General Public License as published by
+ *  the Free Software Foundation; either version 2 of the License, or
+ *  (at your option) any later version.
+ *
+ *  This program is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with this program; if not, a copy is available at
+ *  https://www.R-project.org/Licenses/
+ */
+
+/* <UTF8> OK since this is intended to treat chars as byte streams */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <Defn.h>
+#undef _
+
+#include "tools.h"
+#include "sha256.h"
+
+#define SHA256_HASH_SIZE 32
+#define SHA256_HEX_SIZE  64
+
+/* convenience fn for init + process + finish */
+static void *Rsha256_buffer (const void *buffer, size_t len, void *resblock)
+{
+  struct sha256_ctx ctx;
+  Rsha256_init_ctx(&ctx);
+  Rsha256_process_bytes(buffer, len, &ctx);
+  return Rsha256_finish_ctx(&ctx, resblock);
+}
+
+/* This is essentailly identical to Rmd5 */
+
+/* .Call so manages R_alloc stack */
+SEXP Rsha256(SEXP files)
+{
+    SEXP ans;
+    int i, j, nfiles = length(files), res;
+#ifdef _WIN32
+    const wchar_t *wpath;
+#else
+    const char *path;
+#endif
+    char out[SHA256_HEX_SIZE + 1];
+    FILE *fp;
+    unsigned char resblock[SHA256_HASH_SIZE];
+
+    /* RAW mode: hash of one buffer instead of files */
+    if (TYPEOF(files) == RAWSXP) {
+	/* there is really no failure possible, but just in case... */
+	if (!Rsha256_buffer((const void *) RAW(files), XLENGTH(files), resblock))
+	    return ScalarString(NA_STRING);
+	for(j = 0; j < SHA256_HASH_SIZE; j++)
+	  snprintf (out+2*j, sizeof(out) - 2*j, "%02x", resblock[j]);
+	return mkString(out);
+    }
+    /* otherwise list of files */
+    if(!isString(files)) error(_("argument 'files' must be character"));
+    PROTECT(ans = allocVector(STRSXP, nfiles));
+    for(i = 0; i < nfiles; i++) {
+#ifdef _WIN32
+	wpath = filenameToWchar(STRING_ELT(files, i), FALSE);
+	fp = _wfopen(wpath, L"rb");
+#else
+	path = translateChar(STRING_ELT(files, i));
+	fp = fopen(path, "r");
+#endif
+	if(!fp) {
+	    SET_STRING_ELT(ans, i, NA_STRING);
+	} else {
+	    res = Rsha256_stream(fp, &resblock);
+	    if(res) {
+#ifdef _WIN32
+		warning(_("sha256 failed on file '%ls'"), wpath);
+#else
+		warning(_("sha256 failed on file '%s'"), path);
+#endif
+		SET_STRING_ELT(ans, i, NA_STRING);
+	    } else {
+		for(j = 0; j < SHA256_HASH_SIZE; j++)
+		  snprintf (out+2*j, sizeof(out) - 2*j, "%02x", resblock[j]);
+		SET_STRING_ELT(ans, i, mkChar(out));
+	    }
+	    fclose(fp);
+	}
+    }
+    UNPROTECT(1);
+    return ans;
+}

src/library/tools/src/init.c

@@ -42,6 +42,7 @@ static const R_CallMethodDef CallEntries[] = {
     CALLDEF(dirchmod, 2),
     CALLDEF(getfmts, 1),
     CALLDEF(Rmd5, 1),
+    CALLDEF(Rsha256, 1),
     CALLDEF(check_nonASCII, 2),
     CALLDEF(check_nonASCII2, 1),
     CALLDEF(doTabExpand, 2),