cgit.sxemacs.org Git - packages/blob - xemacs-packages/ecrypto/des.el

   1 ;;;  des.el - Data Encryption Standard block cipher, including 3DES
   2
   3 ;; Copyright (C) 1998 Ray Jones
   4
   5 ;; Author: Ray Jones, rjones@pobox.com
   6 ;; Keywords: DES, 3DES, oink, cipher, cypher, cryptography
   7 ;; Created: 1998-04-01
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13 ;;
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program; if not, you can either send email to this
  21 ;; program's maintainer or write to: The Free Software Foundation,
  22 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; this is not optimized at all, yet.  it uses vectors of boolean
  27 ;; values.  changing it to use 16-bit integers instead might be
  28 ;; faster, though the permutation functions will be quite a bit more
  29 ;; confusing.
  30
  31 ;; this code was written using des-how-to.txt, by Matthew Fischer
  32 ;; (mfischer@blue.weeg.uiowa.edu)
  33
  34 ;;; TODO:
  35
  36 ;; add DESX
  37 ;; add DES/SK (anyone that knows what DES/SK is, please mail me)
  38 ;; add DES with key-dependent S-boxes (a la Biham, see Schneier)
  39
  40 ;;; Code:
  41
  42 (require 'cl)
  43
  44 (defun hexstring-to-bitvec (string)
  45   "convert a hexadecimal string into a MSB-first bit vector"
  46   (let* ((strlen (length string))
  47          (bitlen (* 4 strlen))
  48          (bvec (make-vector bitlen nil)))
  49     (do ((stridx 0 (1+ stridx))
  50          (bitidx 0 (+ bitidx 4)))
  51         ((= stridx strlen) bvec)
  52       (let* ((char (aref string stridx))
  53              (val (if (and (<= ?0 char)
  54                            (<= char ?9))
  55                       (- char ?0)
  56                     (+ 10 (- (downcase char) ?a)))))
  57         (dotimes (offset 4)
  58           (when (/= 0 (logand val
  59                               (ash 1 (- 3 offset))))
  60             (aset bvec (+ bitidx offset) t)))))))
  61
  62 (defun bitvec-to-hexstring (bitvec)
  63   "convert an MSB-first bit vector into a hexadecimal string"
  64   (let* ((bitlen (length bitvec))
  65          (strlen (car (ceiling* bitlen 4)))
  66          (string (make-string strlen ?0)))
  67     (do ((stridx 0 (1+ stridx))
  68          (bitidx 0 (+ bitidx 4)))
  69         ((= stridx strlen) string)
  70       (let ((val 0))
  71         (dotimes (offset 4)
  72           (let ((bidx (+ bitidx offset)))
  73             (when (and (< bidx bitlen)
  74                        (aref bitvec bidx))
  75               (incf val (ash 1 (- 3 offset))))))
  76         (aset string stridx (if (< val 10)
  77                                 (+ ?0 val)
  78                               (+ ?a (- val 10))))))))
  79
  80 (defun des-permute (vec permute-vals)
  81   "helper function for permutations in DES code"
  82   (let* ((len (length permute-vals))
  83          (outvec (make-vector len nil)))
  84     (dotimes (offset len outvec)
  85       (aset outvec offset (aref vec (aref permute-vals offset))))))
  86
  87 ;; note that these are 0-indexed.  most references list these as 1-indexed
  88 (defconst des-PC1-vals [56 48 40 32 24 16 8 0 57 49 41 33 25 17 9 1 58 50 42 34 26 18 10 2 59 51 43 35 62 54 46 38 30 22 14 6 61 53 45 37 29 21 13 5 60 52 44 36 28 20 12 4 27 19 11 3])
  89
  90 (defun des-PC1 (key)
  91   "DES permuted choice #1.
  92 takes a 64-bit key and returns a 56-bit permuted key"
  93   (assert (= (length key) 64) nil
  94           "des-PC1: key must be 64 bits long")
  95   (des-permute key des-PC1-vals))
  96
  97 ;; note that these are 0-indexed.  most references list these as 1-indexed
  98 (defconst des-PC2-vals [13 16 10 23 0 4 2 27 14 5 20 9 22 18 11 3 25 7 15 6 26 19 12 1 40 51 30 36 46 54 29 39 50 44 32 47 43 48 38 55 33 52 45 41 49 35 28 31])
  99
 100
 101 (defun des-PC2 (key)
 102   "DES permuted choice #2.
 103 takes a 56-bit key and returns a 48-bit permuted key."
 104   (assert (= (length key) 56) nil
 105           "des-PC2: key must be 56 bits long")
 106   (des-permute key des-PC2-vals))
 107
 108
 109 (defun des-<<< (vec shift)
 110   "circular left shift VEC by SHIFT elements"
 111   (let* ((len (length vec))
 112          (outvec (make-vector len nil)))
 113     (when (or (>= shift len)
 114               (< shift 0))
 115       (setq shift (mod shift len)))
 116     (do ((out-idx 0 (1+ out-idx))
 117          (in-idx shift (1+ in-idx)))
 118         ((= in-idx len))
 119       (aset outvec out-idx (aref vec in-idx)))
 120     (do ((out-idx (- len shift) (1+ out-idx))
 121          (in-idx 0 (1+ in-idx)))
 122         ((= in-idx shift) outvec)
 123       (aset outvec out-idx (aref vec in-idx)))))
 124
 125
 126 (defconst des-key-shifts [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
 127
 128 (defun des-compute-subkeys (key)
 129   "computes the 16 48-bit subkeys from a 64-bit key"
 130   (let* ((subkeys (make-vector 16 []))
 131          (PC1 (des-PC1 key))
 132          (C (subseq PC1 0 28))
 133          (D (subseq PC1 28 56)))
 134     ;; clean up
 135     (fillarray PC1 nil)
 136     ;; compute subkeys
 137     (dotimes (count 16)
 138       (let* ((new-C (des-<<< C (aref des-key-shifts count)))
 139              (new-D (des-<<< D (aref des-key-shifts count)))
 140              (CD (vconcat new-C new-D)))
 141         (aset subkeys count (des-PC2 CD))
 142         ;; clean up
 143         (fillarray C nil)
 144         (fillarray D nil)
 145         ;; replace old with new
 146         (setq C new-C)
 147         (setq D new-D)))
 148     (fillarray C nil)
 149     (fillarray D nil)
 150     subkeys))
 151
 152
 153
 154 (defconst des-E-vals [31 0 1 2 3 4 3 4 5 6 7 8 7 8 9 10 11 12 11 12 13 14 15 16 15 16 17 18 19 20 19 20 21 22 23 24 23 24 25 26 27 28 27 28 29 30 31 0])
 155
 156 (defun des-E (vec)
 157   "perform the Expansion function on a 32-bit vector"
 158   (assert (= (length vec) 32) nil
 159           "des-E: vec must be 32 bits long")
 160   (des-permute vec des-E-vals))
 161
 162 (defun des-xor-in-place (vec1 vec2)
 163   "XOR two bit vectors together, storing in the first"
 164   (let ((len (length vec1)))
 165     (assert (= len (length vec2)) nil
 166             "des-xor: vec1 and vec2 must be of same length")
 167     (dotimes (idx len vec1)
 168       (aset vec1 idx (not (eq (aref vec1 idx)
 169                               (aref vec2 idx)))))))
 170
 171 (defun des-integer-to-bitvec (val)
 172   "converts an integer to a 4-bit bit vector (used to construct S-boxes)"
 173   (let ((out (make-vector 4 nil)))
 174     (dotimes (shift 4 out)
 175       (when (= 1 (logand 1 (ash val (- shift 3))))
 176         (aset out shift t)))))
 177
 178
 179 (defconst des-S-boxes-vals
 180   [[[14  4 13  1  2 15 11  8  3 10  6 12  5  9  0  7]
 181     [ 0 15  7  4 14  2 13  1 10  6 12 11  9  5  3  8]
 182     [ 4  1 14  8 13  6  2 11 15 12  9  7  3 10  5  0]
 183     [15 12  8  2  4  9  1  7  5 11  3 14 10  0  6 13]]
 184
 185    [[15  1  8 14  6 11  3  4  9  7  2 13 12  0  5 10]
 186     [ 3 13  4  7 15  2  8 14 12  0  1 10  6  9 11  5]
 187     [ 0 14  7 11 10  4 13  1  5  8 12  6  9  3  2 15]
 188     [13  8 10  1  3 15  4  2 11  6  7 12  0  5 14  9]]
 189
 190    [[10  0  9 14  6  3 15  5  1 13 12  7 11  4  2  8]
 191     [13  7  0  9  3  4  6 10  2  8  5 14 12 11 15  1]
 192     [13  6  4  9  8 15  3  0 11  1  2 12  5 10 14  7]
 193     [ 1 10 13  0  6  9  8  7  4 15 14  3 11  5  2 12]]
 194
 195    [[ 7 13 14  3  0  6  9 10  1  2  8  5 11 12  4 15]
 196     [13  8 11  5  6 15  0  3  4  7  2 12  1 10 14  9]
 197     [10  6  9  0 12 11  7 13 15  1  3 14  5  2  8  4]
 198     [ 3 15  0  6 10  1 13  8  9  4  5 11 12  7  2 14]]
 199
 200    [[ 2 12  4  1  7 10 11  6  8  5  3 15 13  0 14  9]
 201     [14 11  2 12  4  7 13  1  5  0 15 10  3  9  8  6]
 202     [ 4  2  1 11 10 13  7  8 15  9 12  5  6  3  0 14]
 203     [11  8 12  7  1 14  2 13  6 15  0  9 10  4  5  3]]
 204
 205    [[12  1 10 15  9  2  6  8  0 13  3  4 14  7  5 11]
 206     [10 15  4  2  7 12  9  5  6  1 13 14  0 11  3  8]
 207     [ 9 14 15  5  2  8 12  3  7  0  4 10  1 13 11  6]
 208     [ 4  3  2 12  9  5 15 10 11 14  1  7  6  0  8 13]]
 209
 210    [[ 4 11  2 14 15  0  8 13  3 12  9  7  5 10  6  1]
 211     [13  0 11  7  4  9  1 10 14  3  5 12  2 15  8  6]
 212     [ 1  4 11 13 12  3  7 14 10 15  6  8  0  5  9  2]
 213     [ 6 11 13  8  1  4 10  7  9  5  0 15 14  2  3 12]]
 214
 215    [[13  2  8  4  6 15 11  1 10  9  3 14  5  0 12  7]
 216     [ 1 15 13  8 10  3  7  4 12  5  6 11  0 14  9  2]
 217     [ 7 11  4  1  9 12 14  2  0  6 10 13 15  3  5  8]
 218     [ 2  1 14  7  4 10  8 13 15 12  9  0  3  5  6 11]]])
 219
 220 (defconst des-S-boxes (map 'vector
 221                            #'(lambda (x)
 222                                (map 'vector
 223                                     #'(lambda (y)
 224                                         (map 'vector
 225                                              #'des-integer-to-bitvec
 226                                              y))
 227                                     x))
 228                            des-S-boxes-vals))
 229
 230 (defun des-S (vec)
 231   "do the S substitution on a 48-bit vector, returning a 32-bit vector"
 232   (let ((temp-vecs (make-vector 8 nil)))
 233     (do ((Sidx 0 (1+ Sidx))
 234          (bitidx 0 (+ bitidx 6)))
 235         ((= Sidx 8))
 236       (let ((val1 (+ (if (aref vec (+ bitidx 0)) 2 0)
 237                      (if (aref vec (+ bitidx 5)) 1 0)))
 238             (val2 (+ (if (aref vec (+ bitidx 1)) 8 0)
 239                      (if (aref vec (+ bitidx 2)) 4 0)
 240                      (if (aref vec (+ bitidx 3)) 2 0)
 241                      (if (aref vec (+ bitidx 4)) 1 0))))
 242         (aset temp-vecs Sidx (aref (aref (aref des-S-boxes Sidx)
 243                                          val1)
 244                                    val2))))
 245     (prog1
 246         (apply #'vconcat (coerce temp-vecs 'list))
 247       ;; clean up
 248       (fillarray temp-vecs nil))))
 249
 250 (defconst des-P-vals [15 6 19 20 28 11 27 16 0 14 22 25 4 17 30 9 1 7 23 13 31 26 2 8 18 12 29 5 21 10 3 24])
 251
 252 (defun des-P (vec)
 253   "perform the P permutation on a 32-bit vector"
 254   (assert (= (length vec) 32) nil
 255           "des-P: vec must be 32 bits long")
 256   (des-permute vec des-P-vals))
 257
 258 (defun des-f (vec key)
 259   "perform the des f() function on 32-bit VEC and 48-bit KEY"
 260   (let* ((E-vec (des-E vec))
 261          (S-vec (des-S (des-xor-in-place E-vec key)))
 262          (P-vec (des-P S-vec)))
 263     (prog1
 264         P-vec
 265       ;; clean up
 266       (fillarray E-vec nil)
 267       (fillarray S-vec nil))))
 268
 269 (defconst des-IP-vals [57 49 41 33 25 17 9 1 59 51 43 35 27 19 11 3 61 53 45 37 29 21 13 5 63 55 47 39 31 23 15 7 56 48 40 32 24 16 8 0 58 50 42 34 26 18 10 2 60 52 44 36 28 20 12 4 62 54 46 38 30 22 14 6])
 270
 271 (defun des-IP (vec)
 272   "perform the Initial Permutation on a 64-bit data vector"
 273   (assert (= (length vec) 64) nil
 274           "des-IP: vec must be 64 bits long")
 275   (des-permute vec des-IP-vals))
 276
 277
 278 (defconst des-IP-inv-vals [39 7 47 15 55 23 63 31 38 6 46 14 54 22 62 30 37 5 45 13 53 21 61 29 36 4 44 12 52 20 60 28 35 3 43 11 51 19 59 27 34 2 42 10 50 18 58 26 33 1 41 9 49 17 57 25 32 0 40 8 48 16 56 24])
 279
 280 (defun des-IP-inv (vec)
 281   "perform the inverse of the Initial Permutation on a 64-bit data vector"
 282   (assert (= (length vec) 64) nil
 283           "des-IP-inv: vec must be 64 bits long")
 284   (des-permute vec des-IP-inv-vals))
 285
 286 (defun des-cipher-block (vec subkeys &optional reverse)
 287   "perform the DES cipher on a 64-bit VEC using SUBKEYS.
 288 if optional third arg REVERSE is true, decrypts."
 289   (let* ((IP (des-IP vec))
 290          (L (subseq IP 0 32))
 291          (R (subseq IP 32 64)))
 292     ;; clean up
 293     (fillarray IP nil)
 294
 295     (dotimes (count 16)
 296       (let ((f-R (des-f R (aref subkeys (if reverse (- 15 count) count))))
 297             (old-R R)
 298             (old-L L))
 299         (setq L old-R)
 300         (setq R (des-xor-in-place old-L f-R))
 301         ;; clean up
 302         (fillarray f-R nil)))
 303
 304     (let ((RL (vconcat R L)))
 305       (prog1
 306           (des-IP-inv RL)
 307         ;; clean up
 308         (fillarray RL nil)
 309         (fillarray R nil)
 310         (fillarray L nil)))))
 311
 312 (defun des-triple-des (data subkeys1 subkeys2 subkeys3 &optional reverse)
 313   "perform the triple-DES encryption on DATA with three sets of subkeys.
 314 if optional fifth arg REVERSE is true, decrypts."
 315   (if (not reverse)
 316       (let* ((E1 (des-cipher-block data subkeys1))
 317              (E2 (des-cipher-block E1 subkeys2 t))
 318              (E3 (des-cipher-block E2 subkeys3)))
 319         ;; clean up
 320         (fillarray E1 nil)
 321         (fillarray E2 nil)
 322         E3)
 323
 324     (let* ((D1 (des-cipher-block data subkeys3 t))
 325            (D2 (des-cipher-block D1 subkeys2))
 326            (D3 (des-cipher-block D2 subkeys1 t)))
 327       ;; clean up
 328       (fillarray D1 nil)
 329       (fillarray D2 nil)
 330       D3)))