home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / runtime / blowfish.scm < prev    next >
Text File  |  2001-03-08  |  4KB  |  99 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: blowfish.scm,v 1.23 2001/03/08 19:27:33 cph Exp $
  4.  
  5. Copyright (c) 1997-2001 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; Interface to Blowfish
  23. ;;; package: ()
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define blowfish-set-key (ucode-primitive blowfish-set-key 1))
  28. (define blowfish-ecb (ucode-primitive blowfish-ecb 4))
  29. (define blowfish-cbc (ucode-primitive blowfish-cbc-v2 5))
  30. (define blowfish-cfb64 (ucode-primitive blowfish-cfb64-substring-v2 9))
  31. (define blowfish-ofb64 (ucode-primitive blowfish-ofb64-substring 8))
  32.  
  33. (define (blowfish-available?)
  34.   (load-library-object-file "prbfish" #f)
  35.   (implemented-primitive-procedure? blowfish-cfb64))
  36.  
  37. (define (blowfish-encrypt-port input output key init-vector encrypt?)
  38.   ;; Assumes that INPUT is in blocking mode.
  39.   (let ((key (blowfish-set-key key))
  40.     (input-buffer (make-string 4096))
  41.     (output-buffer (make-string 4096)))
  42.     (dynamic-wind
  43.      (lambda ()
  44.        unspecific)
  45.      (lambda ()
  46.        (let loop ((m 0))
  47.      (let ((n (input-port/read-string! input input-buffer)))
  48.        (if (not (fix:= 0 n))
  49.            (let ((m
  50.               (blowfish-cfb64 input-buffer 0 n output-buffer 0
  51.                       key init-vector m encrypt?)))
  52.          (write-substring output-buffer 0 n output)
  53.          (loop m))))))
  54.      (lambda ()
  55.        (string-fill! input-buffer #\NUL)
  56.        (string-fill! output-buffer #\NUL)))))
  57.  
  58. (define (compute-blowfish-init-vector)
  59.   ;; This init vector includes a timestamp with a resolution of
  60.   ;; milliseconds, plus 20 random bits.  This should make it very
  61.   ;; difficult to generate two identical vectors.
  62.   (let ((iv (make-string 8)))
  63.     (do ((i 0 (fix:+ i 1))
  64.      (t (+ (* (+ (* (get-universal-time) 1000)
  65.              (remainder (real-time-clock) 1000))
  66.           #x100000)
  67.            (random #x100000))
  68.         (quotient t #x100)))
  69.     ((fix:= 8 i))
  70.       (vector-8b-set! iv i (remainder t #x100)))
  71.     iv))
  72.  
  73. (define (write-blowfish-file-header port)
  74.   (write-string blowfish-file-header-v2 port)
  75.   (newline port)
  76.   (let ((init-vector (compute-blowfish-init-vector)))
  77.     (write-string init-vector port)
  78.     init-vector))
  79.  
  80. (define (read-blowfish-file-header port)
  81.   (let ((line (read-line port)))
  82.     (cond ((string=? blowfish-file-header-v1 line)
  83.        (make-string 8 #\NUL))
  84.       ((string=? blowfish-file-header-v2 line)
  85.        (let ((init-vector (make-string 8)))
  86.          (if (not (= 8 (read-substring! init-vector 0 8 port)))
  87.          (error "Short read while getting init-vector:" port))
  88.          init-vector))
  89.       (else
  90.        (error:bad-range-argument port 'READ-BLOWFISH-FILE-HEADER)))))
  91.  
  92. (define (blowfish-file? pathname)
  93.   (let ((line (call-with-binary-input-file pathname read-line)))
  94.     (and (not (eof-object? line))
  95.      (or (string=? line blowfish-file-header-v1)
  96.          (string=? line blowfish-file-header-v2)))))
  97.  
  98. (define blowfish-file-header-v1 "Blowfish, 16 rounds")
  99. (define blowfish-file-header-v2 "Blowfish, 16 rounds, version 2")