From cda4e5befe2f31dd507e23c0b16990dc5a84f1f2 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 25 Jun 2018 13:35:45 -0600 Subject: [PATCH] add `sha1-bytes`, `sha224-bytes`, and `sha256-bytes` via rktio Although SHA-1 hashing functions are available from `openssl` libraries, a fast crytopgraphic hash is useful for many purposes below the layer where the OpenSSL library has been opened. And SHA-1 is reasonably easy to add to rktio. Meanwhile, provide an equally convenient SHA-2 function to discourage bad security practices (i.e., using SHA-1 where SHA-2 should be preferred). --- pkgs/base/info.rkt | 2 +- pkgs/racket-doc/file/scribblings/sha1.scrbl | 34 +- pkgs/racket-doc/openssl/openssl.scrbl | 13 +- .../racket-doc/scribblings/reference/io.scrbl | 1 + .../scribblings/reference/sha.scrbl | 63 +++ .../scribblings/main/license.scrbl | 5 + pkgs/racket-test-core/tests/racket/file.rktl | 29 ++ .../collects/compiler/private/cm-minimal.rkt | 9 +- racket/collects/file/sha1.rkt | 293 +---------- racket/collects/openssl/sha1.rkt | 11 +- racket/src/cs/demo/io.ss | 13 + racket/src/cs/io.sls | 8 + racket/src/cs/primitive/kernel.ss | 3 + racket/src/gracket/Makefile.in | 6 +- racket/src/io/demo.rkt | 6 + racket/src/io/host/bootstrap-rktio.rkt | 11 + racket/src/io/host/rktio.rkt | 2 + racket/src/io/main.rkt | 2 + racket/src/io/sha/main.rkt | 94 ++++ racket/src/racket/src/Makefile.in | 2 +- racket/src/racket/src/portfun.c | 149 +++++- racket/src/racket/src/schminc.h | 2 +- racket/src/racket/src/schvers.h | 4 +- racket/src/rktio/Makefile.in | 8 + racket/src/rktio/configure | 244 +++++++++ racket/src/rktio/configure.ac | 14 + racket/src/rktio/parse.rkt | 44 +- racket/src/rktio/rktio.def | 7 + racket/src/rktio/rktio.h | 40 ++ racket/src/rktio/rktio.inc | 7 + racket/src/rktio/rktio.rktl | 53 ++ racket/src/rktio/rktio_config.h.in | 3 + racket/src/rktio/rktio_sha1.c | 404 +++++++++++++++ racket/src/rktio/rktio_sha2.c | 464 ++++++++++++++++++ 34 files changed, 1716 insertions(+), 334 deletions(-) create mode 100644 pkgs/racket-doc/scribblings/reference/sha.scrbl create mode 100644 racket/src/io/sha/main.rkt create mode 100644 racket/src/rktio/rktio_sha1.c create mode 100644 racket/src/rktio/rktio_sha2.c diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 29ad007b4c..9abd208a34 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.0.0.4") +(define version "7.0.0.5") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/file/scribblings/sha1.scrbl b/pkgs/racket-doc/file/scribblings/sha1.scrbl index 006fd38b19..2152aa514e 100644 --- a/pkgs/racket-doc/file/scribblings/sha1.scrbl +++ b/pkgs/racket-doc/file/scribblings/sha1.scrbl @@ -10,11 +10,15 @@ See @racketmodname[openssl/sha1] for a faster implementation. -@defproc[(sha1 [in input-port?]) string?]{ +@defproc[(sha1 [in (or/c bytes? input-port?)] + [start exact-nonnegative-integer? 0] + [end (or/c #f exact-nonnegative-integer?) #f]) + string?]{ Returns a 40-character string that represents the SHA-1 hash (in -hexadecimal notation) of the content from @racket[in], consuming all -of the input from @racket[in] until an end-of-file. +hexadecimal notation) of the content from @racket[in]. The +@racket[in], @racket[start], and @racket[end] arguments are treated +the same as @racket[sha1-bytes] from @racketmodname[racket/base]. The @racket[sha1] function composes @racket[bytes->hex-string] with @racket[sha1-bytes]. @@ -22,18 +26,30 @@ The @racket[sha1] function composes @racket[bytes->hex-string] with @examples[ #:eval sha1-eval (sha1 (open-input-bytes #"abc")) -]} +] -@defproc[(sha1-bytes [in input-port?]) bytes?]{ +@history[#:changed "7.0.0.5" @elem{Allowed a byte string as @racket[in] + and added the @racket[start] and + @racket[end] arguments.}]} -Returns a 20-byte byte string that represents the SHA-1 hash of the -content from @racket[in], consuming all of the input from @racket[in] -until an end-of-file. +@defproc[#:link-target? #f + (sha1-bytes [in (or/c bytes? input-port?)] + [start exact-nonnegative-integer? 0] + [end (or/c #f exact-nonnegative-integer?) #f]) + string?]{ + +The same as @racket[sha1-bytes] from @racketmodname[racket/base], +returns a 20-byte byte string that represents the SHA-1 hash of the +content from @racket[in]. @examples[ #:eval sha1-eval (sha1-bytes (open-input-bytes #"abc")) -]} +] + +@history[#:changed "7.0.0.5" @elem{Allowed a byte string as @racket[in] + and added the @racket[start] and + @racket[end] arguments.}]} @defproc[(bytes->hex-string [bstr bytes?]) string?]{ diff --git a/pkgs/racket-doc/openssl/openssl.scrbl b/pkgs/racket-doc/openssl/openssl.scrbl index 5893c9cccb..e8b3c31186 100644 --- a/pkgs/racket-doc/openssl/openssl.scrbl +++ b/pkgs/racket-doc/openssl/openssl.scrbl @@ -2,13 +2,19 @@ @(require scribble/manual racket/list (for-label openssl - racket + (except-in racket sha1-bytes) openssl/sha1 openssl/md5 openssl/libcrypto openssl/libssl (only-in ffi/unsafe ffi-lib ffi-lib?))) +@(define-syntax-rule (define-racket/base sha1-bytes-id) + (begin + (require (for-label (only-in racket/base sha1-bytes))) + (define sha1-bytes-id @racket[sha1-bytes]))) +@(define-racket/base racket:sha1-bytes) + @title{OpenSSL: Secure Communication} @defmodule[openssl] @@ -812,7 +818,10 @@ The @racket[sha1] function composes @racket[bytes->hex-string] with Returns a 20-byte byte string that represents the SHA-1 hash of the content from @racket[in], consuming all of the input from @racket[in] -until an end-of-file.} +until an end-of-file. + +The @racket:sha1-bytes function from @racketmodname[racket/base] +computes the same result and is only slightly slower.} @defproc[(bytes->hex-string [bstr bytes?]) string?]{ diff --git a/pkgs/racket-doc/scribblings/reference/io.scrbl b/pkgs/racket-doc/scribblings/reference/io.scrbl index 4c1da8173c..8c95fe203d 100644 --- a/pkgs/racket-doc/scribblings/reference/io.scrbl +++ b/pkgs/racket-doc/scribblings/reference/io.scrbl @@ -17,4 +17,5 @@ @include-section["custom-write.scrbl"] @include-section["serialization.scrbl"] @include-section["fasl.scrbl"] +@include-section["sha.scrbl"] diff --git a/pkgs/racket-doc/scribblings/reference/sha.scrbl b/pkgs/racket-doc/scribblings/reference/sha.scrbl new file mode 100644 index 0000000000..19cc173afb --- /dev/null +++ b/pkgs/racket-doc/scribblings/reference/sha.scrbl @@ -0,0 +1,63 @@ +#lang scribble/doc +@(require "mz.rkt" (for-label file/sha1)) + +@(define sha-eval (make-base-eval)) +@examples[#:hidden #:eval sha-eval (require file/sha1)] + +@title[#:tag "sha"]{Cryptographic Hashing} + +@deftogether[( +@defproc[(sha1-bytes [in (or/c bytes? input-port?)] + [start exact-nonnegative-integer? 0] + [end (or/c #f exact-nonnegative-integer?) #f]) + bytes?] +@defproc[(sha224-bytes [in (or/c bytes? input-port?)] + [start exact-nonnegative-integer? 0] + [end (or/c #f exact-nonnegative-integer?) #f]) + bytes?] +@defproc[(sha256-bytes [in (or/c bytes? input-port?)] + [start exact-nonnegative-integer? 0] + [end (or/c #f exact-nonnegative-integer?) #f]) + bytes?] +)]{ + +Computes the SHA-1, SHA-224, or SHA-256 hash of a byte sequence and +returns the hash as a byte string with 20 bytes, 28 bytes, or 32 +bytes, respectively. + +The @racket[start] and @racket[end] arguments determine the range of +bytes of the input that are used to compute the hash. An @racket[end] +value of @racket[#f] corresponds to the end of the byte string or an +end-of-file position for an input port. When @racket[in] is a byte +string, the @racket[start] and @racket[end] values (when non +@racket[#f]) must be no greater than the length of the byte string, +and @racket[start] must be no greater than @racket[end]. When +@racket[in] is an input port, @racket[start] must be no greater than +@racket[end]; if @racket[in] supplies less than @racket[start] or +@racket[end] bytes before an end-of-file, then @racket[start] and/or +@racket[end] is effectively changed to the number of supplied bytes +(so that an empty or truncated byte sequence is hashed). When +@racket[in] is an input port and @racket[end] is a number, then at +most @racket[end] bytes are read from the input port. + +For security purposes, favor @racket[sha224-bytes] and +@racket[sha256-bytes] (which are part of the SHA-2 family) over +@racket[sha1-bytes]. + +Use @racket[bytes->hex-string] from @racketmodname[file/sha1] to +convert a byte string hash to a human-readable string. + +@mz-examples[ +#:eval sha-eval +(sha1-bytes #"abc") +(require file/sha1) +(bytes->hex-string (sha1-bytes #"abc")) +(bytes->hex-string (sha224-bytes #"abc")) +(bytes->hex-string (sha224-bytes (open-input-string "xabcy") 1 4)) +] + +@history[#:added "7.0.0.5"]} + +@; ---------------------------------------------------------------------- + +@close-eval[sha-eval] diff --git a/pkgs/racket-index/scribblings/main/license.scrbl b/pkgs/racket-index/scribblings/main/license.scrbl index e3cc3c694f..7e4c9bd8b1 100644 --- a/pkgs/racket-index/scribblings/main/license.scrbl +++ b/pkgs/racket-index/scribblings/main/license.scrbl @@ -75,5 +75,10 @@ Racket software includes or extends the following copyrighted material: http://www.joachim-bauch.de } +@copyright{ + SHA-224 and SHA-256 implementation from mbed TLS + Copyright (c) 2006-2015, ARM Limited, All Rights Reserved +} + See also other @filepath{LICENSE.txt} files in your distribution or packages. diff --git a/pkgs/racket-test-core/tests/racket/file.rktl b/pkgs/racket-test-core/tests/racket/file.rktl index a87cb153ff..20bbc3f118 100644 --- a/pkgs/racket-test-core/tests/racket/file.rktl +++ b/pkgs/racket-test-core/tests/racket/file.rktl @@ -2049,4 +2049,33 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(test #"\205\327\305\377@:\276r\337[\212'\b\202\36\343<\320\274\316" sha1-bytes #"abcdefghijklmn") +(test #"\340\373\262\1m\341\6V\352$IR\311}\350x7\337d\263\320\243\247\350\342\31R " sha224-bytes #"abcdefghijklmn") +(test #"\6S\307\351\222\327\252\324\f\262cW8\270p\344\301T\257\263F4\r\2\307\227\324\220\335R\325\371" sha256-bytes #"abcdefghijklmn") + +(define (test-sha-more sha-bytes) + (define (try sha-bytes base) + (define expect (sha-bytes base)) + (define len (bytes-length base)) + (test expect sha-bytes base 0) + (test expect sha-bytes base 0 #f) + (test expect sha-bytes (bytes-append #"__" base) 2) + (test expect sha-bytes (bytes-append #"__" base) 2 #f) + (test expect sha-bytes (bytes-append #"__" base) 2 (+ 2 len)) + (test expect sha-bytes (bytes-append #"__" base #"__") 2 (+ 2 len)) + (test expect sha-bytes (bytes-append base #"__") 0 len) + (test expect sha-bytes (bytes-append (make-bytes 1035 42) base) 1035) + #;(test expect sha-bytes (bytes-append (make-bytes 1035 42) base #"__") 1035 (+ 1035 len))) + (define (try-base base) + (try sha-bytes base) + #; + (try (lambda (bstr . args) (apply sha-bytes (open-input-bytes bstr) args)) base)) + (try-base #"abcdefghijklmn") + (try-base (make-bytes 5077 79))) +(test-sha-more sha1-bytes) +(test-sha-more sha224-bytes) +(test-sha-more sha256-bytes) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (report-errs) diff --git a/racket/collects/compiler/private/cm-minimal.rkt b/racket/collects/compiler/private/cm-minimal.rkt index a5a54077e5..27a68a5992 100644 --- a/racket/collects/compiler/private/cm-minimal.rkt +++ b/racket/collects/compiler/private/cm-minimal.rkt @@ -7,7 +7,7 @@ racket/list racket/path racket/promise - openssl/sha1 + file/sha1 setup/collects compiler/compilation-path compiler/private/dep) @@ -209,7 +209,7 @@ ;; sort by sha1s so that order doesn't matter (write (sort l stringmode roots path src-sha1 external-deps external-module-deps reader-deps @@ -417,10 +417,7 @@ (case mode [(#\B) ;; A linklet bundle: - (define h (sha1-bytes (open-input-bytes (if (and (zero? start) - (= len (bytes-length s))) - s - (subbytes s start (+ start len)))))) + (define h (sha1-bytes s start (+ start len))) ;; Write sha1 for bundle hash: (bytes-copy! s (+ start 4 vlen) h)] [(#\D) diff --git a/racket/collects/file/sha1.rkt b/racket/collects/file/sha1.rkt index 2fb19a64dc..7eaa1593a5 100644 --- a/racket/collects/file/sha1.rkt +++ b/racket/collects/file/sha1.rkt @@ -1,300 +1,11 @@ #lang racket/base - -#| -Originally: - -Copyright (c) 2006 Eric Knauel -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. The name of the authors may not be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES -OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. -IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -|# - (provide sha1 sha1-bytes bytes->hex-string hex-string->bytes) -(define 32-mask #xFFFFFFFF) - -(define (mod2+ a b) - (bitwise-and (+ a b) 32-mask)) - -(define (mod5+ a b c d e) - (bitwise-and (+ a b c d e) 32-mask)) - -;;; make a mask with COUNT 1 bits shifted START bits left -(define (make-extract-mask start count) - (arithmetic-shift (sub1 (arithmetic-shift 1 count)) start)) - -;;; rotate I COUNT bits to the left. Assumes length of 32 bits -(define (circular-shift-left i count) - (bitwise-ior - (arithmetic-shift (bitwise-and i (sub1 (arithmetic-shift 1 (- 32 count)))) - count) - (arithmetic-shift i (- count 32)))) - -(define (calc-blocks-needed bits) - (if (<= bits 448) - 1 - (let* ((full-blocks (+ 1 (quotient bits 512))) - (rest (- (* full-blocks 512) bits))) - (if (< rest 64) - (+ 1 full-blocks) - full-blocks)))) - -;;; convert NUM-BYTES from BV (starting at START) into an integer -(define (bytes->block bv start num-bytes) - (let lp ((i 0) (block 0)) - (if (= i num-bytes) - block - (lp (+ i 1) - (bitwise-ior - block - (arithmetic-shift (bytes-ref bv (+ start i)) - (* 8 (- num-bytes (+ i 1))))))))) - -;;; enough space for 64 bit length info? -(define (enough-space-for-length-info? last-block-len) - (<= last-block-len 56)) - -;;; add padding to BLOCK -(define (pad-block block unused-bits) - (bitwise-ior - (arithmetic-shift block unused-bits) - (arithmetic-shift #b1 (- unused-bits 1)))) - -(define (prepare-message! blocks unused-bits total-message-len) - (let* ((len (vector-length blocks)) - (spare-block-index (- len 1)) - (last-block-index (- len 2)) - (last-block (vector-ref blocks last-block-index))) - (cond - ((>= unused-bits (+ 64 1)) - ;; there is enough space to store the message length in the last - ;; block - (vector-set! blocks - last-block-index - ;(+ (pad-block last-block 512) total-message-len)) - (+ (pad-block last-block unused-bits) total-message-len)) - last-block-index) - ((zero? unused-bits) - ;; we need the spare block. There is no space to pad the last - ;; block. - (vector-set! blocks - spare-block-index - ;(+ (pad-block 0 512) total-message-len)) - (+ (pad-block 0 unused-bits) total-message-len)) - spare-block-index) - (else - ;; we need the spare block. First pad the last-block to 512 bits - (vector-set! blocks - last-block-index - ;(pad-block last-block 512)) - (pad-block last-block unused-bits)) - ;; Now write the length into the spare block - (vector-set! blocks spare-block-index total-message-len) - spare-block-index)))) - -;;; generate a vector with masks that decompose a 512-bit block into -;;; 16 32-bit words (stored in a vector) -(define (make-split-block-vector) - (let ((vec (make-vector 16 0))) - (do ((i 0 (+ i 32)) - (j 0 (+ j 1))) - ((>= i 512) vec) - (vector-set! vec - j - (make-extract-mask i 32))))) - -(define split-block-masks - (make-split-block-vector)) - -;;; decompose a 512-bit block into 16 32-bit words (stored in a -;;; vector) -(define (split-block block) - (let ((vec (make-vector 16 0))) - (do ((i 0 (+ i 1))) - ((>= i 16) vec) - (vector-set! - vec (- 15 i) - (arithmetic-shift - (bitwise-and (vector-ref split-block-masks i) - block) - (- (* i 32))))))) - -;;; extend a vector with 16 32-bit words into a vector of 80 32-bit -;;; words -(define (extend-word-blocks word-block) - (let ((vec (make-vector 80 0))) - - (do ((i 0 (+ i 1))) - ((> i 15) (values)) - (vector-set! vec i (vector-ref word-block i))) - - (do ((i 16 (+ i 1))) - ((> i 79) vec) - (vector-set! - vec i - (circular-shift-left - (bitwise-xor (vector-ref vec (- i 3)) - (bitwise-xor (vector-ref vec (- i 8)) - (bitwise-xor (vector-ref vec (- i 14)) - (vector-ref vec (- i 16))))) - 1))))) - -;;; the nonlinear functions used by SHA1 -(define (nonlinear-sha1-function i x y z) - (cond - ((<= i 19) - (bitwise-xor (bitwise-and x y) - (bitwise-and (bitwise-not x) z))) - ((<= i 39) - (bitwise-xor (bitwise-xor x y) z)) - ((<= i 59) - (bitwise-xor - (bitwise-xor (bitwise-and x y) - (bitwise-and x z)) - (bitwise-and y z))) - (else - (bitwise-xor (bitwise-xor x y) z)))) - -;;; the SHA1 "constants" -(define (sha1-constant i) - (cond - ((<= i 19) #x5a827999) - ((<= i 39) #x6ed9eba1) - ((<= i 59) #x8f1bbcdc) - (else #xca62c1d6))) - -;;; append five 32 bits to a 160 bit hash number -(define (append-hash h0 h1 h2 h3 h4) - (bitwise-ior - (bitwise-ior - (bitwise-ior - (bitwise-ior h4 (arithmetic-shift h3 32)) - (arithmetic-shift h2 64)) - (arithmetic-shift h1 96)) - (arithmetic-shift h0 128))) - -;;; SHA1 main loop -(define (sha1-loop extended-words h0 h1 h2 h3 h4) - (let lp ((i 0) (a h0) (b h1) (c h2) (d h3) (e h4)) - (if (= i 80) - (values a b c d e) - (lp (+ i 1) - (mod5+ (circular-shift-left a 5) - (nonlinear-sha1-function i b c d) - e - (vector-ref extended-words i) - (sha1-constant i)) - a - (circular-shift-left b 30) - c - d)))) - -(define (calculate-sha1 blocks last-index) - (let lp ((index 0) - (h0 #x67452301) (h1 #xefcdab89) (h2 #x98badcfe) - (h3 #x10325476) (h4 #xc3d2e1f0)) - (if (> index last-index) - (append-hash h0 h1 h2 h3 h4) - (let* ((block (vector-ref blocks index)) - (word-blocks (split-block block)) - (extended-words (extend-word-blocks word-blocks))) - (let-values ([(a b c d e) - (sha1-loop extended-words h0 h1 h2 h3 h4)]) - (let ((h0 (mod2+ h0 a)) - (h1 (mod2+ h1 b)) - (h2 (mod2+ h2 c)) - (h3 (mod2+ h3 d)) - (h4 (mod2+ h4 e))) - (lp (+ index 1) h0 h1 h2 h3 h4))))))) - -;;; returns a vector of blocks (a block is a 512 bit integer) and the -;;; number of unused bits in the last block. -(define (byte-string->blocks bv) - (let* ((bytes (bytes-length bv)) - (vec (make-vector (+ 1 (+ 1 (quotient bytes (quotient 512 8)))) 0)) - (bits 0)) - ;; the last element is a spare element---just needed if the - ;; message length doesn't fit into the last message block. - (do ((i 0 (+ i 64)) - (j 0 (+ j 1))) - ((> (+ i 64) bytes) - (vector-set! vec j (bytes->block bv i (- bytes i))) - (values vec - (* 8 (- 64 (- bytes i))) - (+ bits (* 8 (- bytes i))))) - (set! bits (+ bits 512)) - (vector-set! vec j (bytes->block bv i 64))))) - -(define (sha1-hash-string str) - (sha1-hash-bytes (string->bytes/utf-8 str))) - -(define (sha1-hash-bytes bv) - (let-values ([(blocks unused-bits total-length) - (byte-string->blocks bv)]) - (let ((last-index (prepare-message! blocks unused-bits total-length))) - (calculate-sha1 blocks last-index)))) - -(define (make-hash-as-bytes-mask) - (let* ((len (quotient 160 8)) - (vec (make-vector len 0))) - (do ((i 0 (+ i 8)) - (j 0 (+ j 1))) - ((>= i 160) vec) - (vector-set! vec j (make-extract-mask i 8))))) - -(define hash-as-bytes-masks - (make-hash-as-bytes-mask)) - -(define (hash-value->bytes int) - (let* ((len (vector-length hash-as-bytes-masks)) - (bv (make-bytes len 0))) - (do ((i 0 (+ i 1))) - ((>= i len) bv) - (bytes-set! - bv (- (- len 1) i) - (arithmetic-shift - (bitwise-and (vector-ref hash-as-bytes-masks i) - int) - (- (* i 8))))))) - -(define (sha1-input in) - (let ([p (open-output-bytes)] - [bstr (make-bytes 4096)]) - (let loop () - (let ([c (read-bytes! bstr in)]) - (unless (eof-object? c) - (write-bytes bstr p 0 c) - (loop)))) - (sha1-hash-bytes (get-output-bytes p)))) - -(define (sha1 in) - (bytes->hex-string (hash-value->bytes (sha1-input in)))) - -(define (sha1-bytes in) - (hash-value->bytes (sha1-input in))) +(define (sha1 in [start 0] [end #f]) + (bytes->hex-string (sha1-bytes in start end))) (define (bytes->hex-string bstr) (let* ([len (bytes-length bstr)] diff --git a/racket/collects/openssl/sha1.rkt b/racket/collects/openssl/sha1.rkt index 546e5c126c..1eae418dcf 100644 --- a/racket/collects/openssl/sha1.rkt +++ b/racket/collects/openssl/sha1.rkt @@ -2,13 +2,16 @@ (require ffi/unsafe racket/runtime-path (for-syntax racket/base) - (prefix-in r: file/sha1) + (only-in file/sha1 + [sha1-bytes r:sha1-bytes] + bytes->hex-string + hex-string->bytes) "libcrypto.rkt") (provide sha1 sha1-bytes - (rename-out [r:bytes->hex-string bytes->hex-string]) - (rename-out [r:hex-string->bytes hex-string->bytes])) + bytes->hex-string + hex-string->bytes) (define _SHA_CTX-pointer _pointer) @@ -40,4 +43,4 @@ (define (sha1 in) (unless (input-port? in) (raise-argument-error 'sha1 "input-port?" in)) - (r:bytes->hex-string (sha1-bytes in))) + (bytes->hex-string (sha1-bytes in))) diff --git a/racket/src/cs/demo/io.ss b/racket/src/cs/demo/io.ss index ef59ab1697..81e24c70d5 100644 --- a/racket/src/cs/demo/io.ss +++ b/racket/src/cs/demo/io.ss @@ -17,6 +17,19 @@ ;; ---------------------------------------- +(define abcdefghijklmn (string->bytes/utf-8 "abcdefghijklmn")) +(define __abcdefghijklmn__ (string->bytes/utf-8 "__abcdefghijklmn__")) + +(test '#vu8(133 215 197 255 64 58 190 114 223 91 138 39 8 130 30 227 60 208 188 206) (sha1-bytes abcdefghijklmn)) +(test '#vu8(224 251 178 1 109 225 6 86 234 36 73 82 201 125 232 120 55 223 100 179 208 163 167 232 226 25 82 32) + (sha224-bytes abcdefghijklmn)) +(test '#vu8(6 83 199 233 146 215 170 212 12 178 99 87 56 184 112 228 193 84 175 179 70 52 13 2 199 151 212 144 221 82 213 249) + (sha256-bytes abcdefghijklmn)) +(test '#vu8(133 215 197 255 64 58 190 114 223 91 138 39 8 130 30 227 60 208 188 206) (sha1-bytes (open-input-bytes abcdefghijklmn))) +(test '#vu8(133 215 197 255 64 58 190 114 223 91 138 39 8 130 30 227 60 208 188 206) (sha1-bytes (open-input-bytes __abcdefghijklmn__) 2 16)) + +;; ---------------------------------------- + (time (let loop ([j 10]) (unless (zero? j) diff --git a/racket/src/cs/io.sls b/racket/src/cs/io.sls index 7ce2b7ef33..97ed29ab37 100644 --- a/racket/src/cs/io.sls +++ b/racket/src/cs/io.sls @@ -41,6 +41,7 @@ (define-ftype intptr_t iptr) (define-ftype uintptr_t uptr) (define-ftype rktio_int64_t integer-64) + (define-ftype function-pointer uptr) (define _uintptr _uint64) (define NULL 0) @@ -255,6 +256,11 @@ (rktio_to_bytes_list lls len) (void)) + (define (rktio_make_sha1_ctx) + (make-bytevector (ftype-sizeof rktio_sha1_ctx_t))) + (define (rktio_make_sha2_ctx) + (make-bytevector (ftype-sizeof rktio_sha2_ctx_t))) + (define (null-to-false v) (if (eqv? v NULL) #f v)) (define (rktio_process_result_stdin_fd r) @@ -318,6 +324,8 @@ 'rktio_free_bytes_list rktio_free_bytes_list 'rktio_from_bytes_list rktio_from_bytes_list 'rktio_free_bytes_list rktio_free_bytes_list + 'rktio_make_sha1_ctx rktio_make_sha1_ctx + 'rktio_make_sha2_ctx rktio_make_sha2_ctx 'rktio_process_result_stdin_fd rktio_process_result_stdin_fd 'rktio_process_result_stdout_fd rktio_process_result_stdout_fd 'rktio_process_result_stderr_fd rktio_process_result_stderr_fd diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index a9fe37d2fa..be10ce9f2b 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -760,6 +760,9 @@ [set-mcdr! (known-procedure 4)] [set-phantom-bytes! (known-procedure 4)] [set-port-next-location! (known-procedure 16)] + [sha1-bytes (known-procedure 14)] + [sha224-bytes (known-procedure 14)] + [sha256-bytes (known-procedure 14)] [shared-bytes (known-procedure -1)] [shell-execute (known-procedure 32)] [simplify-path (known-procedure 6)] diff --git a/racket/src/gracket/Makefile.in b/racket/src/gracket/Makefile.in index 7b767a1a14..bb95e4aa6a 100644 --- a/racket/src/gracket/Makefile.in +++ b/racket/src/gracket/Makefile.in @@ -193,6 +193,8 @@ install-post-collects: install-common: $(NOOP) +INSTALL_SETUP_BOOT = $(SETUP_BOOT) dummy_install dummy_install.d + # X11 ---------------------------------------- install-wx_xt: @@ -252,7 +254,7 @@ install-wx_mac: install-wx_mac-cgc: cd ..; $(ICP) -r gracket/GRacket@CGC@.app $(DESTDIR)"$(libpltdir)/GRacket@CGC_CAP_INSTALLED@.app" - @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) -cqu "$(srcdir)/../mac/rename-app.rkt" $(DESTDIR)"$(libpltdir)/GRacket@CGC_CAP_INSTALLED@.app" "GRacket@CGC@" "GRacket@CGC_CAP_INSTALLED@" + @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) $(INSTALL_SETUP_BOOT) "$(srcdir)/../mac/rename-app.rkt" $(DESTDIR)"$(libpltdir)/GRacket@CGC_CAP_INSTALLED@.app" "GRacket@CGC@" "GRacket@CGC_CAP_INSTALLED@" /usr/bin/install_name_tool -change "@executable_path/../../../../racket/Racket.framework/Versions/$(FWVERSION)/Racket" "@FRAMEWORK_PREFIX@Racket.framework/Versions/$(FWVERSION)/Racket" $(DESTDIR)"$(libpltdir)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@" @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) -cu "$(srcdir)/../racket/collects-path.rkt" $(DESTDIR)"$(libpltdir)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@" @GR_APP_COLLECTS_PATH@ @GR_APP_CONFIG_PATH@ @STRIP_DEBUG@ $(DESTDIR)"$(libpltdir)/GRacket@CGC_CAP_INSTALLED@.app/Contents/MacOS/GRacket@CGC_CAP_INSTALLED@" @@ -262,7 +264,7 @@ install-wx_mac-cgc-final: install-wx_mac-3m: cd ..; $(ICP) -r "gracket/GRacket@MMM@.app" $(DESTDIR)"$(libpltdir)/GRacket@MMM_CAP_INSTALLED@.app" - @RUN_RACKET_MMM@ $(SELF_RACKET_FLAGS) -cqu "$(srcdir)/../mac/rename-app.rkt" $(DESTDIR)"$(libpltdir)/GRacket@MMM_CAP_INSTALLED@.app" "GRacket@MMM@" "GRacket@MMM_CAP_INSTALLED@" + @RUN_RACKET_MMM@ $(SELF_RACKET_FLAGS) $(INSTALL_SETUP_BOOT) "$(srcdir)/../mac/rename-app.rkt" $(DESTDIR)"$(libpltdir)/GRacket@MMM_CAP_INSTALLED@.app" "GRacket@MMM@" "GRacket@MMM_CAP_INSTALLED@" /usr/bin/install_name_tool -change "@executable_path/../../../../racket/Racket.framework/Versions/$(FWVERSION)_3m/Racket" "@FRAMEWORK_PREFIX@Racket.framework/Versions/$(FWVERSION)_3m/Racket" $(DESTDIR)"$(libpltdir)/GRacket@MMM_CAP_INSTALLED@.app/Contents/MacOS/GRacket@MMM_CAP_INSTALLED@" @RUN_RACKET_MMM@ $(SELF_RACKET_FLAGS) -cu "$(srcdir)/../racket/collects-path.rkt" $(DESTDIR)"$(libpltdir)/GRacket@MMM_CAP_INSTALLED@.app/Contents/MacOS/GRacket@MMM_CAP_INSTALLED@" @GR_APP_COLLECTS_PATH@ @GR_APP_CONFIG_PATH@ @STRIP_DEBUG@ $(DESTDIR)"$(libpltdir)/GRacket@MMM_CAP_INSTALLED@.app/Contents/MacOS/GRacket@MMM_CAP_INSTALLED@" diff --git a/racket/src/io/demo.rkt b/racket/src/io/demo.rkt index 1088e3651c..82d5c2cb7e 100644 --- a/racket/src/io/demo.rkt +++ b/racket/src/io/demo.rkt @@ -23,6 +23,12 @@ (test #f (bytes-utf-8-ref #"\364\220\200\200" 0)) +(test #"\205\327\305\377@:\276r\337[\212'\b\202\36\343<\320\274\316" (sha1-bytes #"abcdefghijklmn")) +(test #"\340\373\262\1m\341\6V\352$IR\311}\350x7\337d\263\320\243\247\350\342\31R " (sha224-bytes #"abcdefghijklmn")) +(test #"\6S\307\351\222\327\252\324\f\262cW8\270p\344\301T\257\263F4\r\2\307\227\324\220\335R\325\371" (sha256-bytes #"abcdefghijklmn")) +(test #"\205\327\305\377@:\276r\337[\212'\b\202\36\343<\320\274\316" (sha1-bytes (open-input-bytes #"abcdefghijklmn"))) +(test #"\205\327\305\377@:\276r\337[\212'\b\202\36\343<\320\274\316" (sha1-bytes (open-input-bytes #"__abcdefghijklmn__") 2 16)) + (test #t (file-exists? "demo.rkt")) (test #f (file-exists? "compiled")) (test #f (file-exists? "compiled/demo-file")) diff --git a/racket/src/io/host/bootstrap-rktio.rkt b/racket/src/io/host/bootstrap-rktio.rkt index db129d1641..4849c925ec 100644 --- a/racket/src/io/host/bootstrap-rktio.rkt +++ b/racket/src/io/host/bootstrap-rktio.rkt @@ -14,12 +14,15 @@ (define void _void) (define char _byte) (define int _int) +(define unsigned _uint) (define unsigned-short _ushort) +(define unsigned-8 _ubyte) (define intptr_t _intptr) (define uintptr_t _uintptr) (define rktio_int64_t _int64) (define float _float) (define double _double) +(define function-pointer _pointer) (define NULL #f) (define-syntax-rule (define-constant n v) (define n v)) @@ -47,6 +50,7 @@ (define-syntax-rule (ref t) _pointer) (define-syntax-rule (*ref t) _pointer) +(define-syntax-rule (array n t) (_array t n)) (define-syntax-rule (define-function flags ret-type name ([arg-type arg-name] ...)) (define name @@ -169,6 +173,11 @@ (lambda (k) (racket:void))) +(define (rktio_make_sha1_ctx) + (malloc _Rrktio_sha1_ctx_t)) +(define (rktio_make_sha2_ctx) + (malloc _Rrktio_sha2_ctx_t)) + (primitive-table '#%rktio (let () (define-syntax extract-functions @@ -206,6 +215,8 @@ 'rktio_to_shorts rktio_to_shorts 'rktio_from_bytes_list rktio_from_bytes_list 'rktio_free_bytes_list rktio_free_bytes_list + 'rktio_make_sha1_ctx rktio_make_sha1_ctx + 'rktio_make_sha2_ctx rktio_make_sha2_ctx 'rktio_process_result_stdin_fd rktio_process_result_stdin_fd 'rktio_process_result_stdout_fd rktio_process_result_stdout_fd 'rktio_process_result_stderr_fd rktio_process_result_stderr_fd diff --git a/racket/src/io/host/rktio.rkt b/racket/src/io/host/rktio.rkt index 360d7ba5c1..15396b0cfe 100644 --- a/racket/src/io/host/rktio.rkt +++ b/racket/src/io/host/rktio.rkt @@ -55,6 +55,8 @@ (define-function () #f rktio_get_ctl_c_handler) (define-function () #f rktio_from_bytes_list) (define-function () #f rktio_free_bytes_list) +(define-function () #f rktio_make_sha1_ctx) +(define-function () #f rktio_make_sha2_ctx) (define-function () #f rktio_process_result_stdin_fd) (define-function () #f rktio_process_result_stdout_fd) (define-function () #f rktio_process_result_stderr_fd) diff --git a/racket/src/io/main.rkt b/racket/src/io/main.rkt index 68564d4556..fd6d3fa861 100644 --- a/racket/src/io/main.rkt +++ b/racket/src/io/main.rkt @@ -14,6 +14,7 @@ "filesystem-change-evt/main.rkt" "security/main.rkt" "envvar/main.rkt" + "sha/main.rkt" "subprocess/main.rkt" "network/main.rkt" "foreign/main.rkt" @@ -34,6 +35,7 @@ (all-from-out "filesystem-change-evt/main.rkt") (all-from-out "security/main.rkt") (all-from-out "envvar/main.rkt") + (all-from-out "sha/main.rkt") (all-from-out "subprocess/main.rkt") (all-from-out "network/main.rkt") (all-from-out "foreign/main.rkt") diff --git a/racket/src/io/sha/main.rkt b/racket/src/io/sha/main.rkt new file mode 100644 index 0000000000..749e191951 --- /dev/null +++ b/racket/src/io/sha/main.rkt @@ -0,0 +1,94 @@ +#lang racket/base +(require "../common/check.rkt" + "../host/rktio.rkt" + "../port/input-port.rkt" + "../port/bytes-input.rkt") + +(provide sha1-bytes + sha224-bytes + sha256-bytes) + +(define/who (sha1-bytes in [start 0] [end #f]) + (sha who + in start end + (rktio_make_sha1_ctx) + RKTIO_SHA1_DIGEST_SIZE + rktio_sha1_init + rktio_sha1_update + rktio_sha1_final)) + +(define/who (sha224-bytes in [start 0] [end #f]) + (sha who + in start end + (rktio_make_sha2_ctx) + RKTIO_SHA224_DIGEST_SIZE + (lambda (p) (rktio_sha2_init p #t)) + rktio_sha2_update + rktio_sha2_final)) + +(define/who (sha256-bytes in [start 0] [end #f]) + (sha who + in start end + (rktio_make_sha2_ctx) + RKTIO_SHA256_DIGEST_SIZE + (lambda (p) (rktio_sha2_init p #f)) + rktio_sha2_update + rktio_sha2_final)) + +(define (sha who in start end p sz init update final) + (check who (lambda (p) (or (bytes? p) (input-port? p))) in) + (check who exact-nonnegative-integer? start) + (when (bytes? in) + (unless (<= 0 start (bytes-length in)) + (raise-range-error who + "byte string" + "starting " + start + in + 0 + (bytes-length in) + #f))) + (when end + (check who #:or-false exact-nonnegative-integer? end) + (if (bytes? in) + (unless (<= start end (bytes-length in)) + (raise-range-error who + "byte string" + "ending " + end + in + 0 + (bytes-length in) + start)) + (unless (start . <= . end) + (raise-arguments-error who + "ending index is smaller than starting index" + "starting index" start + "ending index" end)))) + (init p) + (cond + [(bytes? in) + (update p in start (or end (bytes-length in)))] + [else + (define buffer-size (min 256 (if end (- end start) 256))) + (define buffer (make-bytes buffer-size)) + ;; Discard bytes until `start` goes to 0.... + (let loop ([skip start]) + (cond + [(zero? skip) + ;; Read up to `(- end start)` bytes and hash + (let loop ([len (and end (- end start))]) + (unless (and len (zero? len)) + (define got (read-bytes! buffer in 0 (if len + (min len buffer-size) + buffer-size))) + (unless (eof-object? got) + (update p buffer 0 got) + (loop (and len (- len got))))))] + [else + (define got (read-bytes! buffer in 0 (min skip buffer-size))) + (unless (eof-object? got) + (loop (- skip got)))]))]) + (define bstr (make-bytes sz)) + (final p bstr) + bstr) diff --git a/racket/src/racket/src/Makefile.in b/racket/src/racket/src/Makefile.in index 1e63d8096d..873922c89d 100644 --- a/racket/src/racket/src/Makefile.in +++ b/racket/src/racket/src/Makefile.in @@ -401,7 +401,7 @@ place.@LTO@: $(COMMON_HEADERS) $(RKTIO_HEADERS) \ $(srcdir)/stypes.h $(srcdir)/mzmark_place.inc port.@LTO@: $(COMMON_HEADERS) $(RKTIO_HEADERS) \ $(srcdir)/stypes.h $(srcdir)/mzmark_port.inc -portfun.@LTO@: $(COMMON_HEADERS) $(srcdir)/schvers.h \ +portfun.@LTO@: $(COMMON_HEADERS) $(RKTIO_HEADERS) $(srcdir)/schvers.h \ $(srcdir)/stypes.h $(srcdir)/mzmark_portfun.inc print.@LTO@: $(COMMON_HEADERS) $(srcdir)/stypes.h $(srcdir)/schcpt.h \ $(srcdir)/schvers.h $(SCONFIG) $(srcdir)/mzmark_print.inc \ diff --git a/racket/src/racket/src/portfun.c b/racket/src/racket/src/portfun.c index 09668ca0bc..e5b43b1dc0 100644 --- a/racket/src/racket/src/portfun.c +++ b/racket/src/racket/src/portfun.c @@ -28,6 +28,7 @@ #include "schpriv.h" #include "schvers.h" +#include "schrktio.h" static Scheme_Object *input_port_p (int, Scheme_Object *[]); static Scheme_Object *output_port_p (int, Scheme_Object *[]); @@ -132,6 +133,10 @@ static int pipe_input_p(Scheme_Object *o); static int pipe_output_p(Scheme_Object *o); static int pipe_out_ready(Scheme_Output_Port *p); +static Scheme_Object *sha1_bytes(int, Scheme_Object **args); +static Scheme_Object *sha224_bytes(int, Scheme_Object **args); +static Scheme_Object *sha256_bytes(int, Scheme_Object **args); + #ifdef MZ_PRECISE_GC static void register_traversers(void); #endif @@ -345,6 +350,10 @@ scheme_init_port_fun(Scheme_Startup_Env *env) REGISTER_SO(scheme_default_global_print_handler); scheme_default_global_print_handler = scheme_make_prim_w_arity(sch_default_global_port_print_handler, "default-global-port-print-handler", 2, 3); + + ADD_PRIM_W_ARITY("sha1-bytes", sha1_bytes, 1, 3, env); + ADD_PRIM_W_ARITY("sha224-bytes", sha224_bytes, 1, 3, env); + ADD_PRIM_W_ARITY("sha256-bytes", sha256_bytes, 1, 3, env); } void scheme_init_param_symbol() @@ -1161,7 +1170,7 @@ user_peeked_read(Scheme_Input_Port *port, scheme_port_count_lines((Scheme_Port *)port, buf, 0, size); } - + return SCHEME_TRUEP(val); } @@ -4526,6 +4535,144 @@ flush_output(int argc, Scheme_Object *argv[]) return (scheme_void); } +#define SCHEME_DO_SHA1 0 +#define SCHEME_DO_SHA224 1 +#define SCHEME_DO_SHA256 2 + +typedef union rktio_sha_ctx_t { + rktio_sha1_ctx_t sha1; + rktio_sha2_ctx_t sha2; +} rktio_sha_ctx_t; + +static Scheme_Object *sha_bytes(const char *name, int argc, Scheme_Object **argv, int mode) +{ + Scheme_Object *o; + GC_CAN_IGNORE rktio_sha_ctx_t ctx; + int sz; + unsigned char r[RKTIO_SHA256_DIGEST_SIZE]; /* bigger than RKTIO_SHA{1,224}_DIGEST_SIZE */ + + if (mode == SCHEME_DO_SHA1) + rktio_sha1_init(&ctx.sha1); + else + rktio_sha2_init(&ctx.sha2, mode == SCHEME_DO_SHA224); + + o = argv[0]; + if (SCHEME_BYTE_STRINGP(o)) { + intptr_t start, finish; + scheme_get_substring_indices(name, o, + (((argc > 2) && SCHEME_FALSEP(argv[2])) ? 2 : argc), + argv, + 1, 2, &start, &finish); + if (mode == SCHEME_DO_SHA1) + rktio_sha1_update(&ctx.sha1, (unsigned char *)SCHEME_BYTE_STR_VAL(o), start, finish); + else + rktio_sha2_update(&ctx.sha2, (unsigned char *)SCHEME_BYTE_STR_VAL(o), start, finish); + } else if (SCHEME_INPUT_PORTP(o)) { + Scheme_Object *skip, *count; + char buf[256]; + + if (argc > 1) { + intptr_t start, end; + start = scheme_extract_index(name, 1, argc, argv, -1, 0); + if ((argc > 2) && !SCHEME_FALSEP(argv[2])) + end = scheme_extract_index(name, 2, argc, argv, -1, 1); + else + end = -1; + if (end >= 0) { + if (scheme_bin_lt(argv[2], argv[1])) { + scheme_contract_error(name, + "ending index is smaller than starting index", + "starting index", 1, argv[1], + "ending index", 1, argv[2], + NULL); + return NULL; + } + count = scheme_bin_minus(argv[2], argv[1]); + } else + count = scheme_false; + skip = argv[1]; + } else { + skip = scheme_make_integer(0); + count = scheme_false; + } + + while (1) { + intptr_t size = sizeof(buf), got; + + if (SCHEME_INTP(count)) { + intptr_t c = SCHEME_INT_VAL(count); + if (!c) + break; + if (c < size) + size = c; + } + + got = scheme_get_byte_string(name, o, + buf, 0, size, + 0, 0, NULL); + if (got == EOF) + break; + + if (!SCHEME_INTP(skip)) { + skip = scheme_bin_minus(skip, scheme_make_integer(got)); + } else { + intptr_t s = SCHEME_INT_VAL(skip), delta = 0; + + if (s > 0) { + if (s < got) { + delta = s; + got -= s; + skip = scheme_make_integer(0); + } else { + got = 0; + skip = scheme_make_integer(s-got); + } + } + + if (got > 0) { + if (mode == SCHEME_DO_SHA1) + rktio_sha1_update(&ctx.sha1, (unsigned char *)buf, delta, delta + got); + else + rktio_sha2_update(&ctx.sha2, (unsigned char *)buf, delta, delta + got); + if (!SCHEME_FALSEP(count)) + count = scheme_bin_minus(count, scheme_make_integer(got)); + } + } + } + } else { + scheme_wrong_contract(name, "(or/c bytes? input-port?)", 0, argc, argv); + return NULL; + } + + if (mode == SCHEME_DO_SHA1) { + rktio_sha1_final(&ctx.sha1, r); + sz = RKTIO_SHA1_DIGEST_SIZE; + } else { + rktio_sha2_final(&ctx.sha2, r); + if (mode == SCHEME_DO_SHA224) + sz = RKTIO_SHA224_DIGEST_SIZE; + else + sz = RKTIO_SHA256_DIGEST_SIZE; + } + + return scheme_make_sized_byte_string((char *)r, sz, 1); +} + +static Scheme_Object *sha1_bytes(int argc, Scheme_Object **argv) +{ + return sha_bytes("sha1-bytes", argc, argv, SCHEME_DO_SHA1); +} + +static Scheme_Object *sha224_bytes(int argc, Scheme_Object **argv) +{ + return sha_bytes("sha224-bytes", argc, argv, SCHEME_DO_SHA224); +} + +static Scheme_Object *sha256_bytes(int argc, Scheme_Object **argv) +{ + return sha_bytes("sha256-bytes", argc, argv, SCHEME_DO_SHA256); +} + /*========================================================================*/ /* precise GC traversers */ /*========================================================================*/ diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 6dd2622a6f..fa9727bb58 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1432 +#define EXPECTED_PRIM_COUNT 1435 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 556b8f0511..db97cba1aa 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "7.0.0.4" +#define MZSCHEME_VERSION "7.0.0.5" #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 4 +#define MZSCHEME_VERSION_W 5 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/rktio/Makefile.in b/racket/src/rktio/Makefile.in index b17becca96..5abf3d121e 100644 --- a/racket/src/rktio/Makefile.in +++ b/racket/src/rktio/Makefile.in @@ -40,6 +40,8 @@ OBJS = rktio_fs.@LTO@ \ rktio_time.@LTO@ \ rktio_syslog.@LTO@ \ rktio_convert.@LTO@ \ + rktio_sha1.@LTO@ \ + rktio_sha2.@LTO@ \ rktio_dll.@LTO@ \ rktio_error.@LTO@ \ rktio_hash.@LTO@ \ @@ -113,6 +115,12 @@ rktio_syslog.@LTO@: $(srcdir)/rktio_syslog.c $(RKTIO_HEADERS) rktio_convert.@LTO@: $(srcdir)/rktio_convert.c $(RKTIO_HEADERS) $(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_convert.@LTO@ -c $(srcdir)/rktio_convert.c +rktio_sha1.@LTO@: $(srcdir)/rktio_sha1.c $(RKTIO_HEADERS) + $(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_sha1.@LTO@ -c $(srcdir)/rktio_sha1.c + +rktio_sha2.@LTO@: $(srcdir)/rktio_sha2.c $(RKTIO_HEADERS) + $(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_sha2.@LTO@ -c $(srcdir)/rktio_sha2.c + rktio_dll.@LTO@: $(srcdir)/rktio_dll.c $(RKTIO_HEADERS) $(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_dll.@LTO@ -c $(srcdir)/rktio_dll.c diff --git a/racket/src/rktio/configure b/racket/src/rktio/configure index ffa9ddae28..961d4e52a0 100755 --- a/racket/src/rktio/configure +++ b/racket/src/rktio/configure @@ -701,6 +701,7 @@ enable_shared enable_standalone enable_pthread enable_iconv +enable_bigendian ' ac_precious_vars='build_alias host_alias @@ -1327,6 +1328,7 @@ Optional Features: --enable-standalone create a standalone shared library --enable-pthread link with pthreads (usually auto-enabled if needed) --enable-iconv use iconv (usually auto-enabled) + --enable-bigendian assume "big" if endianness cannot be determined Some influential environment variables: CC C compiler command @@ -2268,6 +2270,11 @@ if test "${enable_iconv+set}" = set; then : enableval=$enable_iconv; fi +# Check whether --enable-bigendian was given. +if test "${enable_bigendian+set}" = set; then : + enableval=$enable_bigendian; +fi + if test "${enable_iconv}" = "" ; then enable_iconv=yes @@ -3867,6 +3874,242 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } +if ${ac_cv_c_bigendian+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_bigendian=unknown + # See if we're dealing with a universal compiler. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __APPLE_CC__ + not a universal capable compiler + #endif + typedef int dummy; + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + # Check for potential -arch flags. It is not universal unless + # there are at least two -arch flags with different values. + ac_arch= + ac_prev= + for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do + if test -n "$ac_prev"; then + case $ac_word in + i?86 | x86_64 | ppc | ppc64) + if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then + ac_arch=$ac_word + else + ac_cv_c_bigendian=universal + break + fi + ;; + esac + ac_prev= + elif test "x$ac_word" = "x-arch"; then + ac_prev=arch + fi + done +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test $ac_cv_c_bigendian = unknown; then + # See if sys/param.h defines the BYTE_ORDER macro. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + #include + +int +main () +{ +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ + && LITTLE_ENDIAN) + bogus endian macros + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + #include + +int +main () +{ +#if BYTE_ORDER != BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) + bogus endian macros + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to _BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +#ifndef _BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # Compile a test program. + if test "$cross_compiling" = yes; then : + # Try to guess by grepping values from an object file. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +short int ascii_mm[] = + { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; + short int ascii_ii[] = + { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; + int use_ascii (int i) { + return ascii_mm[i] + ascii_ii[i]; + } + short int ebcdic_ii[] = + { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; + short int ebcdic_mm[] = + { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; + int use_ebcdic (int i) { + return ebcdic_mm[i] + ebcdic_ii[i]; + } + extern int foo; + +int +main () +{ +return use_ascii (foo) == use_ebcdic (foo); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + ac_cv_c_bigendian=yes + fi + if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi + fi +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ + + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_bigendian=no +else + ac_cv_c_bigendian=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } + case $ac_cv_c_bigendian in #( + yes) + endianness=big;; #( + no) + endianness=little ;; #( + universal) + +$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h + + ;; #( + *) + endianness=unknown ;; + esac + +if test "${endianness}" = "unknown" ; then + if test "${enable_bigendian}" = "yes" ; then + endianness=big + else + echo configure: warning: cannot determine endianness, assuming little + fi +fi + +if test "${endianness}" = "big" ; then + +$as_echo "#define RKTIO_BIG_ENDIAN 1" >>confdefs.h + +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getaddrinfo" >&5 $as_echo_n "checking for getaddrinfo... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4404,6 +4647,7 @@ LTLIBOBJS=$ac_ltlibobjs + : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files diff --git a/racket/src/rktio/configure.ac b/racket/src/rktio/configure.ac index 9958045514..0fc7e6c1bd 100644 --- a/racket/src/rktio/configure.ac +++ b/racket/src/rktio/configure.ac @@ -14,6 +14,7 @@ AC_ARG_ENABLE(shared, [ --enable-shared create shared libraries (ok AC_ARG_ENABLE(standalone, [ --enable-standalone create a standalone shared library]) AC_ARG_ENABLE(pthread, [ --enable-pthread link with pthreads (usually auto-enabled if needed)]) AC_ARG_ENABLE(iconv, [ --enable-iconv use iconv (usually auto-enabled)]) +AC_ARG_ENABLE(bigendian, [ --enable-bigendian assume "big" if endianness cannot be determined]) if test "${enable_iconv}" = "" ; then enable_iconv=yes @@ -135,6 +136,19 @@ AC_LANG_C AC_TYPE_INTPTR_T AC_TYPE_UINTPTR_T +AC_C_BIGENDIAN(endianness=big, endianness=little, endianness=unknown) +if test "${endianness}" = "unknown" ; then + if test "${enable_bigendian}" = "yes" ; then + endianness=big + else + echo configure: warning: cannot determine endianness, assuming little + fi +fi + +if test "${endianness}" = "big" ; then + AC_DEFINE(RKTIO_BIG_ENDIAN,1,[Big endian]) +fi + AC_MSG_CHECKING([for getaddrinfo]) AC_TRY_LINK([#include #include diff --git a/racket/src/rktio/parse.rkt b/racket/src/rktio/parse.rkt index a322bdc3ec..4f6b915f24 100644 --- a/racket/src/rktio/parse.rkt +++ b/racket/src/rktio/parse.rkt @@ -49,9 +49,9 @@ (define-empty-tokens delim-tokens (EOF WHITESPACE - OPEN CLOSE COPEN CCLOSE SEMI COMMA STAR LSHIFT EQUAL + OPEN CLOSE BOPEN BCLOSE COPEN CCLOSE SEMI COMMA STAR LSHIFT EQUAL __RKTIO_H__ EXTERN EXTERN/NOERR EXTERN/STEP EXTERN/ERR - DEFINE TYPEDEF ENUM STRUCT VOID UNSIGNED SHORT INT + DEFINE TYPEDEF ENUM STRUCT VOID UNSIGNED SHORT INT CHAR CONST NULLABLE BLOCKING)) (define lex @@ -60,6 +60,8 @@ [";" 'SEMI] ["(" 'OPEN] [")" 'CLOSE] + ["[" 'BOPEN] + ["]" 'BCLOSE] ["{" 'COPEN] ["}" 'CCLOSE] ["*" 'STAR] @@ -74,6 +76,7 @@ ["unsigned" 'UNSIGNED] ["short" 'SHORT] ["int" 'INT] + ["char" 'CHAR] ["const" 'CONST] ["__RKTIO_H__" '__RKTIO_H__] ["RKTIO_EXTERN" 'EXTERN] @@ -126,6 +129,8 @@ (if (eq? $2 $5) `(define-struct-type ,$2 ,$4) (error 'parse "typedef struct names don't match at ~s" $5))] + [(TYPEDEF STAR OPEN STAR CLOSE OPEN SEMI) + `(define-type ,$6 function-pointer)] [( OPEN SEMI) (let ([r-type (shift-stars $4 $3)] [id (unstar $4)]) @@ -151,7 +156,8 @@ (append (map (lambda (id) `(,(shift-stars id $1) ,(unstar id))) $2) $3)]) ( [(ID) $1] - [(STAR ) `(*ref ,$2)]) + [(STAR ) `(*ref ,$2)] + [(ID BOPEN NUM BCLOSE) `(array ,$3 ,$1)]) ( [( SEMI) (list $1)] [( COMMA ) (cons $1 $3)]) ( [(ID) $1] @@ -161,11 +167,13 @@ ( [(ID) $1] [(CONST ) $2] [(NULLABLE ) `(nullable ,$2)] - [(UNSIGNED SHORT) `unsigned-short] - [(UNSIGNED INT) `unsigned] + [(UNSIGNED SHORT) 'unsigned-short] + [(UNSIGNED INT) 'unsigned] + [(UNSIGNED CHAR) 'unsigned-8] [(UNSIGNED) 'unsigned] [(INT) 'int] [(SHORT) 'short] + [(CHAR) 'char] [(VOID) 'void] [(STRUCT ID) $2]) ( [() $1])))) @@ -182,16 +190,24 @@ [else (list def-kind)])) (define (shift-stars from to) - (if (and (pair? from) - (eq? '*ref (car from))) - `(*ref ,(shift-stars (cadr from) to)) - to)) + (cond + [(and (pair? from) + (eq? '*ref (car from))) + `(*ref ,(shift-stars (cadr from) to))] + [(and (pair? from) + (eq? 'array (car from))) + `(array ,(cadr from) ,(shift-stars (caddr from) to))] + [else to])) (define (unstar from) - (if (and (pair? from) - (eq? '*ref (car from))) - (unstar (cadr from)) - from)) + (cond + [(and (pair? from) + (eq? '*ref (car from))) + (unstar (cadr from))] + [(and (pair? from) + (eq? 'array (car from))) + (unstar (caddr from))] + [else from])) (define (enum-definitions l) (let loop ([l l] [i 0]) @@ -246,7 +262,7 @@ (define defined-types (let ([ht (for/hash ([e (in-list type-content)]) (values (cadr e) #t))]) - (for/fold ([ht ht]) ([t (in-list '(char int unsigned-short + (for/fold ([ht ht]) ([t (in-list '(char int unsigned-short unsigned-8 intptr_t rktio_int64_t))]) (hash-set ht t #t)))) diff --git a/racket/src/rktio/rktio.def b/racket/src/rktio/rktio.def index ed1ae4ff47..b1d569e2ea 100644 --- a/racket/src/rktio/rktio.def +++ b/racket/src/rktio/rktio.def @@ -179,9 +179,16 @@ rktio_set_locale rktio_push_c_numeric_locale rktio_pop_c_numeric_locale rktio_system_language_country +rktio_sha1_init +rktio_sha1_update +rktio_sha1_final +rktio_sha2_init +rktio_sha2_update +rktio_sha2_final rktio_dll_open rktio_dll_find_object rktio_dll_get_error +rktio_set_dll_procs rktio_get_last_error_kind rktio_get_last_error rktio_get_last_error_step diff --git a/racket/src/rktio/rktio.h b/racket/src/rktio/rktio.h index a867ca3068..ea914dccff 100644 --- a/racket/src/rktio/rktio.h +++ b/racket/src/rktio/rktio.h @@ -1135,6 +1135,46 @@ RKTIO_EXTERN char *rktio_system_language_country(rktio_t *rktio); /* Returns the current system's language in country in a 5-character format such as "en_US". */ + +/*************************************************/ +/* SHA-1, SHA-224, SHA-256 */ + +/* From Steve Reid's implementation at https://www.ghostscript.com/ */ + +typedef struct rktio_sha1_ctx_t { + unsigned int state[5]; + unsigned int count[2]; + unsigned char buffer[64]; +} rktio_sha1_ctx_t; + +#define RKTIO_SHA1_DIGEST_SIZE 20 + +RKTIO_EXTERN void rktio_sha1_init(rktio_sha1_ctx_t *context); +/* Initialize a context, which is memory of length `rktio_sha1_ctx_size()` + containing no pointers. */ + +RKTIO_EXTERN void rktio_sha1_update(rktio_sha1_ctx_t *context, + const unsigned char *data, intptr_t start, intptr_t end); +/* Add some bytes to the hash. */ + +RKTIO_EXTERN void rktio_sha1_final(rktio_sha1_ctx_t *context, unsigned char *digest /* RKTIO_SHA1_DIGEST_SIZE */); +/* Get the final hash value after all bytes have been added. */ + +typedef struct rktio_sha2_ctx_t { + unsigned total[2]; + unsigned state[8]; + unsigned char buffer[64]; + int is224; +} rktio_sha2_ctx_t; + +#define RKTIO_SHA224_DIGEST_SIZE 28 +#define RKTIO_SHA256_DIGEST_SIZE 32 + +RKTIO_EXTERN void rktio_sha2_init(rktio_sha2_ctx_t *ctx, rktio_bool_t is224); +RKTIO_EXTERN void rktio_sha2_update(rktio_sha2_ctx_t *ctx, + const unsigned char *data, intptr_t start, intptr_t end); +RKTIO_EXTERN void rktio_sha2_final(rktio_sha2_ctx_t *ctx, unsigned char *digest /* RKTIO_SHA2{24,56}_DIGEST_SIZE */); + /*************************************************/ /* Dynamically loaded libraries */ diff --git a/racket/src/rktio/rktio.inc b/racket/src/rktio/rktio.inc index f1a1ea9326..bcadc28b0c 100644 --- a/racket/src/rktio/rktio.inc +++ b/racket/src/rktio/rktio.inc @@ -179,9 +179,16 @@ Sforeign_symbol("rktio_set_locale", (void *)rktio_set_locale); Sforeign_symbol("rktio_push_c_numeric_locale", (void *)rktio_push_c_numeric_locale); Sforeign_symbol("rktio_pop_c_numeric_locale", (void *)rktio_pop_c_numeric_locale); Sforeign_symbol("rktio_system_language_country", (void *)rktio_system_language_country); +Sforeign_symbol("rktio_sha1_init", (void *)rktio_sha1_init); +Sforeign_symbol("rktio_sha1_update", (void *)rktio_sha1_update); +Sforeign_symbol("rktio_sha1_final", (void *)rktio_sha1_final); +Sforeign_symbol("rktio_sha2_init", (void *)rktio_sha2_init); +Sforeign_symbol("rktio_sha2_update", (void *)rktio_sha2_update); +Sforeign_symbol("rktio_sha2_final", (void *)rktio_sha2_final); Sforeign_symbol("rktio_dll_open", (void *)rktio_dll_open); Sforeign_symbol("rktio_dll_find_object", (void *)rktio_dll_find_object); Sforeign_symbol("rktio_dll_get_error", (void *)rktio_dll_get_error); +Sforeign_symbol("rktio_set_dll_procs", (void *)rktio_set_dll_procs); Sforeign_symbol("rktio_get_last_error_kind", (void *)rktio_get_last_error_kind); Sforeign_symbol("rktio_get_last_error", (void *)rktio_get_last_error); Sforeign_symbol("rktio_get_last_error_step", (void *)rktio_get_last_error_step); diff --git a/racket/src/rktio/rktio.rktl b/racket/src/rktio/rktio.rktl index 923057e140..eeb68df1cb 100644 --- a/racket/src/rktio/rktio.rktl +++ b/racket/src/rktio/rktio.rktl @@ -110,6 +110,9 @@ (define-constant RKTIO_CONVERT_STRCOLL_UTF16 (<< 1 1)) (define-constant RKTIO_CONVERT_RECASE_UTF16 (<< 1 2)) (define-constant RKTIO_CONVERT_ERROR -1) +(define-constant RKTIO_SHA1_DIGEST_SIZE 20) +(define-constant RKTIO_SHA224_DIGEST_SIZE 28) +(define-constant RKTIO_SHA256_DIGEST_SIZE 32) (define-constant RKTIO_ERROR_KIND_POSIX 0) (define-constant RKTIO_ERROR_KIND_WINDOWS 1) (define-constant RKTIO_ERROR_KIND_GAI 2) @@ -188,6 +191,19 @@ (define-struct-type rktio_convert_result_t ((intptr_t in_consumed) (intptr_t out_produced) (intptr_t converted))) +(define-struct-type + rktio_sha1_ctx_t + (((array 5 unsigned) state) + ((array 2 unsigned) count) + ((array 64 unsigned-8) buffer))) +(define-struct-type + rktio_sha2_ctx_t + (((array 2 unsigned) total) + ((array 8 unsigned) state) + ((array 64 unsigned-8) buffer) + (int is224))) +(define-type dll_open_proc function-pointer) +(define-type dll_find_object_proc function-pointer) (define-function () (ref rktio_t) rktio_init ()) (define-function () void rktio_destroy (((ref rktio_t) rktio))) (define-function () void rktio_free (((ref void) p))) @@ -1278,6 +1294,38 @@ (ref char) rktio_system_language_country (((ref rktio_t) rktio))) +(define-function () void rktio_sha1_init (((*ref rktio_sha1_ctx_t) context))) +(define-function + () + void + rktio_sha1_update + (((*ref rktio_sha1_ctx_t) context) + ((*ref unsigned-8) data) + (intptr_t start) + (intptr_t end))) +(define-function + () + void + rktio_sha1_final + (((*ref rktio_sha1_ctx_t) context) ((*ref unsigned-8) digest))) +(define-function + () + void + rktio_sha2_init + (((*ref rktio_sha2_ctx_t) ctx) (rktio_bool_t is224))) +(define-function + () + void + rktio_sha2_update + (((*ref rktio_sha2_ctx_t) ctx) + ((*ref unsigned-8) data) + (intptr_t start) + (intptr_t end))) +(define-function + () + void + rktio_sha2_final + (((*ref rktio_sha2_ctx_t) ctx) ((*ref unsigned-8) digest))) (define-function/errno NULL () @@ -1296,6 +1344,11 @@ (ref char) rktio_dll_get_error (((ref rktio_t) rktio))) +(define-function + () + void + rktio_set_dll_procs + ((dll_open_proc dll_open) (dll_find_object_proc dll_find_object))) (define-function () int rktio_get_last_error_kind (((ref rktio_t) rktio))) (define-function () int rktio_get_last_error (((ref rktio_t) rktio))) (define-function () int rktio_get_last_error_step (((ref rktio_t) rktio))) diff --git a/racket/src/rktio/rktio_config.h.in b/racket/src/rktio/rktio_config.h.in index 4d410959ef..03233eb892 100644 --- a/racket/src/rktio/rktio_config.h.in +++ b/racket/src/rktio/rktio_config.h.in @@ -34,6 +34,9 @@ typedef long long rktio_int64_t; typedef unsigned long long rktio_uint64_t; #endif +/* Endianness. */ +#undef RKTIO_BIG_ENDIAN + /* Whether pthread is available */ #undef RKTIO_USE_PTHREADS diff --git a/racket/src/rktio/rktio_sha1.c b/racket/src/rktio/rktio_sha1.c new file mode 100644 index 0000000000..49745355c6 --- /dev/null +++ b/racket/src/rktio/rktio_sha1.c @@ -0,0 +1,404 @@ +/* +SHA-1 in C +By Steve Reid +100% Public Domain + +----------------- +Modified 7/98 +By James H. Brown +Still 100% Public Domain + +Corrected a problem which generated improper hash values on 16 bit machines +Routine SHA1Update changed from + void SHA1Update(SHA1_CTX* context, unsigned char* data, unsigned int +len) +to + void SHA1Update(SHA1_CTX* context, unsigned char* data, unsigned +long len) + +The 'len' parameter was declared an int which works fine on 32 bit machines. +However, on 16 bit machines an int is too small for the shifts being done +against +it. This caused the hash function to generate incorrect values if len was +greater than 8191 (8K - 1) due to the 'len << 3' on line 3 of SHA1Update(). + +Since the file IO in main() reads 16K at a time, any file 8K or larger would +be guaranteed to generate the wrong hash (e.g. Test Vector #3, a million +"a"s). + +I also changed the declaration of variables i & j in SHA1Update to +unsigned long from unsigned int for the same reason. + +These changes should make no difference to any 32 bit implementations since +an +int and a long are the same size in those environments. + +-- +I also corrected a few compiler warnings generated by Borland C. +1. Added #include for exit() prototype +2. Removed unused variable 'j' in SHA1Final +3. Changed exit(0) to return(0) at end of main. + +ALL changes I made can be located by searching for comments containing 'JHB' +----------------- +Modified 8/98 +By Steve Reid +Still 100% public domain + +1- Removed #include and used return() instead of exit() +2- Fixed overwriting of finalcount in SHA1Final() (discovered by Chris Hall) +3- Changed email address from steve@edmweb.com to sreid@sea-to-sky.net + +----------------- +Modified 4/01 +By Saul Kravitz +Still 100% PD +Modified to run on Compaq Alpha hardware. + +----------------- +Modified 07/2002 +By Ralph Giles +Still 100% public domain +modified for use with stdint types, autoconf +code cleanup, removed attribution comments +switched SHA1Final() argument order for consistency +use SHA1_ prefix for public api +move public api to sha1.h + +----------------- +Modified 06/2018 +By Matthew Flatt +Still 100% public domain, in case that's somehow useful +Adapted to rktio + +*/ + +/* +Test Vectors (from FIPS PUB 180-1) +"abc" + A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D +"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1 +A million repetitions of "a" + 34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F +*/ + +#define SHA1HANDSOFF 1 + +#include "rktio.h" + +#include +#include + +/* rktio requires certain integer sizes, anyway: */ +typedef unsigned int uint32_sha1_t; +typedef unsigned char uint8_sha1_t; +typedef uintptr_t size_sha1_t; + +typedef rktio_sha1_ctx_t SHA1_CTX; + +#define SHA1_DIGEST_SIZE 20 + +static void SHA1_Transform(uint32_sha1_t state[5], const uint8_sha1_t buffer[64]); + +#define rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits)))) + +/* blk0() and blk() perform the initial expand. */ +/* I got the idea of expanding during the round function from SSLeay */ +/* FIXME: can we do this in an endian-proof way? */ +#ifdef RKTIO_BIG_ENDIAN +#define blk0(i) block->l[i] +#else +#define blk0(i) (block->l[i] = (rol(block->l[i],24)&0xFF00FF00) \ + |(rol(block->l[i],8)&0x00FF00FF)) +#endif +#define blk(i) (block->l[i&15] = rol(block->l[(i+13)&15]^block->l[(i+8)&15] \ + ^block->l[(i+2)&15]^block->l[i&15],1)) + +/* (R0+R1), R2, R3, R4 are the different operations used in SHA1 */ +#define R0(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk0(i)+0x5A827999+rol(v,5);w=rol(w,30); +#define R1(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk(i)+0x5A827999+rol(v,5);w=rol(w,30); +#define R2(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0x6ED9EBA1+rol(v,5);w=rol(w,30); +#define R3(v,w,x,y,z,i) z+=(((w|x)&y)|(w&x))+blk(i)+0x8F1BBCDC+rol(v,5);w=rol(w,30); +#define R4(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0xCA62C1D6+rol(v,5);w=rol(w,30); + +#ifdef VERBOSE /* SAK */ +void +SHAPrintContext(SHA1_CTX *context, char *msg) +{ + printf("%s (%d,%d) %x %x %x %x %x\n", + msg, context->count[0], context->count[1], context->state[0], context->state[1], context->state[2], context->state[3], context->state[4]); +} +#endif /* VERBOSE */ + +/* Hash a single 512-bit block. This is the core of the algorithm. */ +void +SHA1_Transform(uint32_sha1_t state[5], const uint8_sha1_t buffer[64]) +{ + uint32_sha1_t a, b, c, d, e; + typedef union { + uint8_sha1_t c[64]; + uint32_sha1_t l[16]; + } CHAR64LONG16; + CHAR64LONG16 *block; + +#ifdef SHA1HANDSOFF + uint8_sha1_t workspace[64]; + + block = (CHAR64LONG16 *) workspace; + memcpy(block, buffer, 64); +#else + block = (CHAR64LONG16 *) buffer; +#endif + + /* Copy context->state[] to working vars */ + a = state[0]; + b = state[1]; + c = state[2]; + d = state[3]; + e = state[4]; + + /* 4 rounds of 20 operations each. Loop unrolled. */ + R0(a,b,c,d,e, 0); R0(e,a,b,c,d, 1); R0(d,e,a,b,c, 2); R0(c,d,e,a,b, 3); + R0(b,c,d,e,a, 4); R0(a,b,c,d,e, 5); R0(e,a,b,c,d, 6); R0(d,e,a,b,c, 7); + R0(c,d,e,a,b, 8); R0(b,c,d,e,a, 9); R0(a,b,c,d,e,10); R0(e,a,b,c,d,11); + R0(d,e,a,b,c,12); R0(c,d,e,a,b,13); R0(b,c,d,e,a,14); R0(a,b,c,d,e,15); + R1(e,a,b,c,d,16); R1(d,e,a,b,c,17); R1(c,d,e,a,b,18); R1(b,c,d,e,a,19); + R2(a,b,c,d,e,20); R2(e,a,b,c,d,21); R2(d,e,a,b,c,22); R2(c,d,e,a,b,23); + R2(b,c,d,e,a,24); R2(a,b,c,d,e,25); R2(e,a,b,c,d,26); R2(d,e,a,b,c,27); + R2(c,d,e,a,b,28); R2(b,c,d,e,a,29); R2(a,b,c,d,e,30); R2(e,a,b,c,d,31); + R2(d,e,a,b,c,32); R2(c,d,e,a,b,33); R2(b,c,d,e,a,34); R2(a,b,c,d,e,35); + R2(e,a,b,c,d,36); R2(d,e,a,b,c,37); R2(c,d,e,a,b,38); R2(b,c,d,e,a,39); + R3(a,b,c,d,e,40); R3(e,a,b,c,d,41); R3(d,e,a,b,c,42); R3(c,d,e,a,b,43); + R3(b,c,d,e,a,44); R3(a,b,c,d,e,45); R3(e,a,b,c,d,46); R3(d,e,a,b,c,47); + R3(c,d,e,a,b,48); R3(b,c,d,e,a,49); R3(a,b,c,d,e,50); R3(e,a,b,c,d,51); + R3(d,e,a,b,c,52); R3(c,d,e,a,b,53); R3(b,c,d,e,a,54); R3(a,b,c,d,e,55); + R3(e,a,b,c,d,56); R3(d,e,a,b,c,57); R3(c,d,e,a,b,58); R3(b,c,d,e,a,59); + R4(a,b,c,d,e,60); R4(e,a,b,c,d,61); R4(d,e,a,b,c,62); R4(c,d,e,a,b,63); + R4(b,c,d,e,a,64); R4(a,b,c,d,e,65); R4(e,a,b,c,d,66); R4(d,e,a,b,c,67); + R4(c,d,e,a,b,68); R4(b,c,d,e,a,69); R4(a,b,c,d,e,70); R4(e,a,b,c,d,71); + R4(d,e,a,b,c,72); R4(c,d,e,a,b,73); R4(b,c,d,e,a,74); R4(a,b,c,d,e,75); + R4(e,a,b,c,d,76); R4(d,e,a,b,c,77); R4(c,d,e,a,b,78); R4(b,c,d,e,a,79); + + /* Add the working vars back into context.state[] */ + state[0] += a; + state[1] += b; + state[2] += c; + state[3] += d; + state[4] += e; + + /* Wipe variables */ + a = b = c = d = e = 0; +} + +/* SHA1Init - Initialize new context */ +static void +SHA1_Init(SHA1_CTX *context) +{ + /* SHA1 initialization constants */ + context->state[0] = 0x67452301; + context->state[1] = 0xEFCDAB89; + context->state[2] = 0x98BADCFE; + context->state[3] = 0x10325476; + context->state[4] = 0xC3D2E1F0; + context->count[0] = context->count[1] = 0; +} + +/* Run your data through this. */ +static void +SHA1_Update(SHA1_CTX *context, const uint8_sha1_t *data, const size_sha1_t len) +{ + size_sha1_t i, j; + +#ifdef VERBOSE + SHAPrintContext(context, "before"); +#endif + + j = (context->count[0] >> 3) & 63; + if ((context->count[0] += len << 3) < (len << 3)) + context->count[1]++; + context->count[1] += (len >> 29); + if ((j + len) > 63) { + memcpy(&context->buffer[j], data, (i = 64 - j)); + SHA1_Transform(context->state, context->buffer); + for (; i + 63 < len; i += 64) { + SHA1_Transform(context->state, data + i); + } + j = 0; + } else + i = 0; + memcpy(&context->buffer[j], &data[i], len - i); + +#ifdef VERBOSE + SHAPrintContext(context, "after "); +#endif +} + +/* Add padding and return the message digest. */ +static void +SHA1_Final(SHA1_CTX *context, uint8_sha1_t digest[SHA1_DIGEST_SIZE]) +{ + uint32_sha1_t i; + uint8_sha1_t finalcount[8]; + + for (i = 0; i < 8; i++) { + finalcount[i] = (unsigned char)((context->count[(i >= 4 ? 0 : 1)] + >> ((3 - (i & 3)) * 8)) & 255); /* Endian independent */ + } + SHA1_Update(context, (uint8_sha1_t *) "\200", 1); + while ((context->count[0] & 504) != 448) { + SHA1_Update(context, (uint8_sha1_t *) "\0", 1); + } + SHA1_Update(context, finalcount, 8); /* Should cause a SHA1_Transform() */ + for (i = 0; i < SHA1_DIGEST_SIZE; i++) { + digest[i] = (uint8_sha1_t) + ((context->state[i >> 2] >> ((3 - (i & 3)) * 8)) & 255); + } + + /* Wipe variables */ + i = 0; + memset(context->buffer, 0, 64); + memset(context->state, 0, 20); + memset(context->count, 0, 8); + memset(finalcount, 0, 8); /* SWR */ + +#ifdef SHA1HANDSOFF /* make SHA1Transform overwrite its own static vars */ + SHA1_Transform(context->state, context->buffer); +#endif +} + +/*************************************************************/ + +#if 0 +int +main(int argc, char **argv) +{ + int i, j; + SHA1_CTX context; + unsigned char digest[SHA1_DIGEST_SIZE], buffer[16384]; + FILE *file; + + if (argc > 2) { + puts("Public domain SHA-1 implementation - by Steve Reid "); + puts("Modified for 16 bit environments 7/98 - by James H. Brown "); /* JHB */ + puts("Produces the SHA-1 hash of a file, or stdin if no file is specified."); + return (0); + } + if (argc < 2) { + file = stdin; + } else { + if (!(file = fopen(argv[1], "rb"))) { + fputs("Unable to open file.", stderr); + return (-1); + } + } + SHA1_Init(&context); + while (!feof(file)) { /* note: what if ferror(file) */ + i = fread(buffer, 1, 16384, file); + SHA1_Update(&context, buffer, i); + } + SHA1_Final(&context, digest); + fclose(file); + for (i = 0; i < SHA1_DIGEST_SIZE / 4; i++) { + for (j = 0; j < 4; j++) { + printf("%02X", digest[i * 4 + j]); + } + putchar(' '); + } + putchar('\n'); + return (0); /* JHB */ +} +#endif + +/* self test */ + +#ifdef TEST + +static char *test_data[] = { + "abc", + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", + "A million repetitions of 'a'" +}; +static char *test_results[] = { + "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D", + "84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1", + "34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F" +}; + +void +digest_to_hex(const uint8_sha1_t digest[SHA1_DIGEST_SIZE], char *output) +{ + int i, j; + char *c = output; + + for (i = 0; i < SHA1_DIGEST_SIZE / 4; i++) { + for (j = 0; j < 4; j++) { + sprintf(c, "%02X", digest[i * 4 + j]); + c += 2; + } + sprintf(c, " "); + c += 1; + } + *(c - 1) = '\0'; +} + +int +main(int argc, char **argv) +{ + int k; + SHA1_CTX context; + uint8_sha1_t digest[20]; + char output[80]; + + fprintf(stdout, "verifying SHA-1 implementation... "); + + for (k = 0; k < 2; k++) { + SHA1_Init(&context); + SHA1_Update(&context, (uint8_sha1_t *) test_data[k], strlen(test_data[k])); + SHA1_Final(&context, digest); + digest_to_hex(digest, output); + + if (strcmp(output, test_results[k])) { + fprintf(stdout, "FAIL\n"); + fprintf(stderr, "* hash of \"%s\" incorrect:\n", test_data[k]); + fprintf(stderr, "\t%s returned\n", output); + fprintf(stderr, "\t%s is correct\n", test_results[k]); + return (1); + } + } + /* million 'a' vector we feed separately */ + SHA1_Init(&context); + for (k = 0; k < 1000000; k++) + SHA1_Update(&context, (uint8_sha1_t *) "a", 1); + SHA1_Final(&context, digest); + digest_to_hex(digest, output); + if (strcmp(output, test_results[2])) { + fprintf(stdout, "FAIL\n"); + fprintf(stderr, "* hash of \"%s\" incorrect:\n", test_data[2]); + fprintf(stderr, "\t%s returned\n", output); + fprintf(stderr, "\t%s is correct\n", test_results[2]); + return (1); + } + + /* success */ + fprintf(stdout, "ok\n"); + return (0); +} +#endif /* TEST */ + +/* ******************************************************************** */ + +void rktio_sha1_init(rktio_sha1_ctx_t *context) +{ + SHA1_Init(context); +} + +void rktio_sha1_update(rktio_sha1_ctx_t *context, const unsigned char *data, intptr_t start, intptr_t end) +{ + SHA1_Update(context, data + start, end - start); +} + +void rktio_sha1_final(rktio_sha1_ctx_t *context, unsigned char *digest) +{ + SHA1_Final(context, digest); +} diff --git a/racket/src/rktio/rktio_sha2.c b/racket/src/rktio/rktio_sha2.c new file mode 100644 index 0000000000..9ba38b29b0 --- /dev/null +++ b/racket/src/rktio/rktio_sha2.c @@ -0,0 +1,464 @@ +/* + * FIPS-180-2 compliant SHA-256 implementation + * + * Copyright (C) 2006-2015, ARM Limited, All Rights Reserved + * SPDX-License-Identifier: Apache-2.0 + * + * Licensed under the Apache License, Version 2.0 (the "License"); you may + * not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, WITHOUT + * WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * This file is part of mbed TLS (https://tls.mbed.org) + */ +/* + * The SHA-256 Secure Hash Standard was published by NIST in 2002. + * + * http://csrc.nist.gov/publications/fips/fips180-2/fips180-2.pdf + */ +/* Adjusted by Matthew Flatt for rktio */ + +#include "rktio.h" + +#include +#include + +/* rktio requires certain integer sizes, anyway: */ +typedef unsigned int uint32_sha1_t; +typedef unsigned char uint8_sha1_t; +typedef uintptr_t size_sha1_t; + +typedef rktio_sha2_ctx_t mbedtls_sha256_context; + +#ifdef RKTIO_BIG_ENDIAN +# define GET_UINT32_BE(n,b,i) n = b[i] +# define PUT_UINT32_BE(n,b,i) b[i] = n +#endif + +/* + * 32-bit integer manipulation macros (big endian) + */ +#ifndef GET_UINT32_BE +#define GET_UINT32_BE(n,b,i) \ +do { \ + (n) = ( (uint32_t) (b)[(i) ] << 24 ) \ + | ( (uint32_t) (b)[(i) + 1] << 16 ) \ + | ( (uint32_t) (b)[(i) + 2] << 8 ) \ + | ( (uint32_t) (b)[(i) + 3] ); \ +} while( 0 ) +#endif + +#ifndef PUT_UINT32_BE +#define PUT_UINT32_BE(n,b,i) \ +do { \ + (b)[(i) ] = (unsigned char) ( (n) >> 24 ); \ + (b)[(i) + 1] = (unsigned char) ( (n) >> 16 ); \ + (b)[(i) + 2] = (unsigned char) ( (n) >> 8 ); \ + (b)[(i) + 3] = (unsigned char) ( (n) ); \ +} while( 0 ) +#endif + +static void mbedtls_sha256_init( mbedtls_sha256_context *ctx ) +{ + memset( ctx, 0, sizeof( mbedtls_sha256_context ) ); +} + +/* + * SHA-256 context setup + */ +static int mbedtls_sha256_starts_ret( mbedtls_sha256_context *ctx, int is224 ) +{ + ctx->total[0] = 0; + ctx->total[1] = 0; + + if( is224 == 0 ) + { + /* SHA-256 */ + ctx->state[0] = 0x6A09E667; + ctx->state[1] = 0xBB67AE85; + ctx->state[2] = 0x3C6EF372; + ctx->state[3] = 0xA54FF53A; + ctx->state[4] = 0x510E527F; + ctx->state[5] = 0x9B05688C; + ctx->state[6] = 0x1F83D9AB; + ctx->state[7] = 0x5BE0CD19; + } + else + { + /* SHA-224 */ + ctx->state[0] = 0xC1059ED8; + ctx->state[1] = 0x367CD507; + ctx->state[2] = 0x3070DD17; + ctx->state[3] = 0xF70E5939; + ctx->state[4] = 0xFFC00B31; + ctx->state[5] = 0x68581511; + ctx->state[6] = 0x64F98FA7; + ctx->state[7] = 0xBEFA4FA4; + } + + ctx->is224 = is224; + + return( 0 ); +} + +static const uint32_t K[] = +{ + 0x428A2F98, 0x71374491, 0xB5C0FBCF, 0xE9B5DBA5, + 0x3956C25B, 0x59F111F1, 0x923F82A4, 0xAB1C5ED5, + 0xD807AA98, 0x12835B01, 0x243185BE, 0x550C7DC3, + 0x72BE5D74, 0x80DEB1FE, 0x9BDC06A7, 0xC19BF174, + 0xE49B69C1, 0xEFBE4786, 0x0FC19DC6, 0x240CA1CC, + 0x2DE92C6F, 0x4A7484AA, 0x5CB0A9DC, 0x76F988DA, + 0x983E5152, 0xA831C66D, 0xB00327C8, 0xBF597FC7, + 0xC6E00BF3, 0xD5A79147, 0x06CA6351, 0x14292967, + 0x27B70A85, 0x2E1B2138, 0x4D2C6DFC, 0x53380D13, + 0x650A7354, 0x766A0ABB, 0x81C2C92E, 0x92722C85, + 0xA2BFE8A1, 0xA81A664B, 0xC24B8B70, 0xC76C51A3, + 0xD192E819, 0xD6990624, 0xF40E3585, 0x106AA070, + 0x19A4C116, 0x1E376C08, 0x2748774C, 0x34B0BCB5, + 0x391C0CB3, 0x4ED8AA4A, 0x5B9CCA4F, 0x682E6FF3, + 0x748F82EE, 0x78A5636F, 0x84C87814, 0x8CC70208, + 0x90BEFFFA, 0xA4506CEB, 0xBEF9A3F7, 0xC67178F2, +}; + +#define SHR(x,n) ((x & 0xFFFFFFFF) >> n) +#define ROTR(x,n) (SHR(x,n) | (x << (32 - n))) + +#define S0(x) (ROTR(x, 7) ^ ROTR(x,18) ^ SHR(x, 3)) +#define S1(x) (ROTR(x,17) ^ ROTR(x,19) ^ SHR(x,10)) + +#define S2(x) (ROTR(x, 2) ^ ROTR(x,13) ^ ROTR(x,22)) +#define S3(x) (ROTR(x, 6) ^ ROTR(x,11) ^ ROTR(x,25)) + +#define F0(x,y,z) ((x & y) | (z & (x | y))) +#define F1(x,y,z) (z ^ (x & (y ^ z))) + +#define R(t) \ +( \ + W[t] = S1(W[t - 2]) + W[t - 7] + \ + S0(W[t - 15]) + W[t - 16] \ +) + +#define P(a,b,c,d,e,f,g,h,x,K) \ +{ \ + temp1 = h + S3(e) + F1(e,f,g) + K + x; \ + temp2 = S2(a) + F0(a,b,c); \ + d += temp1; h = temp1 + temp2; \ +} + +static int mbedtls_internal_sha256_process( mbedtls_sha256_context *ctx, + const unsigned char data[64] ) +{ + uint32_t temp1, temp2, W[64]; + uint32_t A[8]; + unsigned int i; + + for( i = 0; i < 8; i++ ) + A[i] = ctx->state[i]; + +#if defined(MBEDTLS_SHA256_SMALLER) + for( i = 0; i < 64; i++ ) + { + if( i < 16 ) + GET_UINT32_BE( W[i], data, 4 * i ); + else + R( i ); + + P( A[0], A[1], A[2], A[3], A[4], A[5], A[6], A[7], W[i], K[i] ); + + temp1 = A[7]; A[7] = A[6]; A[6] = A[5]; A[5] = A[4]; A[4] = A[3]; + A[3] = A[2]; A[2] = A[1]; A[1] = A[0]; A[0] = temp1; + } +#else /* MBEDTLS_SHA256_SMALLER */ + for( i = 0; i < 16; i++ ) + GET_UINT32_BE( W[i], data, 4 * i ); + + for( i = 0; i < 16; i += 8 ) + { + P( A[0], A[1], A[2], A[3], A[4], A[5], A[6], A[7], W[i+0], K[i+0] ); + P( A[7], A[0], A[1], A[2], A[3], A[4], A[5], A[6], W[i+1], K[i+1] ); + P( A[6], A[7], A[0], A[1], A[2], A[3], A[4], A[5], W[i+2], K[i+2] ); + P( A[5], A[6], A[7], A[0], A[1], A[2], A[3], A[4], W[i+3], K[i+3] ); + P( A[4], A[5], A[6], A[7], A[0], A[1], A[2], A[3], W[i+4], K[i+4] ); + P( A[3], A[4], A[5], A[6], A[7], A[0], A[1], A[2], W[i+5], K[i+5] ); + P( A[2], A[3], A[4], A[5], A[6], A[7], A[0], A[1], W[i+6], K[i+6] ); + P( A[1], A[2], A[3], A[4], A[5], A[6], A[7], A[0], W[i+7], K[i+7] ); + } + + for( i = 16; i < 64; i += 8 ) + { + P( A[0], A[1], A[2], A[3], A[4], A[5], A[6], A[7], R(i+0), K[i+0] ); + P( A[7], A[0], A[1], A[2], A[3], A[4], A[5], A[6], R(i+1), K[i+1] ); + P( A[6], A[7], A[0], A[1], A[2], A[3], A[4], A[5], R(i+2), K[i+2] ); + P( A[5], A[6], A[7], A[0], A[1], A[2], A[3], A[4], R(i+3), K[i+3] ); + P( A[4], A[5], A[6], A[7], A[0], A[1], A[2], A[3], R(i+4), K[i+4] ); + P( A[3], A[4], A[5], A[6], A[7], A[0], A[1], A[2], R(i+5), K[i+5] ); + P( A[2], A[3], A[4], A[5], A[6], A[7], A[0], A[1], R(i+6), K[i+6] ); + P( A[1], A[2], A[3], A[4], A[5], A[6], A[7], A[0], R(i+7), K[i+7] ); + } +#endif /* MBEDTLS_SHA256_SMALLER */ + + for( i = 0; i < 8; i++ ) + ctx->state[i] += A[i]; + + return( 0 ); +} + +/* + * SHA-256 process buffer + */ +static int mbedtls_sha256_update_ret( mbedtls_sha256_context *ctx, + const unsigned char *input, + size_t ilen ) +{ + int ret; + size_t fill; + uint32_t left; + + if( ilen == 0 ) + return( 0 ); + + left = ctx->total[0] & 0x3F; + fill = 64 - left; + + ctx->total[0] += (uint32_t) ilen; + ctx->total[0] &= 0xFFFFFFFF; + + if( ctx->total[0] < (uint32_t) ilen ) + ctx->total[1]++; + + if( left && ilen >= fill ) + { + memcpy( (void *) (ctx->buffer + left), input, fill ); + + if( ( ret = mbedtls_internal_sha256_process( ctx, ctx->buffer ) ) != 0 ) + return( ret ); + + input += fill; + ilen -= fill; + left = 0; + } + + while( ilen >= 64 ) + { + if( ( ret = mbedtls_internal_sha256_process( ctx, input ) ) != 0 ) + return( ret ); + + input += 64; + ilen -= 64; + } + + if( ilen > 0 ) + memcpy( (void *) (ctx->buffer + left), input, ilen ); + + return( 0 ); +} + +static const unsigned char sha256_padding[64] = +{ + 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 +}; + +/* + * SHA-256 final digest + */ +static int mbedtls_sha256_finish_ret( mbedtls_sha256_context *ctx, + unsigned char output[32] ) +{ + int ret; + uint32_t last, padn; + uint32_t high, low; + unsigned char msglen[8]; + + high = ( ctx->total[0] >> 29 ) + | ( ctx->total[1] << 3 ); + low = ( ctx->total[0] << 3 ); + + PUT_UINT32_BE( high, msglen, 0 ); + PUT_UINT32_BE( low, msglen, 4 ); + + last = ctx->total[0] & 0x3F; + padn = ( last < 56 ) ? ( 56 - last ) : ( 120 - last ); + + if( ( ret = mbedtls_sha256_update_ret( ctx, sha256_padding, padn ) ) != 0 ) + return( ret ); + + if( ( ret = mbedtls_sha256_update_ret( ctx, msglen, 8 ) ) != 0 ) + return( ret ); + + PUT_UINT32_BE( ctx->state[0], output, 0 ); + PUT_UINT32_BE( ctx->state[1], output, 4 ); + PUT_UINT32_BE( ctx->state[2], output, 8 ); + PUT_UINT32_BE( ctx->state[3], output, 12 ); + PUT_UINT32_BE( ctx->state[4], output, 16 ); + PUT_UINT32_BE( ctx->state[5], output, 20 ); + PUT_UINT32_BE( ctx->state[6], output, 24 ); + + if( ctx->is224 == 0 ) + PUT_UINT32_BE( ctx->state[7], output, 28 ); + + return( 0 ); +} + +#if defined(MBEDTLS_SELF_TEST) +/* + * FIPS-180-2 test vectors + */ +static const unsigned char sha256_test_buf[3][57] = +{ + { "abc" }, + { "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" }, + { "" } +}; + +static const size_t sha256_test_buflen[3] = +{ + 3, 56, 1000 +}; + +static const unsigned char sha256_test_sum[6][32] = +{ + /* + * SHA-224 test vectors + */ + { 0x23, 0x09, 0x7D, 0x22, 0x34, 0x05, 0xD8, 0x22, + 0x86, 0x42, 0xA4, 0x77, 0xBD, 0xA2, 0x55, 0xB3, + 0x2A, 0xAD, 0xBC, 0xE4, 0xBD, 0xA0, 0xB3, 0xF7, + 0xE3, 0x6C, 0x9D, 0xA7 }, + { 0x75, 0x38, 0x8B, 0x16, 0x51, 0x27, 0x76, 0xCC, + 0x5D, 0xBA, 0x5D, 0xA1, 0xFD, 0x89, 0x01, 0x50, + 0xB0, 0xC6, 0x45, 0x5C, 0xB4, 0xF5, 0x8B, 0x19, + 0x52, 0x52, 0x25, 0x25 }, + { 0x20, 0x79, 0x46, 0x55, 0x98, 0x0C, 0x91, 0xD8, + 0xBB, 0xB4, 0xC1, 0xEA, 0x97, 0x61, 0x8A, 0x4B, + 0xF0, 0x3F, 0x42, 0x58, 0x19, 0x48, 0xB2, 0xEE, + 0x4E, 0xE7, 0xAD, 0x67 }, + + /* + * SHA-256 test vectors + */ + { 0xBA, 0x78, 0x16, 0xBF, 0x8F, 0x01, 0xCF, 0xEA, + 0x41, 0x41, 0x40, 0xDE, 0x5D, 0xAE, 0x22, 0x23, + 0xB0, 0x03, 0x61, 0xA3, 0x96, 0x17, 0x7A, 0x9C, + 0xB4, 0x10, 0xFF, 0x61, 0xF2, 0x00, 0x15, 0xAD }, + { 0x24, 0x8D, 0x6A, 0x61, 0xD2, 0x06, 0x38, 0xB8, + 0xE5, 0xC0, 0x26, 0x93, 0x0C, 0x3E, 0x60, 0x39, + 0xA3, 0x3C, 0xE4, 0x59, 0x64, 0xFF, 0x21, 0x67, + 0xF6, 0xEC, 0xED, 0xD4, 0x19, 0xDB, 0x06, 0xC1 }, + { 0xCD, 0xC7, 0x6E, 0x5C, 0x99, 0x14, 0xFB, 0x92, + 0x81, 0xA1, 0xC7, 0xE2, 0x84, 0xD7, 0x3E, 0x67, + 0xF1, 0x80, 0x9A, 0x48, 0xA4, 0x97, 0x20, 0x0E, + 0x04, 0x6D, 0x39, 0xCC, 0xC7, 0x11, 0x2C, 0xD0 } +}; + +/* + * Checkup routine + */ +int mbedtls_sha256_self_test( int verbose ) +{ + int i, j, k, buflen, ret = 0; + unsigned char *buf; + unsigned char sha256sum[32]; + mbedtls_sha256_context ctx; + + buf = mbedtls_calloc( 1024, sizeof(unsigned char) ); + if( NULL == buf ) + { + if( verbose != 0 ) + mbedtls_printf( "Buffer allocation failed\n" ); + + return( 1 ); + } + + mbedtls_sha256_init( &ctx ); + + for( i = 0; i < 6; i++ ) + { + j = i % 3; + k = i < 3; + + if( verbose != 0 ) + mbedtls_printf( " SHA-%d test #%d: ", 256 - k * 32, j + 1 ); + + if( ( ret = mbedtls_sha256_starts_ret( &ctx, k ) ) != 0 ) + goto fail; + + if( j == 2 ) + { + memset( buf, 'a', buflen = 1000 ); + + for( j = 0; j < 1000; j++ ) + { + ret = mbedtls_sha256_update_ret( &ctx, buf, buflen ); + if( ret != 0 ) + goto fail; + } + + } + else + { + ret = mbedtls_sha256_update_ret( &ctx, sha256_test_buf[j], + sha256_test_buflen[j] ); + if( ret != 0 ) + goto fail; + } + + if( ( ret = mbedtls_sha256_finish_ret( &ctx, sha256sum ) ) != 0 ) + goto fail; + + + if( memcmp( sha256sum, sha256_test_sum[i], 32 - k * 4 ) != 0 ) + { + ret = 1; + goto fail; + } + + if( verbose != 0 ) + mbedtls_printf( "passed\n" ); + } + + if( verbose != 0 ) + mbedtls_printf( "\n" ); + + goto exit; + +fail: + if( verbose != 0 ) + mbedtls_printf( "failed\n" ); + +exit: + mbedtls_sha256_free( &ctx ); + mbedtls_free( buf ); + + return( ret ); +} + +#endif /* MBEDTLS_SELF_TEST */ + +/* ************************************************************ */ + +void rktio_sha2_init(rktio_sha2_ctx_t *ctx, rktio_bool_t is224) +{ + (void)mbedtls_sha256_init(ctx); + (void)mbedtls_sha256_starts_ret(ctx, is224); +} + +void rktio_sha2_update(rktio_sha2_ctx_t *ctx, const unsigned char *data, intptr_t start, intptr_t end) +{ + (void)mbedtls_sha256_update_ret(ctx, data + start, end - start); +} + +void rktio_sha2_final(rktio_sha2_ctx_t *ctx, unsigned char *digest) +{ + (void)mbedtls_sha256_finish_ret(ctx, digest); +}