SHA256의 "순수한"체계 구현 (R5RS)은 무엇입니까?

Question

외부 라이브러리 (Java, C 또는 시스템에 따라 다름) 또는 특정 Scheme 구현 (예 : Chicken)을 사용하여 Scheme에서 SHA256을 사용할 수 있지만 "순수한"스키마 구현이 있는지 궁금합니다.

Answer 1

오늘 구현을 작성했습니다. 아아, R5RS는 바이트 벡터도 바이너리 I/O도 가지지 않으므로 바이트 벡터와 2 진 입출력을 위해 R7RS API를 사용합니다. 이러한 API를 Scheme 구현의 네이티브 API에 쉽게 연결해야합니다 (예 : 실제로 Racket 및 Guile에서 구현을 테스트 함).

몇 가지 참고 사항 :

• 이 코드는 대소 문자 구분을 가정합니다. 이것은 R7RS의 기본값이지만 R5RS의 경우는 아닙니다. 따라서 R5RS 구현을 사용하는 경우주의하십시오.
• SRFI가 필요합니다. 1, 26, 43 및 60입니다.
• 속도보다는 우아함과 선명도를 강조합니다. 사실, 코드는 매우 느립니다.
• 내 프로필에 나와있는 것과는 반대로이 코드는 CC BY-SA 3.0의 표준 스택 오버플로 라이선스 외에도 Apache Licence 2.0으로 만 라이선스를 부여하며 CC0 또는 공개 도메인과 닮은 것으로 분류되지는 않습니다. 내가 FIPS 180-4에있는 모든 알고리즘을 구현

  ;;; Auxiliary definitions to avoid having to use giant tables of constants. 
  
  (define primes80 '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 
          79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 
          163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 
          241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 
          337 347 349 353 359 367 373 379 383 389 397 401 409)) 
  
  (define (sqrt x) 
      (fold (lambda (_ y) (/ (+ (/ x y) y) 2)) 4 (iota 7))) 
  
  (define (cbrt x) 
      (fold (lambda (_ y) (/ (+ (/ x y y) y y) 3)) 4 (iota 8))) 
  
  (define (frac x scale base) 
      (bitwise-and (floor (* x (arithmetic-shift 1 scale))) 
         (- (arithmetic-shift 1 base) 1))) 
  
  ;;; The actual initialisation and constant values. 
  
  (define sha1-init '(#x67452301 #xefcdab89 #x98badcfe #x10325476 #xc3d2e1f0)) 
  (define sha2-init (map (lambda (x) (frac (sqrt x) 64 64)) (take primes80 16))) 
  (define-values (sha512-init sha384-init) (split-at sha2-init 8)) 
  (define sha256-init (map (cut arithmetic-shift <> -32) sha512-init)) 
  (define sha224-init (map (cut frac <> 0 32) sha384-init)) 
  
  (define sha1-const (map (lambda (x) (frac (sqrt x) 30 32)) '(2 3 5 10))) 
  (define sha512-const (map (lambda (x) (frac (cbrt x) 64 64)) primes80)) 
  (define sha256-const (map (cut arithmetic-shift <> -32) (take sha512-const 64))) 
  
  ;;; Utility functions used by the compression and driver functions. 
  
  (define (u32+ . xs) (bitwise-and (apply + xs) #xffffffff)) 
  (define (u64+ . xs) (bitwise-and (apply + xs) #xffffffffffffffff)) 
  (define (bitwise-majority x y z) 
      (bitwise-xor (bitwise-and x y) (bitwise-and x z) (bitwise-and y z))) 
  
  (define (bytevector-be-ref bv base n) 
      (let loop ((res 0) (i 0)) 
      (if (< i n) 
       (loop (+ (arithmetic-shift res 8) (bytevector-u8-ref bv (+ base i))) 
         (+ i 1)) 
       res))) 
  (define (bytevector-u64-ref bv i) 
      (bytevector-be-ref bv (arithmetic-shift i 3) 8)) 
  (define (bytevector-u32-ref bv i) 
      (bytevector-be-ref bv (arithmetic-shift i 2) 4)) 
  
  (define (bytevector-be-set! bv base n val) 
      (let loop ((i n) (val val)) 
      (when (positive? i) 
       (bytevector-u8-set! bv (+ base i -1) (bitwise-and val 255)) 
       (loop (- i 1) (arithmetic-shift val -8))))) 
  
  (define (md-pad! bv offset count counter-size) 
      (define block-size (bytevector-length bv)) 
      (unless (negative? offset) 
      (bytevector-u8-set! bv offset #x80)) 
      (let loop ((i (+ offset 1))) 
      (when (< i block-size) 
       (bytevector-u8-set! bv i 0) 
       (loop (+ i 1)))) 
      (when count 
      (bytevector-be-set! bv (- block-size counter-size) counter-size 
           (arithmetic-shift count 3)))) 
  
  (define (hash-state->bytevector hs trunc word-size) 
      (define result (make-bytevector (* trunc word-size))) 
      (for-each (lambda (h i) 
         (bytevector-be-set! result i word-size h)) 
        hs (iota trunc 0 word-size)) 
      result) 
  
  ;;; The compression functions. 
  
  (define (sha2-compress K Σ0 Σ1 σ0 σ1 mod+ getter hs) 
      (define W (vector->list (apply vector-unfold 
             (lambda (_ a b c d e f g h i j k l m n o p) 
              (values a b c d e f g h i j k l m n o p 
                (mod+ a (σ0 b) j (σ1 o)))) 
             (length K) 
             (list-tabulate 16 getter)))) 
      (define (loop k w a b c d e f g h) 
      (if (null? k) 
       (map mod+ hs (list a b c d e f g h)) 
       (let ((T1 (mod+ h (Σ1 e) (bitwise-if e f g) (car k) (car w))) 
         (T2 (mod+ (Σ0 a) (bitwise-majority a b c)))) 
        (loop (cdr k) (cdr w) (mod+ T1 T2) a b c (mod+ d T1) e f g)))) 
      (apply loop K W hs)) 
  
  (define (sha512-compress bv hs) 
      (define (rotr x y) (rotate-bit-field x (- y) 0 64)) 
      (define (shr x y) (arithmetic-shift x (- y))) 
      (sha2-compress sha512-const 
         (lambda (x) (bitwise-xor (rotr x 28) (rotr x 34) (rotr x 39))) 
         (lambda (x) (bitwise-xor (rotr x 14) (rotr x 18) (rotr x 41))) 
         (lambda (x) (bitwise-xor (rotr x 1) (rotr x 8) (shr x 7))) 
         (lambda (x) (bitwise-xor (rotr x 19) (rotr x 61) (shr x 6))) 
         u64+ (cut bytevector-u64-ref bv <>) hs)) 
  
  (define (sha256-compress bv hs) 
      (define (rotr x y) (rotate-bit-field x (- y) 0 32)) 
      (define (shr x y) (arithmetic-shift x (- y))) 
      (sha2-compress sha256-const 
         (lambda (x) (bitwise-xor (rotr x 2) (rotr x 13) (rotr x 22))) 
         (lambda (x) (bitwise-xor (rotr x 6) (rotr x 11) (rotr x 25))) 
         (lambda (x) (bitwise-xor (rotr x 7) (rotr x 18) (shr x 3))) 
         (lambda (x) (bitwise-xor (rotr x 17) (rotr x 19) (shr x 10))) 
         u32+ (cut bytevector-u32-ref bv <>) hs)) 
  
  (define (sha1-compress bv hs) 
      (define (getter x) (bytevector-u32-ref bv x)) 
      (define (rotl x y) (rotate-bit-field x y 0 32)) 
      (define W (vector->list (apply vector-unfold 
             (lambda (_ a b c d e f g h i j k l m n o p) 
              (values a b c d e f g h i j k l m n o p 
                (rotl (bitwise-xor a c i n) 1))) 
             80 
             (list-tabulate 16 getter)))) 
      (define (outer f k w a b c d e) 
      (if (null? k) 
       (map u32+ hs (list a b c d e)) 
       (let inner ((i 0) (w w) (a a) (b b) (c c) (d d) (e e)) 
        (if (< i 20) 
         (let ((T (u32+ (rotl a 5) ((car f) b c d) e (car k) (car w)))) 
         (inner (+ i 1) (cdr w) T a (rotl b 30) c d)) 
         (outer (cdr f) (cdr k) w a b c d e))))) 
      (apply outer (list bitwise-if bitwise-xor bitwise-majority bitwise-xor) 
         sha1-const W hs)) 
  
  ;;; The Merkle-Damgård "driver" function. 
  
  (define (md-loop init compress block-size trunc word-size counter-size in) 
      (define leftover (- block-size counter-size)) 
      (define bv (make-bytevector block-size)) 
      (define pad! (cut md-pad! bv <> <> counter-size)) 
      (define hs->bv (cut hash-state->bytevector <> trunc word-size)) 
  
      (let loop ((count 0) (hs init)) 
      (define read-size (read-bytevector! bv in)) 
      (cond ((eof-object? read-size) 
        (pad! 0 count) 
        (hs->bv (compress bv hs))) 
        ((= read-size block-size) 
        (loop (+ count read-size) (compress bv hs))) 
        ((< read-size leftover) 
        (pad! read-size (+ count read-size)) 
        (hs->bv (compress bv hs))) 
        (else 
        (pad! read-size #f) 
        (let ((pen (compress bv hs))) 
        (pad! -1 (+ count read-size)) 
        (hs->bv (compress bv pen))))))) 
  
  ;;; SHA-512/t stuff. 
  
  (define sha512/t-init (map (cut bitwise-xor <> #xa5a5a5a5a5a5a5a5) sha512-init)) 
  (define (make-sha512/t-init t) 
      (define key (string->utf8 (string-append "SHA-512/" (number->string t)))) 
      (define size (bytevector-length key)) 
      (define bv (make-bytevector 128)) 
      (bytevector-copy! bv 0 key) 
      (md-pad! bv size size 16) 
      (sha512-compress bv sha512/t-init)) 
  
  (define (make-sha512/t t) 
      (define init (make-sha512/t-init t)) 
      (define words (arithmetic-shift t -6)) 
      (if (zero? (bitwise-and t 63)) 
       (cut md-loop init sha512-compress 128 words 8 16 <>) 
       (lambda (in) 
       (bytevector-copy 
       (md-loop init sha512-compress 128 (ceiling words) 8 16 in) 
       0 (arithmetic-shift t -3))))) 
  
  ;;; Public entry points. 
  
  (define sha1 (cut md-loop sha1-init sha1-compress 64 5 4 8 <>)) 
  (define sha224 (cut md-loop sha224-init sha256-compress 64 7 4 8 <>)) 
  (define sha256 (cut md-loop sha256-init sha256-compress 64 8 4 8 <>)) 
  (define sha384 (cut md-loop sha384-init sha512-compress 128 6 8 16 <>)) 
  (define sha512 (cut md-loop sha512-init sha512-compress 128 8 8 16 <>)) 
  (define sha512/256 (make-sha512/t 256)) 
  (define sha512/224 (make-sha512/t 224)) 
  

  ,하지만 당신은 당신이 필요로하지 않는 어떤 밖으로 제거 할 수 있습니다

어쨌든, 속히, 여기가 (as a Gist도 가능)입니다 .

---

앞서 언급했듯이, 나는 이것을 Racket에서 테스트했습니다. 다음과 같이 내가 라켓의 API에 다리를 추가 정의는 다음과 같습니다

(use-modules (srfi srfi-1) (srfi srfi-26) (srfi srfi-43) (srfi srfi-60) 
      (rnrs bytevectors) (ice-9 binary-ports)) 

(define* (bytevector-copy bv #:optional (start 0) (end (bytevector-length bv))) 
    (define copy (make-bytevector (- end start))) 
    (bytevector-copy! copy 0 bv start end) 
    copy) 
(define* (bytevector-copy! to at from #:optional (start 0) 
               (end (bytevector-length from))) 
    ((@ (rnrs bytevectors) bytevector-copy!) from start to at (- end start))) 
(define* (read-bytevector! bv #:optional (port (current-input-port)) (start 0) 
             (end (bytevector-length bv))) 
    (get-bytevector-n! port bv start (- end start))) 

것은 쉽게 만들 수 있어야한다 :

#lang racket 
(require (only-in srfi/1 iota) 
     (only-in srfi/26 cut) 
     (only-in srfi/43 vector-unfold) 
     (only-in srfi/60 bitwise-if rotate-bit-field) 
     (rename-in racket/base [build-list list-tabulate] 
           [bytes-copy! bytevector-copy!] 
           [bytes-length bytevector-length] 
           [bytes-ref bytevector-u8-ref] 
           [bytes-set! bytevector-u8-set!] 
           [foldl fold] 
           [make-bytes make-bytevector] 
           [read-bytes! read-bytevector!] 
           [string->bytes/utf-8 string->utf8] 
           [subbytes bytevector-copy])) 

을 그리고 여기 계략에 대한 정의입니다 (버전 2.0.11 이상이 필요) 선택한 구현에 대해 비슷한 것이 있습니다.

---

I는 다양한 명령 라인 SHA-1, SHA-2 유틸리티 (예 sha1sum, sha256sum, sha512sum 등) 준비된 비교를 들어, 16 진수 문자열로 출력을 출력하는 기능을 가지고 :

(define (hex bv) 
    (define out (open-output-string)) 
    (do ((i 0 (+ i 1))) 
     ((>= i (bytevector-length bv)) (get-output-string out)) 
    (let-values (((q r) (truncate/ (bytevector-u8-ref bv i) 16))) 
     (display (number->string q 16) out) 
     (display (number->string r 16) out))))