blowfish encryption - encrypt decrypt
This commit is contained in:
		
							parent
							
								
									f13cfe023b
								
							
						
					
					
						commit
						34b9159fa9
					
				| 
						 | 
				
			
			@ -1 +1,2 @@
 | 
			
		|||
Encryption done in scheme.
 | 
			
		||||
;; NOTE : Do not forget to set the endianess !
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -28,6 +28,10 @@
 | 
			
		|||
 | 
			
		||||
(load "dictionary.scm")
 | 
			
		||||
 | 
			
		||||
(define BIG-ENDIAN-HOST (if (getenv BIG_ENDIAN_HOST)
 | 
			
		||||
                            (getenv BIG_ENDIAN_HOST)
 | 
			
		||||
                            #t) ;; NOTE : Do not forget to set this !
 | 
			
		||||
 | 
			
		||||
(define blowfish-ks0 (make-dictionary))
 | 
			
		||||
(dictionary-add! blowfish-ks0 '0xD1310BA6)
 | 
			
		||||
(dictionary-add! blowfish-ks0 '0x98DFB5AC)
 | 
			
		||||
| 
						 | 
				
			
			@ -1091,11 +1095,11 @@
 | 
			
		|||
  (record-constructor :blowfish-record
 | 
			
		||||
		      '(blowfish-s0 blowfish-s1 blowfish-s2 blowfish-s3 blowfish-p)))
 | 
			
		||||
 | 
			
		||||
(define blowfish-record:s0 (record-accessor :blowfish-record 'blowfish-s0))
 | 
			
		||||
(define blowfish-record:s1 (record-accessor :blowfish-record 'blowfish-s1))
 | 
			
		||||
(define blowfish-record:s2 (record-accessor :blowfish-record 'blowfish-s2))
 | 
			
		||||
(define blowfish-record:s3 (record-accessor :blowfish-record 'blowfish-s3))
 | 
			
		||||
(define blowfish-record:p (record-accessor :blowfish-record 'blowfish-p))
 | 
			
		||||
(define blowfish-s0 (record-accessor :blowfish-record 'blowfish-s0))
 | 
			
		||||
(define blowfish-s1 (record-accessor :blowfish-record 'blowfish-s1))
 | 
			
		||||
(define blowfish-s2 (record-accessor :blowfish-record 'blowfish-s2))
 | 
			
		||||
(define blowfish-s3 (record-accessor :blowfish-record 'blowfish-s3))
 | 
			
		||||
(define blowfish-p (record-accessor :blowfish-record 'blowfish-p))
 | 
			
		||||
 | 
			
		||||
(define blowfish-rounds 16) ;;
 | 
			
		||||
(define blowfish-context (make-blowfish-record
 | 
			
		||||
| 
						 | 
				
			
			@ -1105,31 +1109,125 @@
 | 
			
		|||
                          (make-vector 256)
 | 
			
		||||
                          (make-vector (+ blowfish-rounds) 2)))
 | 
			
		||||
 | 
			
		||||
(define blowfish-ps (make-dictionary))
 | 
			
		||||
(dictionary-add! blowfish-ps '0x243F6A88)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x85A308D3)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x13198A2E)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x03707344)
 | 
			
		||||
(dictionary-add! blowfish-ps '0xA4093822)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x299F31D0)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x082EFA98)
 | 
			
		||||
(dictionary-add! blowfish-ps '0xEC4E6C89)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x452821E6)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x38D01377)
 | 
			
		||||
(dictionary-add! blowfish-ps '0xBE5466CF)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x34E90C6C)
 | 
			
		||||
(dictionary-add! blowfish-ps '0xC0AC29B7)
 | 
			
		||||
(dictionary-add! blowfish-ps '0xC97C50DD)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x3F84D5B5)
 | 
			
		||||
(dictionary-add! blowfish-ps '0xB5470917)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x9216D5D9)
 | 
			
		||||
(dictionary-add! blowfish-ps '0x8979FB1B)
 | 
			
		||||
(define blowfish-ps (make-table))
 | 
			
		||||
(table-set! blowfish-ps 0  '0x243F6A88)
 | 
			
		||||
(table-set! blowfish-ps 1  '0x85A308D3)
 | 
			
		||||
(table-set! blowfish-ps 2  '0x13198A2E)
 | 
			
		||||
(table-set! blowfish-ps 3  '0x03707344)
 | 
			
		||||
(table-set! blowfish-ps 4  '0xA4093822)
 | 
			
		||||
(table-set! blowfish-ps 5  '0x299F31D0)
 | 
			
		||||
(table-set! blowfish-ps 6  '0x082EFA98)
 | 
			
		||||
(table-set! blowfish-ps 7  '0xEC4E6C89)
 | 
			
		||||
(table-set! blowfish-ps 8  '0x452821E6)
 | 
			
		||||
(table-set! blowfish-ps 9  '0x38D01377)
 | 
			
		||||
(table-set! blowfish-ps 10 '0xBE5466CF)
 | 
			
		||||
(table-set! blowfish-ps 11 '0x34E90C6C)
 | 
			
		||||
(table-set! blowfish-ps 12 '0xC0AC29B7)
 | 
			
		||||
(table-set! blowfish-ps 13 '0xC97C50DD)
 | 
			
		||||
(table-set! blowfish-ps 14 '0x3F84D5B5)
 | 
			
		||||
(table-set! blowfish-ps 15 '0xB5470917)
 | 
			
		||||
(table-set! blowfish-ps 16 '0x9216D5D9)
 | 
			
		||||
(table-set! blowfish-ps 17 '0x8979FB1B)
 | 
			
		||||
 | 
			
		||||
(define blowfish_R(l r i)
 | 
			
		||||
  (let ((l (bitwise-not (dictionary-ref blowfish-p i))))
 | 
			
		||||
(define (blowfish-F-be x)
 | 
			
		||||
  (bitwise-xor (+ (vector-ref (blowfish-s0 blowfish-context) 0)
 | 
			
		||||
                  (vector-ref (blowfish-s1 blowfish-context) 1))
 | 
			
		||||
               (+ (vector-ref (blowfish-s2 blowfish-context) 2)
 | 
			
		||||
                  (vector-ref (blowfish-s3 blowfish-context) 3))))
 | 
			
		||||
(define (blowfish-F-le x)
 | 
			
		||||
  (bitwise-xor (+ (vector-ref (blowfish-s0 blowfish-context) 3)
 | 
			
		||||
                  (vector-ref (blowfish-s1 blowfish-context) 2))
 | 
			
		||||
               (+ (vector-ref (blowfish-s2 blowfish-context) 1)
 | 
			
		||||
                  (vector-ref (blowfish-s3 blowfish-context) 0))))
 | 
			
		||||
(define blowfish-F (if BIG-ENDIAN-HOST blowfish-F-be blowfish-F-le)) ;; FIXME default is big endian
 | 
			
		||||
 | 
			
		||||
(define (blowfish-encrypt)
 | 
			
		||||
  )
 | 
			
		||||
(define (blowfish-R l r i)
 | 
			
		||||
  (let ((l (bitwise-xor l (dictionary-ref (blowfish-p blowfish-context) i)))
 | 
			
		||||
        (r (bitwise-xor r ((dictionary-ref (blowfish-p blowfish-context) blowfish_F l)))))
 | 
			
		||||
    ))
 | 
			
		||||
 | 
			
		||||
(define (blowfish-decrypt)
 | 
			
		||||
;; blowfish-rounds == 16 ->
 | 
			
		||||
(define (blowfish-encrypt bc ret_xl ret_xr) ;; NOTE bc = blowfish-context
 | 
			
		||||
  (let ((xl ret_xl)
 | 
			
		||||
        (xr ret_xr)
 | 
			
		||||
        (p (blowfish-p bc))
 | 
			
		||||
        (s0 (blowfish-s0 bc))
 | 
			
		||||
        (s1 (blowfish-s1 bc))
 | 
			
		||||
        (s2 (blowfish-s2 bc))
 | 
			
		||||
        (s3 (blowfish-s3 bc)))
 | 
			
		||||
 | 
			
		||||
    (blowfish-R xl xr 0)
 | 
			
		||||
    (blowfish-R xr xl 1)
 | 
			
		||||
    (blowfish-R xl xr 2)
 | 
			
		||||
    (blowfish-R xr xl 3)
 | 
			
		||||
    (blowfish-R xl xr 4)
 | 
			
		||||
    (blowfish-R xr xl 5)
 | 
			
		||||
    (blowfish-R xl xr 6)
 | 
			
		||||
    (blowfish-R xr xl 7)
 | 
			
		||||
    (blowfish-R xl xr 8)
 | 
			
		||||
    (blowfish-R xr xl 9)
 | 
			
		||||
    (blowfish-R xl xr 10)
 | 
			
		||||
    (blowfish-R xr xl 11)
 | 
			
		||||
    (blowfish-R xl xr 12)
 | 
			
		||||
    (blowfish-R xr xl 13)
 | 
			
		||||
    (blowfish-R xl xr 14)
 | 
			
		||||
    (blowfish-R xr xl 15)
 | 
			
		||||
 | 
			
		||||
    (let ((xl (bitwise-xor xl (vector-ref p blowfish-rounds)))
 | 
			
		||||
          (xr (bitwise-xor xr (vector-ref p (+ blowfish-rounds)))))
 | 
			
		||||
      (set! ret_xl xr)
 | 
			
		||||
      (set! ret_xr xl)
 | 
			
		||||
      )))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(define (blowfish-decrypt bc ret_xl ret_xr) ;; NOTE bc = blowfish-context
 | 
			
		||||
  (let ((xl ret_xl)
 | 
			
		||||
        (xr ret_xr)
 | 
			
		||||
        (p (blowfish-p bc))
 | 
			
		||||
        (s0 (blowfish-s0 bc))
 | 
			
		||||
        (s1 (blowfish-s1 bc))
 | 
			
		||||
        (s2 (blowfish-s2 bc))
 | 
			
		||||
        (s3 (blowfish-s3 bc)))
 | 
			
		||||
 | 
			
		||||
    (blowfish-R xl xr 17)
 | 
			
		||||
    (blowfish-R xr xl 16)
 | 
			
		||||
    (blowfish-R xl xr 15)
 | 
			
		||||
    (blowfish-R xr xl 14)
 | 
			
		||||
    (blowfish-R xl xr 13)
 | 
			
		||||
    (blowfish-R xr xl 12)
 | 
			
		||||
    (blowfish-R xl xr 11)
 | 
			
		||||
    (blowfish-R xr xl 10)
 | 
			
		||||
    (blowfish-R xl xr 9)
 | 
			
		||||
    (blowfish-R xr xl 8)
 | 
			
		||||
    (blowfish-R xl xr 7)
 | 
			
		||||
    (blowfish-R xr xl 6)
 | 
			
		||||
    (blowfish-R xl xr 5)
 | 
			
		||||
    (blowfish-R xr xl 4)
 | 
			
		||||
    (blowfish-R xl xr 3)
 | 
			
		||||
    (blowfish-R xr xl 2)
 | 
			
		||||
 | 
			
		||||
    (let ((xl (bitwise-xor xl (vector-ref p 1)))
 | 
			
		||||
          (xr (bitwise-xor xr (vector-ref p 0))))
 | 
			
		||||
      (set! ret_xl xr)
 | 
			
		||||
      (set! ret_xr xl)
 | 
			
		||||
      )))
 | 
			
		||||
 | 
			
		||||
(define (blowfish-set-key bc key keylen)
 | 
			
		||||
 | 
			
		||||
  (do ((i 0 (+ i 1)))
 | 
			
		||||
      ((=> i (+ blowfish-rounds 2))0)
 | 
			
		||||
        (set! (vector-ref (blowfish-p bc) i) (table-ref blowfish-ps i)))
 | 
			
		||||
 | 
			
		||||
  (do ((i 0 (+ i 1)))
 | 
			
		||||
      ((>= i 256)0)
 | 
			
		||||
    (((blowfish-s0 bc) 'set-with-index) i (((blowfish-ks0 'get-with-index) i)))
 | 
			
		||||
    (((blowfish-s1 bc) 'set-with-index) i (((blowfish-ks1 'get-with-index) i)))
 | 
			
		||||
    (((blowfish-s2 bc) 'set-with-index) i (((blowfish-ks2 'get-with-index) i)))
 | 
			
		||||
    (((blowfish-s3 bc) 'set-with-index) i (((blowfish-ks3 'get-with-index) i)))
 | 
			
		||||
    )
 | 
			
		||||
 | 
			
		||||
  (do ((i 0 (+ i 1))
 | 
			
		||||
       (j 0 (+ j 1)))
 | 
			
		||||
      ((>= i (+ blowfish-rounds 2))0)
 | 
			
		||||
    )
 | 
			
		||||
  )
 | 
			
		||||
| 
						 | 
				
			
			@ -36,6 +36,20 @@
 | 
			
		|||
	   (cadar l));;returns value
 | 
			
		||||
	))
 | 
			
		||||
 | 
			
		||||
    (define (get-with-index i) ;; get key
 | 
			
		||||
      (do ((j 0 (+ j 1))
 | 
			
		||||
           (l *dict (cdr l)))
 | 
			
		||||
          ((= j i)
 | 
			
		||||
           (cadar l));;returns value
 | 
			
		||||
        ))
 | 
			
		||||
 | 
			
		||||
    (define (set-with-index i value) ;; set value
 | 
			
		||||
      (do ((j 0 (+ j 1))
 | 
			
		||||
           (l *dict (cdr l)))
 | 
			
		||||
          ((= j i)
 | 
			
		||||
           (set-car! (list-ref *dict j) value));;sets value FIXME
 | 
			
		||||
        ))
 | 
			
		||||
 | 
			
		||||
    (define (get-substring key) ;; get key
 | 
			
		||||
      (do ((l *dict (cdr l)))
 | 
			
		||||
	  ((string<=? (if (symbol? key)
 | 
			
		||||
| 
						 | 
				
			
			@ -61,6 +75,8 @@
 | 
			
		|||
 | 
			
		||||
    (lambda (msg)
 | 
			
		||||
      (cond ((eq? msg 'get) get)
 | 
			
		||||
            ((eq? msg 'get-with-index) get-with-index)
 | 
			
		||||
            ((eq? msg 'set-with-index) set-with-index)
 | 
			
		||||
            ((eq? msg 'get-substring) get-substring)
 | 
			
		||||
	    ((eq? msg 'set) set)
 | 
			
		||||
	    ((eq? msg 'add) add)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue