lispnik (lispnik) wrote,
lispnik
lispnik

Новый CipherSaber

В связи с неожиданно всплывшим интересом к моей реализации CipherSaber я решил пересмотреть её код. В частности, изменил одну неправильную декларацию типа. :)

Теперь файл компилируется в SBCL (на x64) без предупреждений даже на самой высокой степени оптимизации.

(deftype byte8 ()
  '(unsigned-byte 8))

(deftype cs-vector (&optional (len 256))
  `(simple-array byte8 (,len)))

(defun make-init-vector ()
  (let ((vec (make-array 256 :element-type 'byte8 :initial-element 0)))
    (declare (type cs-vector vec))
    (dotimes (i 256)
      (setf (aref vec i) i))
    vec))

(declaim (inline byte8+))
(defun byte8+ (&rest args)
  ;; I presume intermediate sum doesn't exceed fixnum; it is certainly
  ;; true for the functions below, as number of arguments is up to 3.
  (ldb (byte 8 0) (the fixnum (apply #'+ args))))

(define-compiler-macro byte8+ (&rest args)
  `(ldb (byte 8 0) (+ ,@args)))

(defun mix-vector (vector key rounds)
  (declare (type cs-vector vector)
           (type (cs-vector *) key)
           (type fixnum rounds))
  (let ((j 0)
        (keylen (length key)))
    (declare (type byte8 j)
             (type fixnum keylen))
    (dotimes (k rounds)
      (dotimes (i 256)
        (let ((n (mod i keylen)))
          (setf j (byte8+ j (aref vector i) (aref key n)))
          ;; Swap
          (rotatef (aref vector i) (aref vector j)))))
    vector))

(defun encrypt-decrypt (input-stream output-stream key &optional (rounds 1))
  (let ((vector (mix-vector (make-init-vector) key rounds)))
    (declare (type cs-vector vector))
    (loop :with i :of-type byte8 := 0  ; Runs from 0 to 255 and then
                                       ; again from 0
          :with j :of-type byte8 := 0
          :for byte :of-type (or byte8 null) := (read-byte input-stream nil nil)
          :while byte :do
          (setf i (byte8+ i 1))
          (setf j (byte8+ j (aref vector i)))
          ;; Swap
          (rotatef (aref vector i) (aref vector j))
          (let ((n (byte8+ (aref vector i) (aref vector j))))
            (write-byte (logxor byte (aref vector n))
                        output-stream)))))

(defun passphrase-to-key (passphrase key)
  (declare (type simple-string passphrase)
           (type (cs-vector *) key))
  ;; Copy passphrase to key
  (let ((psph-len (length passphrase)))
    (dotimes (i psph-len)
      (let ((code (char-code (aref passphrase i))))
        (when (< 255 code)
          (setf code (mod code 256))
          (warn "Char is out of range: ~S" (aref passphrase i)))
        (setf (aref key i)
              code)))))

(defun make-enc-key (passphrase output)
  (declare (type string passphrase))
  (let ((psph-len (length passphrase)))
    (let ((key (make-array (+ 10 psph-len)
                           :element-type 'byte8
                           :initial-element 0))
          (rnd-file (or #+unix(probe-file #p"/dev/random")
                        #+unix(probe-file #p"/dev/urandom"))))
      (declare (type (cs-vector *) key))
      (passphrase-to-key passphrase key)
      ;; Generate IV
      (if rnd-file
          ;; Wonderful!  We have system RNG
          (with-open-file (rnd-input rnd-file
                                     :direction :input
                                     :element-type 'byte8)
            (dotimes (i 10)
              (let ((byte (read-byte rnd-input)))
                (setf (aref key (+ i psph-len)) byte)
                (write-byte byte output))))
          ;; We have no system RNG; try Lisp RNG
          (let ((rnd (make-random-state t)))
            (dotimes (i 10)
              (let ((byte (random 256 rnd)))
                (setf (aref key (+ i psph-len)) byte)
                (write-byte byte output)))))
      key)))

(defun make-dec-key (passphrase input)
  (declare (type string passphrase))
  (let ((psph-len (length passphrase)))
    (let ((key (make-array (+ 10 psph-len)
                           :element-type 'byte8
                           :initial-element 0)))
      (passphrase-to-key passphrase key)
      (dotimes (i 10)
        (let ((byte (read-byte input)))
          (setf (aref key (+ i psph-len)) byte)))
      key)))

(defun encrypt-stream1 (passphrase input output)
  "Insecure CypherSaber1-encrypt input stream with PASSPHRASE"
  (let ((key (make-enc-key passphrase output)))
    (encrypt-decrypt input output key)))

(defun decrypt-stream1 (passphrase input output)
  "Decrypt insecure CypherSaber1-encoded input stream with PASSPHRASE"
  (let ((key (make-dec-key passphrase input)))
    (encrypt-decrypt input output key)))

(defun encrypt-stream2 (passphrase input output &optional (rounds 20))
  "CypherSaber2-encrypt input stream with PASSPHRASE"
  (let ((key (make-enc-key passphrase output)))
    (encrypt-decrypt input output key rounds)))

(defun decrypt-stream2 (passphrase input output &optional (rounds 20))
  "Decrypt CypherSaber2-encoded input stream with PASSPHRASE"
  (let ((key (make-dec-key passphrase input)))
    (encrypt-decrypt input output key rounds)))

Upd: теперь используется length вместо array-dimension, чтобы не было предупреждений на x86.

Tags: ciphersaber, crypto, lisp
Subscribe

  • Post a new comment

    Error

    Anonymous comments are disabled in this journal

    default userpic

    Your IP address will be recorded 

  • 1 comment