ported to CHICKEN 5

rabbit.c5.release-info

@@ -0,0 +1,7 @@
+;; -*- scheme -*-
+
+(repo git "git://github.com/iraikov/chicken-rabbit.git")
+(uri targz "https://github.com/iraikov/chicken-rabbit/tarball/{egg-release}")
+(uri files-list "http://code.call-cc.org/files-list?egg={egg-name};egg-release={egg-release};chicken-release={chicken-release}" old-uri)
+
+(release "1.2")

rabbit.egg

@@ -0,0 +1,12 @@
+;;;; -*- Scheme -*-
+
+((synopsis "Rabbit stream cipher.")
+ (license "Public Domain")
+ (category crypt)
+ (dependencies datatype matchable yasos srfi-1)
+ (test-dependencies test srfi-1)
+ (maintainer "Ivan Raikov")
+ (author "Martin Boesgaard, Mette Vesterager, Thomas Christensen and Erik Zenner")
+ (components (extension rabbit))
+ )
+

rabbit.scm

@@ -8,18 +8,13 @@
 
 (module rabbit
 
-        (rabbit-debuglevel
+        (debuglevel make-context destroy-context! encode! decode!)
-         rabbit-make
-         rabbit-destroy!
-         rabbit-encode!
-         rabbit-decode!)
 
-	(import scheme chicken foreign)
+	(import scheme (chicken base) (chicken foreign) (chicken blob) (chicken format))
-        (import (only extras printf))
 
-        (define rabbit-debuglevel (make-parameter 0))
+        (define debuglevel (make-parameter 0))
-        (define (rabbit-log level . x)
+        (define (logger level . x)
-          (if (>= (rabbit-debuglevel) level) (apply printf (append (list "rabbit: ") x))))
+          (if (>= (debuglevel) level) (apply printf (append (list "rabbit: ") x))))
 
 
 #>
@@ -28,8 +23,8 @@
 <#
 
 
-(define (rabbit-make key)  ;; key must be at least 24 bytes
+(define (make-context key)  ;; key must be at least 24 bytes
-  (rabbit-log 1 "rabbit-make " (blob->string key))
+  (logger 1 "make-context " (blob->string key))
   ((foreign-safe-lambda* nonnull-c-pointer ((scheme-object key))
 #<<END
      int len; void* keydata, *result;
@@ -42,8 +37,8 @@ END
   )
 
 
-(define (rabbit-destroy! ctx)
+(define (destroy-context! ctx)
-  (rabbit-log 1 "rabbit-destroy " ctx)
+  (logger 1 "destroy-context " ctx)
   ((foreign-lambda* void ((nonnull-c-pointer ctx))
 #<<END
      _rabbit_destroy(ctx);
@@ -51,8 +46,8 @@ END
    ) ctx)
 )
 
-(define (rabbit-encode! ctx v)
+(define (encode! ctx v)
-  (rabbit-log 2 "rabbit-encode/decode " ctx " " v)
+  (logger 2 "encode/decode " ctx " " v)
   (if (blob? v) 
       (begin
         ((foreign-lambda* void ((nonnull-c-pointer ctx) (scheme-object v))
@@ -66,6 +61,6 @@ EOF
         v)
       #f))
 
-(define rabbit-decode! rabbit-encode!)
+(define decode! encode!)
 
 )

tests/run.scm

@@ -1,30 +1,18 @@
-(use rabbit srfi-4 test)
+(import scheme (chicken base) (chicken random) (chicken blob) rabbit test)
-
-(randomize)
-
-(define (random-blob n)
-  (let ((v (make-u8vector n)))
-    (let loop ((n n))
-      (if (> n 0)
-          (begin 
-            (u8vector-set! v (- n 1) (random 255))
-            (loop (- n 1)))
-          (u8vector->blob v)))
-    ))
                        
 (test-group "rabbit 1000 random vectors" 
   (let loop ((n 1000))
     (test-assert
       (if (= n 0) #t 
           (if (let* (
-                     (keylen (+ (random 10) 24))
+                     (keylen (+ (pseudo-random-integer 10) 24))
-                     (key (random-blob keylen))
+                     (key (random-bytes (make-blob keylen)))
-                     (datalen (random 100000))
+                     (datalen (pseudo-random-integer 100000))
-                     (data (random-blob datalen))
+                     (data (random-bytes (make-blob datalen)))
-                     (ctx (rabbit-make key))
+                     (ctx (make-context key))
                      )
-                (let ((res (not (equal? data (rabbit-decode! ctx (rabbit-encode! ctx data))))))
+                (let ((res (not (equal? data (decode! ctx (encode! ctx data))))))
-                  (rabbit-destroy! ctx)
+                  (destroy-context! ctx)
                   res))
               #f 
               (loop (- n 1)))))))