1. evhan
  2. siphash

Commits

evhan  committed acbf24f

initial

  • Participants
  • Branches master

Comments (0)

Files changed (1)

File siphash.scm

View file
  • Ignore whitespace
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; A Scheme implementation of SipHash, a cryptographically strong
+;;; family of hash functions designed by Jean-Philippe Aumasson and
+;;; Daniel J. Bernstein.
+;;;
+;;; http://131002.net/siphash/
+;;; 
+;;; Copyright (c) 2013, Evan Hanson
+;;; BSD-style license. See LICENSE for details.
+;;;
+
+(use srfi-4 numbers)
+
+;; Shorthand.
+(define & bitwise-and)
+(define ⊕ bitwise-xor)
+(define ❘ bitwise-ior)
+
+;; 64-bit-word-bounded operations.
+(define-syntax w (syntax-rules () ((_ n)   (bitwise-and n 18446744073709551615))))
+(define-syntax « (syntax-rules () ((_ n m) (w (arithmetic-shift n m)))))
+(define-syntax ↺ (syntax-rules () ((_ n m) (❘ (« n m) (« n (- (- 64 m)))))))
+
+;; Repeat body `b` `n` times.
+(define-syntax do-times
+  (syntax-rules ()
+    ((_ n . b)
+     (do ((i n (- i 1)))
+         ((zero? i))
+       (begin . b)))))
+
+;; Treats `v` as little-endian.
+(define u8vector->integer 
+  (case-lambda
+    ((v)
+     (u8vector->integer v (u8vector-length v)))
+    ((v l)
+     (do ((i 0 (+ i 1))
+          (a 0 (+ a (« (u8vector-ref v i) (* i 8)))))
+         ((= i l) a)))))
+
+;; One SipRound.
+(define-syntax sip-round!
+  (syntax-rules ()
+    ((_ v0 v1 v2 v3)
+     (let-syntax ((+ (syntax-rules () ((_ . n) (w (+ . n))))))
+       (set! v0 (+ v0 v1))
+       (set! v2 (+ v2 v3))
+       (set! v1 (↺ v1 13))
+       (set! v3 (↺ v3 16))
+       (set! v1 (⊕ v1 v0))
+       (set! v3 (⊕ v3 v2))
+       (set! v0 (↺ v0 32))
+       (set! v2 (+ v2 v1))
+       (set! v0 (+ v0 v3))
+       (set! v1 (↺ v1 17))
+       (set! v3 (↺ v3 21))
+       (set! v1 (⊕ v1 v2))
+       (set! v3 (⊕ v3 v0))
+       (set! v2 (↺ v2 32))))))
+
+(define make-siphash
+  (let ((m0 (string->number "736f6d6570736575" 16))
+        (m1 (string->number "646f72616e646f6d" 16))
+        (m2 (string->number "6c7967656e657261" 16))
+        (m3 (string->number "7465646279746573" 16)))
+    (lambda (c d)
+      (lambda (k m)
+        (let* ((l  (u8vector-length m))
+               (k0 (u8vector->integer (subu8vector k 0 8) 8))
+               (k1 (u8vector->integer (subu8vector k 8 16) 8))
+               (v0 (⊕ k0 m0))
+               (v1 (⊕ k1 m1))
+               (v2 (⊕ k0 m2))
+               (v3 (⊕ k1 m3)))
+          (let-syntax ((process-message!
+                        (syntax-rules ()
+                          ((_ m) (let ((mi m))
+                                   (set! v3 (⊕ v3 mi))
+                                   (do-times c
+                                     (sip-round! v0 v1 v2 v3))
+                                   (set! v0 (⊕ v0 mi)))))))
+            (do ((i 0 (+ i 8)))
+                ((> i (- l 8))
+                 (process-message!
+                  (❘ (« (modulo l 256) 56)
+                     (u8vector->integer (subu8vector m i l)))))
+              (process-message!
+               (u8vector->integer (subu8vector m i (+ i 8)) 8)))
+            (set! v2 (⊕ v2 255))
+            (do-times d
+              (sip-round! v0 v1 v2 v3))
+            (⊕ v0 v1 v2 v3)))))))
+
+(define siphash-2-4 (make-siphash 2 4))
+(define siphash-4-8 (make-siphash 4 8))