ref: a31ba7cf16c2335fe7478a3d08bd4bb649a311bf
parent: 41ff8acc4af96fb161fa0fa3e46b5a3b510590dc
author: Philip McGrath <philip@philipmcgrath.com>
date: Fri May 27 11:39:12 CDT 2022
Zuo: Use SHA-256. Also, document the use of concatenated SHA-256 strings for multi-file targets.
--- a/LICENSE.txt
+++ b/LICENSE.txt
@@ -8,3 +8,6 @@
and
https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt
for the full text of the licenses.
+
+The SHA-256 implementation is from mbed TLS. mbed TLS is licensed
+under the Apache v2.0 License.
--- a/lib/zuo/build.zuo
+++ b/lib/zuo/build.zuo
@@ -19,9 +19,10 @@
rule?
phony-rule?
- sha1?
- file-sha1
- no-sha1
+ sha256?
+ file-sha256
+ no-sha256
+ sha256-length
build
build/command-line
@@ -43,7 +44,7 @@
;; Targets and rules
;; A token represents a build in progress, used by a target's `get-rule` or `build`
-;; function to make recursive call or get SHA-1s (possibly cached)
+;; function to make recursive call or get SHA-256s (possibly cached)
(struct token (target ; the target that received this token
ch ; a channel to access the build state
seen ; to detect dependency cycles
@@ -58,8 +59,8 @@
;; A rule is a result from `get-rule`:
(struct rule (deps ; list of targets
- build ; (-> any), called when deps SHA-1s different than recorded
- sha1)) ; #f => computed via `file-sha1`
+ build ; (-> any), called when deps SHA-256s different than recorded
+ sha256)) ; #f => computed via `file-sha256`
;; A phony target returns a phony-rule, instead:
(struct phony-rule (deps
@@ -68,16 +69,16 @@
;; During a target's `get-rule` or `build`, calls to `build/dep`
;; trigger recording of additional dependencies
-(define no-sha1 "")
-(define phony-sha1 (string->uninterned-symbol "x")) ; internal use
-(define (sha1? s)
+(define no-sha256 "")
+(define phony-sha256 (string->uninterned-symbol "x")) ; internal use
+(define (sha256? s)
(or (and (string? s)
- (or (= (string-length s) 40)
- (string=? s no-sha1)
- ;; also allow a concatenation of SHA-1s for multi-file targets
- (and (>= (string-length s) 40)
- (= 0 (modulo (string-length s) 40)))))
- (eq? s phony-sha1)))
+ (or (= (string-length s) sha256-length)
+ (string=? s no-sha256)
+ ;; also allow a concatenation of SHA-256s for multi-file targets
+ (and (>= (string-length s) sha256-length)
+ (= 0 (modulo (string-length s) sha256-length)))))
+ (eq? s phony-sha256)))
;; public constructor
(define make-target
@@ -100,7 +101,7 @@
;; public constructor
(define make-rule
(let ([rule
- (lambda (deps [build #f] [sha1 #f])
+ (lambda (deps [build #f] [sha256 #f])
(let ([norm-deps (and (list? deps) (map coerce-to-target deps))])
(unless (and norm-deps (andmap target? norm-deps))
(arg-error 'rule "list of targets" deps))
@@ -107,9 +108,9 @@
(unless (or (not build)
(procedure? build))
(arg-error 'rule "procedure or #f" build))
- (unless (or (not sha1) (sha1? sha1))
- (arg-error 'rule "sha1 or #f" sha1))
- (rule norm-deps build sha1)))])
+ (unless (or (not sha256) (sha256? sha256))
+ (arg-error 'rule "sha256 or #f" sha256))
+ (rule norm-deps build sha256)))])
rule))
;; An input-file target has no dependencies
@@ -139,12 +140,12 @@
t))
(coerce-to-target t)))
-;; An input-data target supplies its SHA-1 up front
+;; An input-data target supplies its SHA-256 up front
(define (input-data-target name v)
(unless (symbol? name) (arg-error 'input-data-target "symbol" name))
(target (symbol->key name)
name
- (lambda (path token) (make-rule '() #f (string-sha1 (~s v))))
+ (lambda (path token) (make-rule '() #f (string-sha256 (~s v))))
'input
(hash)))
@@ -167,8 +168,8 @@
(rule (phony-rule-deps r)
(lambda ()
((phony-rule-build r))
- phony-sha1)
- phony-sha1)))
+ phony-sha256)
+ phony-sha256)))
(define (target-path t)
(unless (target? t) (arg-error 'target-path "target" t))
@@ -192,23 +193,23 @@
;; When a target is built, the build result is recorded as
;;
-;; (list sha1 (list dep-sym-or-path-rel-to-target sha1) ..)
+;; (list sha256 (list dep-sym-or-path-rel-to-target sha256) ...)
;;
;; This result is in the `target-state` field of a build state, while
;; `db` holds the same-shaped information from the previous build.
;;
;; The `time-cache` field of a build state is a shortcut for getting
-;; input-file SHA-1s on the assumption that a SHA-1 recorded last time
+;; input-file SHA-256s on the assumption that a SHA-256 recorded last time
;; is still right if the file's timestamp hasn't changed.
-;; Where the contracts below say "dep-sha1s", that's a hash table
-;; mapping a dependency's key to a SHA-1.
+;; Where the contracts below say "dep-sha256s", that's a hash table
+;; mapping a dependency's key to a SHA-256.
(struct build-state (ch ; channel to hold the state while target is running
- target-state ; key -> (cons sha1 dep-sha1s) | 'pending | channel
- target-accum ; key -> dep-sha1s
- db ; key -> (cons sha1 dep-sha1s) | #t [for db file itself]
- time-cache ; key -> (cons timestamp sha1)
+ target-state ; key -> (cons sha256 dep-sha256s) | 'pending | channel
+ target-accum ; key -> dep-sha256s
+ db ; key -> (cons sha256 dep-sha256s) | #t [for db file itself]
+ time-cache ; key -> (cons timestamp sha256)
saw-targets ; key -> target [to detect multiple for same output]
resource-ch ; channel with available resources enqueued
log? ; logging enabled?
@@ -314,9 +315,9 @@
[(eq? (target-kind t) 'input)
;; no dependencies, not need for a thread to build, etc.
(define r ((target-get-rule t) (target-name t) #f))
- (define sha1 (or (rule-sha1 r) (file-sha1/state (target-path t) state)))
- (when (equal? sha1 no-sha1) ((rule-build r)))
- (update-target-state state t (list sha1))]
+ (define sha256 (or (rule-sha256 r) (file-sha256/state (target-path t) state)))
+ (when (equal? sha256 no-sha256) ((rule-build r)))
+ (update-target-state state t (list sha256))]
[else (build-unbuilt t state seen top?)]))
;; Starts a build for a specific target
@@ -336,10 +337,10 @@
;; get previously recorded result, possibly loading from a file
;; that is cached in the build state
- (define loaded-state (load-sha1s state t path))
+ (define loaded-state (load-sha256s state t path))
(define prev-ts (previous-target-state loaded-state (target-key t)))
- (define prev-sha1 (car prev-ts))
- (define prev-dep-sha1s/raw-symbols (cdr prev-ts))
+ (define prev-sha256 (car prev-ts))
+ (define prev-dep-sha256s/raw-symbols (cdr prev-ts))
;; record a channel as the start's current build state
(define result-ch (channel))
@@ -357,23 +358,23 @@
(unless (rule? r)
(error "build: target result is not a rule" r))
(define deps (rule-deps r))
- (define sha1 (or (rule-sha1 r) (if (pair? co-outputs)
- (files-sha1 (cons path co-outputs) tok)
- (file-sha1 path tok))))
+ (define sha256 (or (rule-sha256 r) (if (pair? co-outputs)
+ (files-sha256 (cons path co-outputs) tok)
+ (file-sha256 path tok))))
(define to-build (rule-build r))
- (define build-to-sha1? (and (rule-sha1 r) #t))
+ (define build-to-sha256? (and (rule-sha256 r) #t))
;; if we recorded any data targets, we need to fix up the keys
- (define prev-dep-sha1s (foldl (lambda (dep-key dep-sha1s)
- (cond
- [(symbol-key? dep-key)
- (let ([actual-key (translate-key dep-key deps t)])
- (hash-set (hash-remove dep-sha1s dep-key)
- actual-key
- (hash-ref dep-sha1s dep-key)))]
- [else dep-sha1s]))
- prev-dep-sha1s/raw-symbols
- (hash-keys prev-dep-sha1s/raw-symbols)))
+ (define prev-dep-sha256s (foldl (lambda (dep-key dep-sha256s)
+ (cond
+ [(symbol-key? dep-key)
+ (let ([actual-key (translate-key dep-key deps t)])
+ (hash-set (hash-remove dep-sha256s dep-key)
+ actual-key
+ (hash-ref dep-sha256s dep-key)))]
+ [else dep-sha256s]))
+ prev-dep-sha256s/raw-symbols
+ (hash-keys prev-dep-sha256s/raw-symbols)))
(define rule-state (get-state (token-ch tok) "rule"))
@@ -386,14 +387,14 @@
rule-state
deps))
- ;; extract results, assemble in a hash table: <rel-path> -> <sha1>
- (define dep-reported-sha1s
- (foldl (lambda (dep dep-sha1s)
- (add-dependent-target-state dep dep-sha1s new-state))
+ ;; extract results, assemble in a hash table: <rel-path> -> <sha256>
+ (define dep-reported-sha256s
+ (foldl (lambda (dep dep-sha256s)
+ (add-dependent-target-state dep dep-sha256s new-state))
(hash)
deps))
- (define dep-sha1s
- (cdr (merge-target-accumulated new-state t (cons #f dep-reported-sha1s))))
+ (define dep-sha256s
+ (cdr (merge-target-accumulated new-state t (cons #f dep-reported-sha256s))))
;; calling the build step for `t` might generate more dependencies, but those
;; extra dependencies are supposed to be determined only by the ones declared
@@ -402,26 +403,26 @@
;; then we can assume that the extra dependencies generated previously are still
;; the extra dependencies this time
(define same-so-far?
- (and (log-changed (and (equal? sha1 prev-sha1) (not (equal? sha1 no-sha1))) path state)
+ (and (log-changed (and (equal? sha256 prev-sha256) (not (equal? sha256 no-sha256))) path state)
(andmap (lambda (dep-key)
- (log-changed (equal? (hash-ref dep-sha1s dep-key)
- (hash-ref prev-dep-sha1s dep-key #f))
+ (log-changed (equal? (hash-ref dep-sha256s dep-key)
+ (hash-ref prev-dep-sha256s dep-key #f))
dep-key
state))
- (hash-keys dep-sha1s))))
+ (hash-keys dep-sha256s))))
(define more-deps
(if same-so-far?
- (foldl (lambda (dep-key more-sha1s)
+ (foldl (lambda (dep-key more-sha256s)
;; currently, we assume that any additional dependencies
;; added in the build phase were and would be inputs
- (if (or (hash-ref dep-sha1s dep-key #f)
+ (if (or (hash-ref dep-sha256s dep-key #f)
(symbol-key? dep-key))
- more-sha1s
+ more-sha256s
(cons (input-file-target (symbol->string dep-key))
- more-sha1s)))
+ more-sha256s)))
'()
- (hash-keys prev-dep-sha1s))
+ (hash-keys prev-dep-sha256s))
'()))
(for-each (make-fetch-dep new-state new-seen dep-top?) more-deps)
(define newer-state
@@ -428,10 +429,10 @@
(foldl (lambda (dep state) (do-build dep state new-seen dep-top?))
new-state
more-deps))
- (define all-dep-sha1s
- (foldl (lambda (dep dep-sha1s)
- (add-dependent-target-state dep dep-sha1s newer-state))
- dep-sha1s
+ (define all-dep-sha256s
+ (foldl (lambda (dep dep-sha256s)
+ (add-dependent-target-state dep dep-sha256s newer-state))
+ dep-sha256s
more-deps))
;; compare to recorded result, and rebuild if different
@@ -438,18 +439,18 @@
(cond
[(and same-so-far?
(andmap (lambda (dep-key)
- (log-changed (equal? (hash-ref all-dep-sha1s dep-key #f)
- (hash-ref prev-dep-sha1s dep-key #f))
+ (log-changed (equal? (hash-ref all-dep-sha256s dep-key #f)
+ (hash-ref prev-dep-sha256s dep-key #f))
dep-key
state))
- (hash-keys all-dep-sha1s)))
+ (hash-keys all-dep-sha256s)))
;; no need to rebuild
(when path-handle (cleanable-cancel path-handle))
(when (and (or alert-top? (hash-ref (target-options t) 'noisy? #f))
- (equal? prev-sha1 sha1)
- (not (equal? sha1 phony-sha1)))
+ (equal? prev-sha256 sha256)
+ (not (equal? sha256 phony-sha256)))
(alert (~a (target-name t) " is up to date")))
- (define done-state (update-target-state newer-state t (cons sha1 all-dep-sha1s)))
+ (define done-state (update-target-state newer-state t (cons sha256 all-dep-sha256s)))
(channel-put result-ch 'done)
done-state]
[else
@@ -456,15 +457,15 @@
(unless to-build
(error "build: out-of-date target has no build procedure" (target-name t)))
(define (build-one finish)
- (let* ([maybe-sha1 (to-build)] ; build!
- [sha1 (if build-to-sha1?
- maybe-sha1
- (if (pair? co-outputs)
- (files-sha1 (cons path co-outputs) tok)
- (file-sha1 path tok)))])
- (unless (sha1? sha1)
- (error "build: target-build result is not a sha1" sha1))
- (when (equal? sha1 no-sha1)
+ (let* ([maybe-sha256 (to-build)] ; build!
+ [sha256 (if build-to-sha256?
+ maybe-sha256
+ (if (pair? co-outputs)
+ (files-sha256 (cons path co-outputs) tok)
+ (file-sha256 path tok)))])
+ (unless (sha256? sha256)
+ (error "build: target-build result is not a sha256" sha256))
+ (when (equal? sha256 no-sha256)
(error "rule for target did not create it" (if (pair? co-outputs)
(cons path co-outputs)
path)))
@@ -472,11 +473,11 @@
(finish
(lambda (state)
;; record result:
- (let* ([ts (if (eq? sha1 phony-sha1)
- (cons no-sha1 (hash))
- (cons sha1 dep-sha1s))]
+ (let* ([ts (if (eq? sha256 phony-sha256)
+ (cons no-sha256 (hash))
+ (cons sha256 dep-sha256s))]
[ts (merge-target-accumulated state t ts)]
- [state (update-target-state/record-sha1s state t ts co-outputs)])
+ [state (update-target-state/record-sha256s state t ts co-outputs)])
(channel-put result-ch 'done)
state)))))
(let ([state-ch (build-state-ch newer-state)])
@@ -681,25 +682,25 @@
(define (target-state state t)
(hash-ref (build-state-target-state state) (target-key t) #f))
-(define (add-dependent-target-state dep dep-sha1s state)
+(define (add-dependent-target-state dep dep-sha256s state)
(define ts (target-state state dep))
- (define sha1 (car ts))
- (hash-set dep-sha1s (target-key dep) (if (eq? sha1 phony-sha1) no-sha1 sha1)))
+ (define sha256 (car ts))
+ (hash-set dep-sha256s (target-key dep) (if (eq? sha256 phony-sha256) no-sha256 sha256)))
(define (record-target-accumulated state for-t t)
(let* ([accum-key (target-key for-t)]
- [dep-sha1s (hash-ref (build-state-target-accum state) accum-key (hash))]
- [dep-sha1s (add-dependent-target-state t dep-sha1s state)])
- (build-state-set-target-accum state (hash-set (build-state-target-accum state) accum-key dep-sha1s))))
+ [dep-sha256s (hash-ref (build-state-target-accum state) accum-key (hash))]
+ [dep-sha256s (add-dependent-target-state t dep-sha256s state)])
+ (build-state-set-target-accum state (hash-set (build-state-target-accum state) accum-key dep-sha256s))))
(define (merge-target-accumulated state t ts)
- (let ([more-dep-sha1s (hash-ref (build-state-target-accum state) (target-key t) #f)])
- (if more-dep-sha1s
+ (let ([more-dep-sha256s (hash-ref (build-state-target-accum state) (target-key t) #f)])
+ (if more-dep-sha256s
(cons (car ts)
- (foldl (lambda (dep-key dep-sha1s)
- (hash-set dep-sha1s dep-key (hash-ref more-dep-sha1s dep-key)))
+ (foldl (lambda (dep-key dep-sha256s)
+ (hash-set dep-sha256s dep-key (hash-ref more-dep-sha256s dep-key)))
(cdr ts)
- (hash-keys more-dep-sha1s)))
+ (hash-keys more-dep-sha256s)))
ts)))
(define (update-target-state state t ts)
@@ -708,19 +709,19 @@
(target-key t)
ts)))
-(define (update-target-state/record-sha1s state t ts co-outputs)
+(define (update-target-state/record-sha256s state t ts co-outputs)
(unless (eq? 'phony (target-kind t))
- (db-record-target-sha1s (target-db-dir t) (target-name t) ts co-outputs))
+ (db-record-target-sha256s (target-db-dir t) (target-name t) ts co-outputs))
(update-target-state state t ts))
-(define (load-sha1s state t path)
+(define (load-sha256s state t path)
(cond
[(symbol? path) state]
[else
- (define db+tc (db-load-sha1s (target-db-dir t)
- path
- (build-state-db state)
- (build-state-time-cache state)))
+ (define db+tc (db-load-sha256s (target-db-dir t)
+ path
+ (build-state-db state)
+ (build-state-time-cache state)))
(if db+tc
(let ([state (build-state-set-db state (car db+tc))])
(build-state-set-time-cache state (cdr db+tc)))
@@ -728,7 +729,7 @@
(define (previous-target-state state key)
(or (hash-ref (build-state-db state) key #f)
- (cons no-sha1 (hash))))
+ (cons no-sha256 (hash))))
(define (ensure-consistent state t)
(let* ([saw (build-state-saw-targets state)]
@@ -743,22 +744,22 @@
[else
(build-state-set-saw-targets state (hash-set saw (target-key t) t))])))
-(define (file-sha1 path token)
- (unless (path-string? path) (arg-error 'file-sha1 "path string" path))
- (unless (or (not token) (token? token)) (error 'file-sha1 "build-token" token))
- (let ([state (and token (get-state (token-ch token) "sha1"))])
- (when state (put-state (token-ch token) state "sha1"))
- (file-sha1/state path state)))
+(define (file-sha256 path token)
+ (unless (path-string? path) (arg-error 'file-sha256 "path string" path))
+ (unless (or (not token) (token? token)) (error 'file-sha256 "build-token" token))
+ (let ([state (and token (get-state (token-ch token) "sha256"))])
+ (when state (put-state (token-ch token) state "sha256"))
+ (file-sha256/state path state)))
-(define (files-sha1 paths token)
- (let ([sha1s (map (lambda (path) (file-sha1 path token)) paths)])
- (if (ormap (lambda (s) (string=? s no-sha1)) sha1s)
- no-sha1
- (apply ~a sha1s))))
+(define (files-sha256 paths token)
+ (let ([sha256s (map (lambda (path) (file-sha256 path token)) paths)])
+ (if (ormap (lambda (s) (string=? s no-sha256)) sha256s)
+ no-sha256
+ (apply ~a sha256s))))
-(define (file-sha1/state path state)
- (or (file-sha1/cached path (and state (build-state-time-cache state)))
- no-sha1))
+(define (file-sha256/state path state)
+ (or (file-sha256/cached path (and state (build-state-time-cache state)))
+ no-sha256))
;; translate a data key as loaded from a previous-run to a key as
;; instantiated for this run
--- a/lib/zuo/private/build-db.zuo
+++ b/lib/zuo/private/build-db.zuo
@@ -5,7 +5,7 @@
;; directory, the goal here is to be able to load information for all
;; the targets at once.
-;; A timestamp-based SHA-1 cache for input files is stored in
+;; A timestamp-based SHA-256 cache for input files is stored in
;; "_zuo_tc.db" alongside "_zuo.db" --- in the directory of a target
;; that depends on the input files, not in the input file's directory
;; (which is likely to be in the source tree). An input used by
@@ -19,14 +19,16 @@
;; format of each file is a top-level sequence of
;; (<rel-path> . <info>)
;; For "_zuo.db", it's more specifically
-;; (<rel-path> <sha1> (<dep-rel-path> <sha1>) ...)
+;; (<rel-path> <sha256> (<dep-rel-path> <sha256>) ...)
;; For "_zuo_tc.db", it's
-;; (<rel-path> (<time-secs> . <time-msec>) <sha1>)
+;; (<rel-path> (<time-secs> . <time-msec>) <sha256>)
-(provide db-record-target-sha1s
- db-load-sha1s
+(provide db-record-target-sha256s
+ db-load-sha256s
- file-sha1/cached
+ sha256-length
+
+ file-sha256/cached
path->absolute-path
dir-part
@@ -34,7 +36,9 @@
symbol-key?
symbol-key->symbol)
-;; for serialization and deserialization of dep-sha1s tables
+(define sha256-length 64)
+
+;; for serialization and deserialization of dep-sha256s tables
(define (hash->list ht db-dir)
(map (lambda (k) (list (serialize-key k db-dir) (hash-ref ht k)))
(hash-keys ht)))
@@ -79,12 +83,12 @@
(k rel-target-path db-dir db-path tc-path))
;; Records the result of a build of `name`, mainly storing the
-;; SHA-1 and dep SHA-1s in "_zuo.db", but also recording a timestamp
-;; plus SHA-1 for dependencies in "_zuo_tc.db".
+;; SHA-256 and dep SHA-256s in "_zuo.db", but also recording a timestamp
+;; plus SHA-256 for dependencies in "_zuo_tc.db".
;; All relative file names are stored relative to `db-dir`, which
;; defaults to the directory of target-path. On entry, `target-path`
;; and keys in `ts` are relative to the current directory.
-(define (db-record-target-sha1s maybe-db-dir target-path ts co-outputs)
+(define (db-record-target-sha256s maybe-db-dir target-path ts co-outputs)
(db-paths
maybe-db-dir target-path
(lambda (rel-target-path db-dir db-path tc-path)
@@ -92,8 +96,8 @@
(if (file-exists? db-path)
(string-read (file->string db-path) 0 db-path)
'()))
- (define dep-sha1s-l (hash->list (cdr ts) db-dir))
- (define new-db-content (reassoc (list* rel-target-path (car ts) dep-sha1s-l) db-content))
+ (define dep-sha256s-l (hash->list (cdr ts) db-dir))
+ (define new-db-content (reassoc (list* rel-target-path (car ts) dep-sha256s-l) db-content))
(update-file db-path new-db-content)
(unless (ormap (lambda (p) (string=? (car p) "SOURCE_DATE_EPOCH")) (hash-ref (runtime-env) 'env))
(define tc-content
@@ -110,19 +114,19 @@
(build-path db-dir dep-name)
dep-name)))
(cond
- [time (reassoc (list dep-name time (substring (cadr dep) 0 40)) tc-content)]
+ [time (reassoc (list dep-name time (substring (cadr dep) 0 sha256-length)) tc-content)]
[else tc-content])]))
tc-content
(if (pair? co-outputs)
- (append (split-sha1s rel-target-path co-outputs (car ts) db-dir)
- dep-sha1s-l)
- (cons (list rel-target-path (car ts)) dep-sha1s-l))))
+ (append (split-sha256s rel-target-path co-outputs (car ts) db-dir)
+ dep-sha256s-l)
+ (cons (list rel-target-path (car ts)) dep-sha256s-l))))
(update-file tc-path new-tc-content)))))
;; Loads previous-build information for `abs-path`, as well as cached
-;; SHA-1s for things that might be dependencies; loading needs to
+;; SHA-256s for things that might be dependencies; loading needs to
;; happen only once per directory that has a (non-input) build target
-(define (db-load-sha1s maybe-db-dir target-path db tc)
+(define (db-load-sha256s maybe-db-dir target-path db tc)
(db-paths
maybe-db-dir target-path
(lambda (name db-dir db-path tc-path)
@@ -159,8 +163,8 @@
(define new-tc (read-in tc-path tc (lambda (v) v)))
(cons new-db new-tc)]))))
-;; Helpers to get an input file's SHA-1, possibly cached
-(define (file-sha1/cached path time-cache)
+;; Helpers to get an input file's SHA-256, possibly cached
+(define (file-sha256/cached path time-cache)
(let ([timestamp (file-timestamp path)])
(and timestamp
(let ([cached (and time-cache
@@ -168,15 +172,17 @@
(string->symbol path)
#f))])
(if (and cached
- (equal? (car cached) timestamp))
+ (equal? (car cached) timestamp)
+ ;; might be a stale SHA-1 rather than an SHA-256
+ (= sha256-length (string-length (cadr cached))))
(cadr cached)
- (string-sha1 (file->string path)))))))
+ (string-sha256 (file->string path)))))))
-;; Split "sha1", which should have a sha1 for each of `rel-target-path`
-;; and each element of `co-outputs`, into a list of sha1s
-(define (split-sha1s rel-target-path co-outputs sha1 db-dir)
- (cons (list rel-target-path (substring sha1 0 40))
- (let loop ([co-outputs co-outputs] [start 40])
+;; Split "sha256", which should have a sha256 for each of `rel-target-path`
+;; and each element of `co-outputs`, into a list of sha256s
+(define (split-sha256s rel-target-path co-outputs sha256 db-dir)
+ (cons (list rel-target-path (substring sha256 0 sha256-length))
+ (let loop ([co-outputs co-outputs] [start sha256-length])
(cond
[(null? co-outputs) '()]
[else
@@ -184,8 +190,8 @@
(cons (list (if (relative-path? co-output)
(find-relative-path db-dir co-output)
co-output)
- (substring sha1 start (+ start 40)))
- (loop (cdr co-outputs) (+ start 40))))]))))
+ (substring sha256 start (+ start sha256-length)))
+ (loop (cdr co-outputs) (+ start sha256-length))))]))))
;; Atomic write by write-to-temporary-and-move
(define (update-file path new-content)
--- a/local/image.zuo
+++ b/local/image.zuo
@@ -44,7 +44,7 @@
(define (image-target cmd)
(target
- (hash-ref cmd 'output) ; the output file; `target` uses SHA-1 on this
+ (hash-ref cmd 'output) ; the output file; `target` uses SHA-256 on this
(lambda (path token)
;; when a target is demanded, we report dependencies and more via `rule`
(rule
--- a/tests/string.zuo
+++ b/tests/string.zuo
@@ -89,7 +89,7 @@
(unless (= j (string-length s)) (j-loop (+ j 1))))
(unless (= i (string-length s)) (i-loop (+ i 1)))))
-(check (string-sha1 "hello\n") "f572d396fae9206628714fb2ce00f72e94f2258f")
+(check (string-sha256 "hello\n") "5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03")
(check (string->integer "10") 10)
(check (string->integer "-10") -10)
--- a/zuo-doc/fake-zuo.rkt
+++ b/zuo-doc/fake-zuo.rkt
@@ -104,7 +104,7 @@
string->uninterned-symbol
symbol->string
string
- string-sha1
+ string-sha256
char
string-split string-join string-trim
string-tree?
@@ -210,9 +210,10 @@
token?
rule?
phony-rule?
- sha1?
- file-sha1
- no-sha1
+ sha256?
+ file-sha256
+ no-sha256
+ sha256-length
build
build/command-line
build/command-line*
--- a/zuo-doc/lang-zuo-kernel.scrbl
+++ b/zuo-doc/lang-zuo-kernel.scrbl
@@ -77,7 +77,7 @@
bitwise-and bitwise-ior bitwise-xor bitwise-not
string? string-length string-ref string-u32-ref substring string
- string=? string-ci=? string-sha1 string-split
+ string=? string-ci=? string-sha256 string-split
symbol? symbol->string string->symbol string->uninterned-symbol
--- a/zuo-doc/lang-zuo.scrbl
+++ b/zuo-doc/lang-zuo.scrbl
@@ -440,9 +440,11 @@
Tries to parse @racket[str] as an integer returning @racket[#f] if
that fails.}
-@defproc[(string-sha1 [str string?]) string?]{+@defproc[(string-sha256 [str string?]) string?]{-Returns the SHA-1 hash of @racket[str] as a 40-digit hexadecimal string.}
+Returns the SHA-256 hash of @racket[str] as a 64-digit hexadecimal string.
+
+See also @racket[file-sha256] and @racket[sha256-length].}
@defform[(char str)]{--- a/zuo-doc/overview.scrbl
+++ b/zuo-doc/overview.scrbl
@@ -13,7 +13,7 @@
base language, the primary intended use of Zuo is with
@racket[@#,hash-lang[] @#,racketmodname[zuo]], which includes the
@racketmodname[zuo/build] library for using @seclink["zuo-build"]{Zuo-as a @tt{make} replacement}.+as a @exec{make} replacement}.The name ``Zuo'' is derived from the Chinese word for ``make.''
--- a/zuo-doc/zuo-build.scrbl
+++ b/zuo-doc/zuo-build.scrbl
@@ -6,7 +6,7 @@
@(define shake-url "https://shakebuild.com/")
-@title[#:tag "zuo-build"]{Zuo as a @tt{make} Replacement}+@title[#:tag "zuo-build"]{Zuo as a @exec{make} Replacement}@defzuomodule[zuo/build]
@@ -26,13 +26,15 @@
A @tech{target} represents either an input to a build (such as asource file) or a generated output, and a target can depend on any
-number of other targets. A target's output is represented by 40-character
-string that is normally a SHA-1 hash; the @racket[build] procedure
+number of other targets. A target's output is represented by a
+string that is normally an SHA-256 hash: more precisely, it is
+represented by a value satisfying the predicate @racket[sha256?].
+The @racket[build] procedure
records hashes and dependencies in a database located alongside
non-input targets, so it can avoid rebuilding targets when nothing has
-changed since the last build. Unlike @tt{make}, timestamps are used-only as a shortcut to avoiding computing the SHA-1 of a file (i.e., if
-the timestamp has not changes, the SHA-1 result is assumed to be
+changed since the last build. Unlike @exec{make}, timestamps are used+only as a shortcut to avoiding computing the SHA-256 of a file (i.e., if
+the timestamp has not changed, the SHA-256 result is assumed to be
unchanged).
``Recursive make'' is encouraged in the sense that a target's build
@@ -55,7 +57,7 @@
are needed. The @racket[_get-rule] procedure returns up to three
results in a @racket[rule] record: a list of dependencies; the hash of
an already-built version of the target, if one exists, where
-@racket[file-sha1] is used by default; and a @racket[_rebuild]
+@racket[file-sha256] is used by default; and a @racket[_rebuild]
procedure that is called if the returned hash, the hash of
dependencies (rebuilt if needed), and recorded results from a previous
build together determine that a rebuild is needed.
@@ -62,7 +64,7 @@
When a target's @racket[_rebuild] function is called, it optionally
returns a hash for the result of the build if the target's
-@racket[rule] had one, otherwise @racket[file-sha1] is used to get a
+@racket[rule] had one, otherwise @racket[file-sha256] is used to get a
result hash. Either way, it's possible that the result hash is the
same the one returned by @racket[_get-rule]; that is, maybe a
dependency of the target changed, but the change turned out not to
@@ -105,7 +107,7 @@
filename, then it reports an error.
The @racket[build/command-line] function is a convenience to implement
-get @tt{make}-like command-line handling for building targets. The+get @exec{make}-like command-line handling for building targets. The@racket[build/command-line] procedure takes a list of targets, and it
calls @racket[build] on one or more of them based on command-line
arguments (with help from @racket[find-target]).
@@ -121,7 +123,7 @@
(supplied as just @racket[build-path] by default) to apply to each
target path when building a list of targets, and a hash table of
variables (analogous to variables that a makefile might provide to
-another makefile via @tt{make} arguments).+another makefile via @exec{make} arguments). As a further convenience following the @racketidfont{targets-at}model, the @racket[provide-targets] form takes an identifier for such a
@@ -173,7 +175,7 @@
@section{Recording Results} Build results are stored in a @filepath{_zuo.db} file in the same-directory as a target (by default). Cached SHA-1 results with associated
+directory as a target (by default). Cached SHA-256 results with associated
file timestamps are stored in a @filepath{_zuo_tc.db} in the samedirectory (i.e., the cached value for dependency is kept with the
target, which is in a writable build space, while an input-file target
@@ -244,7 +246,7 @@
Creates a @tech{target} that represents an input file. An input-filetarget has no build procedure, and it's state is summarized as a hash
-via @racket[file-sha1].}
+via @racket[file-sha256].}
@defproc[(input-data-target [name symbol?] [content any/c]) target?]{@@ -276,7 +278,7 @@
when applying an @racket[_at-dir] function to create @racket[name].
The @deftech{build token} argument to @racket[get-deps] represents the-target build in progress. It's useful with @racket[file-sha1] to take
+target build in progress. It's useful with @racket[file-sha256] to take
advantage of caching, with @racket[build/dep] to report
discovered targets, and with @racket[build/no-dep] or @racket[build].
@@ -328,8 +330,8 @@
@deftogether[(
@defproc[(rule [dependencies (listof (or/c target? path-string?))]
- [rebuild (or/c (-> (or/c sha1? any/c)) #f) #f]
- [sha1 (or/c sha1? #f) #f])
+ [rebuild (or/c (-> (or/c sha256? any/c)) #f) #f]
+ [sha256 (or/c sha256? #f) #f])
rule?]
@defproc[(rule? [v any/c]) boolean?]
)]{@@ -339,9 +341,9 @@
A path string can be reported as a dependency in
@racket[dependencies], in which case it is coerced to a target using
-@racket[input-file-target]. If @racket[sha1] is @racket[#f],
-@racket[file-sha1] is used to compute the target's current hash, and
-@racket[rebuild] is not expected to return a hash. If @racket[sha1] is
+@racket[input-file-target]. If @racket[sha256] is @racket[#f],
+@racket[file-sha256] is used to compute the target's current hash, and
+@racket[rebuild] is not expected to return a hash. If @racket[sha256] is
not @racket[#f], then if @racket[rebuild] is called, it must return a
new hash.}
@@ -355,7 +357,7 @@
The @racket[phony-rule] procedure combines the two results expected
from a procedure passed to @racket[target] to create a @tech{phony}-target. Compared to the non-phonu protocol, the result SHA-1 is
+target. Compared to the non-phony protocol, the result SHA-256 is
omitted.}
@defproc[(token? [v any/c]) boolean?]{@@ -376,7 +378,7 @@
If @racket[target] is a path, then it is coerced to target via
@racket[input-file-target], but the only effect will be to compute the
-file's SHA-1 or error if the file does not exist.
+file's SHA-256 or error if the file does not exist.
The @racket[options] argument supplies build options, and the
following keys are recognized:
@@ -494,19 +496,26 @@
target is built.}
@deftogether[(
-@defproc[(file-sha1 [file path-string?] [token (or/c token? #f)]) sha1?]
-@defproc[(sha1? [v any/c]) booelan?]
+@defproc[(file-sha256 [file path-string?] [token (or/c token? #f)]) sha256?]
+@defproc[(sha256? [v any/c]) booelan?]
+@defthing[sha256-length integer? #:value 64]
)]{-The @racket[file-sha1] procedure returns the SHA-1 hash of the content
-of @racket[file], or it returns @racket[no-sha1] if @racket[file] does
-not exist.
+The @racket[file-sha256] procedure returns the SHA-256 hash of the
+content of @racket[file] as a 64-character hexadecimal string (thus,
+@racket[sha256-length]), or it returns @racket[no-sha256] if
+@racket[file] does not exist.
-The @racket[sha1?] predicate recognizes values that are either a
-40-character string or @racket[no-sha1].}
+The @racket[sha256?] predicate recognizes @racket[no-sha256] and
+strings for which @racket[string-length] returns either
+@racket[sha256-length] or a multiple of @racket[sha256-length]. The
+later case is used for multi-file targets, which concatenate the
+constituent SHA-256 strings.
-@defthing[no-sha1 sha1? ""]{+See also @racket[string-sha256].}
+@defthing[no-sha256 sha256? ""]{+
The empty string represents a non-existent target or one that needs to
be rebuilt.}
@@ -546,13 +555,13 @@
@defproc[(make-targets [specs list?]) list?]{-Converts a @tt{make}-like specification into a list of targets for use-with @racket[build]. In this @tt{make}-like specification, extra+Converts a @exec{make}-like specification into a list of targets for use+with @racket[build]. In this @exec{make}-like specification, extradependencies can be listed separately from a build rule, and
dependencies can be written in terms of paths instead of @tech{target}objects.
-Although it might seem natural for this @tt{make}-like specification+Although it might seem natural for this @exec{make}-like specificationto be provided as a syntactic form, typical makefiles use patterns and
variables to generate sets of rules. In Zuo, @racket[map] and similar
are available for generating sets of rules. So, @racket[make-targets]
--- a/zuo.c
+++ b/zuo.c
@@ -55,6 +55,7 @@
typedef uint32_t zuo_uint32_t;
typedef intptr_t zuo_intptr_t;
+typedef uintptr_t zuo_uintptr_t;
typedef int zuo_raw_handle_t;
#endif
@@ -68,8 +69,10 @@
# ifdef _WIN64
typedef long long zuo_intptr_t;
+typedef unsigned long long zuo_uintptr_t;
# else
typedef long zuo_intptr_t;
+typedef unsigned long zuo_uintptr_t;
# endif
typedef HANDLE zuo_raw_handle_t;
@@ -6116,163 +6119,489 @@
}
/*======================================================================*/
-/* SHA-1 */
+/* SHA-256 */
/*======================================================================*/
+/*
+ * 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 */
+/* This code is also used in "rktio_sha2.c". */
-/* Based on
- SHA-1 in C
- By Steve Reid <sreid@sea-to-sky.net>
- including changes by Saul Kravitz <Saul.Kravitz@celera.com>
- and Ralph Giles <giles@ghostscript.com> */
+typedef struct zuo_sha2_ctx_t {+ unsigned total[2];
+ unsigned state[8];
+ unsigned char buffer[64];
+ int is224;
+} zuo_sha2_ctx_t;
-static int zuo_little_endian;
+#define ZUO_SHA256_DIGEST_SIZE 32
-static void zuo_init_sha1() {- zuo_little_endian = ((zuo_magic() & 0xF) == 0);
+typedef zuo_uint32_t uint32_sha2_t;
+typedef zuo_uintptr_t size_sha2_t;
+
+typedef zuo_sha2_ctx_t mbedtls_sha256_context;
+
+/*
+ * 32-bit integer manipulation macros (big endian)
+ */
+#define GET_UINT32_BE(n,b,i) \
+do { \+ (n) = ( (uint32_sha2_t) (b)[(i) ] << 24 ) \
+ | ( (uint32_sha2_t) (b)[(i) + 1] << 16 ) \
+ | ( (uint32_sha2_t) (b)[(i) + 2] << 8 ) \
+ | ( (uint32_sha2_t) (b)[(i) + 3] ); \
+} while( 0 )
+
+#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 )
+
+static void mbedtls_sha256_init( mbedtls_sha256_context *ctx )
+{+ memset( ctx, 0, sizeof( mbedtls_sha256_context ) );
}
-typedef unsigned char zuo_uint8_t;
+/*
+ * SHA-256 context setup
+ */
+static int mbedtls_sha256_starts_ret( mbedtls_sha256_context *ctx, int is224 )
+{+ ctx->total[0] = 0;
+ ctx->total[1] = 0;
-typedef struct zuo_sha1_ctx_t {- unsigned int state[5];
- unsigned int count[2];
- unsigned char buffer[64];
-} zuo_sha1_ctx_t;
+ 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;
+ }
-#define ZUO_SHA1_DIGEST_SIZE 20
+ ctx->is224 = is224;
-#define rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits))))
+ return( 0 );
+}
-/* blk0() and blk() perform the initial expand; assumes input has been converted to bigendian */
-#define blk0(i) block->l[i]
-#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))
+static const uint32_sha2_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,
+};
-/* (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);
+#define SHR(x,n) ((x & 0xFFFFFFFF) >> n)
+#define ROTR(x,n) (SHR(x,n) | (x << (32 - n)))
-/* Hash a single 512-bit block. This is the core of the algorithm. */
-static void zuo_sha1_transform(zuo_uint32_t state[5], const zuo_uint8_t buffer[64]) {- zuo_uint32_t a, b, c, d, e;
- typedef union {- zuo_uint8_t c[64];
- zuo_uint32_t l[16];
- } CHAR64LONG16;
- CHAR64LONG16 *block;
+#define S0(x) (ROTR(x, 7) ^ ROTR(x,18) ^ SHR(x, 3))
+#define S1(x) (ROTR(x,17) ^ ROTR(x,19) ^ SHR(x,10))
- block = (CHAR64LONG16 *) buffer;
+#define S2(x) (ROTR(x, 2) ^ ROTR(x,13) ^ ROTR(x,22))
+#define S3(x) (ROTR(x, 6) ^ ROTR(x,11) ^ ROTR(x,25))
- if (zuo_little_endian) {- int i;
- for (i = 0; i < 16; i++)
- block->l[i] = (rol(block->l[i], 24) & 0xFF00FF00) | (rol(block->l[i], 8) & 0x00FF00FF);
- }
+#define F0(x,y,z) ((x & y) | (z & (x | y)))
+#define F1(x,y,z) (z ^ (x & (y ^ z)))
- /* Copy context->state[] to working vars */
- a = state[0];
- b = state[1];
- c = state[2];
- d = state[3];
- e = state[4];
+#define R(t) \
+( \
+ W[t] = S1(W[t - 2]) + W[t - 7] + \
+ S0(W[t - 15]) + W[t - 16] \
+)
- /* 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);
+#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; \
+}
- /* Add the working vars back into context.state[] */
- state[0] += a;
- state[1] += b;
- state[2] += c;
- state[3] += d;
- state[4] += e;
+static int mbedtls_internal_sha256_process( mbedtls_sha256_context *ctx,
+ const unsigned char data[64] )
+{+ uint32_sha2_t temp1, temp2, W[64];
+ uint32_sha2_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 );
}
-static void zuo_sha1_init(zuo_sha1_ctx_t *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;
+/*
+ * SHA-256 process buffer
+ */
+static int mbedtls_sha256_update_ret( mbedtls_sha256_context *ctx,
+ const unsigned char *input,
+ size_sha2_t ilen )
+{+ int ret;
+ size_sha2_t fill;
+ uint32_sha2_t left;
+
+ if( ilen == 0 )
+ return( 0 );
+
+ left = ctx->total[0] & 0x3F;
+ fill = 64 - left;
+
+ ctx->total[0] += (uint32_sha2_t) ilen;
+ ctx->total[0] &= 0xFFFFFFFF;
+
+ if( ctx->total[0] < (uint32_sha2_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 );
}
-/* Run your data through this. */
-static void zuo_sha1_update(zuo_sha1_ctx_t *context, const zuo_uint8_t *data, const zuo_intptr_t len) {- zuo_intptr_t i, j;
+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
+};
- 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));
- zuo_sha1_transform(context->state, context->buffer);
- for (; i + 63 < len; i += 64)
- zuo_sha1_transform(context->state, data + i);
- j = 0;
- } else
- i = 0;
- memcpy(&context->buffer[j], &data[i], len - i);
+/*
+ * SHA-256 final digest
+ */
+static int mbedtls_sha256_finish_ret( mbedtls_sha256_context *ctx,
+ unsigned char output[32] )
+{+ int ret;
+ uint32_sha2_t last, padn;
+ uint32_sha2_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 );
}
-static int hex_char(int c) {- return (c < 10) ? (c + '0') : (c + 'a'-10);
+#if defined(MBEDTLS_SELF_TEST)
+/*
+ * FIPS-180-2 test vectors
+ */
+static const unsigned char sha256_test_buf[3][57] =
+{+ { "abc" },+ { "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" },+ { "" }+};
+
+static const size_sha2_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 );
}
-/* Add padding and return the message digest. */
-static void zuo_sha1_final(zuo_sha1_ctx_t *context, zuo_uint8_t digest[ZUO_SHA1_DIGEST_SIZE]) {- zuo_uint32_t i;
- zuo_uint8_t finalcount[8];
+#endif /* MBEDTLS_SELF_TEST */
- for (i = 0; i < 8; i++)
- finalcount[i] = (unsigned char)((context->count[(i >= 4 ? 0 : 1)] >> ((3 - (i & 3)) * 8)) & 255);
- zuo_sha1_update(context, (zuo_uint8_t *)"\200", 1);
- while ((context->count[0] & 504) != 448)
- zuo_sha1_update(context, (zuo_uint8_t *)"\0", 1);
- zuo_sha1_update(context, finalcount, 8);
- for (i = 0; i < ZUO_SHA1_DIGEST_SIZE; i++)
- digest[i] = (zuo_uint8_t)((context->state[i >> 2] >> ((3 - (i & 3)) * 8)) & 255);
+typedef unsigned char zuo_uint8_t;
+
+static void zuo_sha256_init(zuo_sha2_ctx_t *context) {+ int is224 = 0;
+ (void)mbedtls_sha256_init(context);
+ (void)mbedtls_sha256_starts_ret(context, is224);
}
-static zuo_t *zuo_string_sha1(zuo_t *str) {- zuo_sha1_ctx_t context;
- zuo_uint8_t digest[ZUO_SHA1_DIGEST_SIZE];
- char digest_hex[2 * ZUO_SHA1_DIGEST_SIZE];
+/* Run your data through this. */
+static void zuo_sha256_update(zuo_sha2_ctx_t *context, const zuo_uint8_t *data, const zuo_intptr_t len) {+ (void)mbedtls_sha256_update_ret(context, data, len);
+}
+
+/* Get the final hash value after all bytes have been added */
+static void zuo_sha256_final(zuo_sha2_ctx_t *context, zuo_uint8_t digest[ZUO_SHA256_DIGEST_SIZE]) {+ (void)mbedtls_sha256_finish_ret(context, digest);
+}
+
+/* ************************************************************ */
+
+static int hex_char(int c) {+ return (c < 10) ? (c + '0') : (c + 'a'-10);
+}
+
+static zuo_t *zuo_string_sha256(zuo_t *str) {+ zuo_sha2_ctx_t context;
+ zuo_uint8_t digest[ZUO_SHA256_DIGEST_SIZE];
+ char digest_hex[2 * ZUO_SHA256_DIGEST_SIZE];
int i;
- zuo_sha1_init(&context);
- zuo_sha1_update(&context, (zuo_uint8_t *)ZUO_STRING_PTR(str), ZUO_STRING_LEN(str));
- zuo_sha1_final(&context, digest);
+ zuo_sha256_init(&context);
+ zuo_sha256_update(&context, (zuo_uint8_t *)ZUO_STRING_PTR(str), ZUO_STRING_LEN(str));
+ zuo_sha256_final(&context, digest);
- for (i = 0; i < ZUO_SHA1_DIGEST_SIZE; i++) {+ for (i = 0; i < ZUO_SHA256_DIGEST_SIZE; i++) {digest_hex[2*i] = hex_char(digest[i] >> 4);
digest_hex[2*i+1] = hex_char(digest[i] & 0xF);
}
- return zuo_sized_string(digest_hex, 2 * ZUO_SHA1_DIGEST_SIZE);
+ return zuo_sized_string(digest_hex, 2 * ZUO_SHA256_DIGEST_SIZE);
}
/*======================================================================*/
@@ -6495,7 +6824,6 @@
zuo_configure();
zuo_init_terminal();
zuo_init_signal_handler();
- zuo_init_sha1();
/* these initial constants and tables might get replaced by loading
an image, but we need them to register primitives: */
@@ -6615,7 +6943,7 @@
ZUO_TOP_ENV_SET_PRIMITIVE0("resume-signal", zuo_resume_signal); ZUO_TOP_ENV_SET_PRIMITIVE1("string->shell", zuo_string_to_shell); ZUO_TOP_ENV_SET_PRIMITIVEb("shell->strings", zuo_shell_to_strings);- ZUO_TOP_ENV_SET_PRIMITIVE1("string-sha1", zuo_string_sha1);+ ZUO_TOP_ENV_SET_PRIMITIVE1("string-sha256", zuo_string_sha256); ZUO_TOP_ENV_SET_PRIMITIVE1("cleanable-file", zuo_cleanable_file); ZUO_TOP_ENV_SET_PRIMITIVE1("cleanable-cancel", zuo_cleanable_cancel);