suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add sha1-bytes, sha224-bytes, and sha256-bytes via rktio

Browse Source 
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).
This commit is contained in:
Matthew Flatt 2018-06-25 13:35:45 -06:00
parent d72b70f8e1
commit cda4e5befe
34 changed files with 1716 additions and 334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -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]))

34
pkgs/racket-doc/file/scribblings/sha1.scrbl
View File

@ -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?]{

13
pkgs/racket-doc/openssl/openssl.scrbl
View File

@ -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?]{

1
pkgs/racket-doc/scribblings/reference/io.scrbl
View File

@ -17,4 +17,5 @@
@include-section["custom-write.scrbl"]
@include-section["serialization.scrbl"]
@include-section["fasl.scrbl"]
@include-section["sha.scrbl"]

63
pkgs/racket-doc/scribblings/reference/sha.scrbl Normal file
View File

@ -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]

5
pkgs/racket-index/scribblings/main/license.scrbl
View File

@ -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.

29
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -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)

9
racket/collects/compiler/private/cm-minimal.rkt
View File

@ -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 string<? #:key car) p)
;; compute one hash from all hashes
(sha1 (open-input-bytes (get-output-bytes p)))))))
(sha1 (get-output-bytes p))))))
(define (write-deps code path->mode 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)

293
racket/collects/file/sha1.rkt
View File

@ -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)]

11
racket/collects/openssl/sha1.rkt
View File

@ -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)))

13
racket/src/cs/demo/io.ss
View File

@ -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)

8
racket/src/cs/io.sls
View File

@ -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

3
racket/src/cs/primitive/kernel.ss
View File

@ -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)]

6
racket/src/gracket/Makefile.in
View File

@ -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@"

6
racket/src/io/demo.rkt
View File

@ -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"))

11
racket/src/io/host/bootstrap-rktio.rkt
View File

@ -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

2
racket/src/io/host/rktio.rkt
View File

@ -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)

2
racket/src/io/main.rkt
View File

@ -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")

94
racket/src/io/sha/main.rkt Normal file
View File

@ -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)

2
racket/src/racket/src/Makefile.in
View File

@ -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 \

149
racket/src/racket/src/portfun.c
View File

@ -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 */
/*========================================================================*/

2
racket/src/racket/src/schminc.h
View File

@ -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

4
racket/src/racket/src/schvers.h
View File

@ -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)

8
racket/src/rktio/Makefile.in
View File

@ -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

244
racket/src/rktio/configure vendored
View File

@ -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 <sys/types.h>
#include <sys/param.h>
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 <sys/types.h>
#include <sys/param.h>
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 <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <limits.h>
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 <limits.h>
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

14
racket/src/rktio/configure.ac
View File

@ -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 <sys/types.h>
#include <sys/socket.h>

44
racket/src/rktio/parse.rkt
View File

@ -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 <type> STAR OPEN STAR <id> CLOSE OPEN <params> SEMI)
`(define-type ,$6 function-pointer)]
[(<extern> <blocking> <return-type> <id> OPEN <params> 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> [(ID) $1]
[(STAR <id>) `(*ref ,$2)])
[(STAR <id>) `(*ref ,$2)]
[(ID BOPEN NUM BCLOSE) `(array ,$3 ,$1)])
(<ids> [(<id> SEMI) (list $1)]
[(<id> COMMA <ids>) (cons $1 $3)])
(<expr> [(ID) $1]
@ -161,11 +167,13 @@
(<type> [(ID) $1]
[(CONST <type>) $2]
[(NULLABLE <type>) `(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])
(<return-type> [(<type>) $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))))

7
racket/src/rktio/rktio.def
View File

@ -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

40
racket/src/rktio/rktio.h
View File

@ -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 */

7
racket/src/rktio/rktio.inc
View File

@ -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);

53
racket/src/rktio/rktio.rktl
View File

@ -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)))

3
racket/src/rktio/rktio_config.h.in
View File

@ -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

404
racket/src/rktio/rktio_sha1.c Normal file
View File

@ -0,0 +1,404 @@
/*
SHA-1 in C
By Steve Reid <sreid@sea-to-sky.net>
100% Public Domain
-----------------
Modified 7/98
By James H. Brown <jbrown@burgoyne.com>
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 <process.h> 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 <sreid@sea-to-sky.net>
Still 100% public domain
1- Removed #include <process.h> 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 <Saul.Kravitz@celera.com>
Still 100% PD
Modified to run on Compaq Alpha hardware.
-----------------
Modified 07/2002
By Ralph Giles <giles@ghostscript.com>
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 <stdio.h>
#include <string.h>
/* 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 <sreid@sea-to-sky.net>");
puts("Modified for 16 bit environments 7/98 - by James H. Brown <jbrown@burgoyne.com>"); /* 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);
}

464
racket/src/rktio/rktio_sha2.c Normal file
View File

@ -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 <stddef.h>
#include <string.h>
/* 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);
}