bm-signing/cli.lisp at master · acf2/bm-signing · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
;;;; cli.lisp
;;;; Command-line interface for Bellare-Miner signing scheme

(defparameter argv (apply-argv:parse-argv (loop for elem in (rest *posix-argv*)
                                                collect (coerce elem 'string))))
(defparameter current-dir (pathname-directory *default-pathname-defaults*))

(defun getf-int (p-list key)
  (when (getf p-list key)
    (parse-integer (getf p-list key) :junk-allowed t)))

(defmacro setf-if-not-nil (place value)
  `(when (not (null ,value))
     (setf ,place ,value)))

(defmacro fail-quit (&rest symbol-quitmsg-list)
  (let ((fail (gensym)))
    `(let ((,fail nil))
       ,@(loop for symbol-quitmsg-pair in symbol-quitmsg-list
               collect `(unless ,(first symbol-quitmsg-pair)
                          (format t ,(second symbol-quitmsg-pair))
                          (setf ,fail t)))
       (when ,fail (sb-ext:exit)))))

(defun force-write-to-file (filename value)
  (with-standard-io-syntax
    (with-open-file (f filename :direction :output :if-exists :supersede)
      (format f "~S~%" value))))

(defun read-from-file-if-exists (filename)
  (with-standard-io-syntax
    (with-open-file (f filename :direction :input :if-does-not-exist nil)
      (and f (read f)))))

(defun read-bytes-from-file-if-exists (filename)
  (with-standard-io-syntax
    (with-open-file (f filename :element-type '(unsigned-byte 8) :direction :input :if-does-not-exist nil)
      (loop with result = nil
            with buffer = (make-array 4096 :element-type '(unsigned-byte 8))
            with bytes
            do (setf bytes (read-sequence buffer f))
            do (setf result (concatenate '(vector (unsigned-byte 8)) result (subseq buffer 0 bytes)))
            while (= bytes 4096)
            finally (return result)))))

(setf-if-not-nil bm-signing:*boundary* (getf-int argv :bits))
(setf-if-not-nil bm-signing:*challenge-length* (getf-int argv :points))

(defun generate-key (private-key-file public-key-file time-periods)
  (fail-quit (private-key-file "You should specify private key filename for generation of the key~%")
             (public-key-file "You should specify public key filename for generation of the key~%")
             (time-periods "You should specify number of time periods for generation of the key~%"))
  (let ((key (bm-signing:generate-key time-periods)))
    (force-write-to-file public-key-file (getf key :public-key))
    (force-write-to-file private-key-file (getf key :private-key))
    (format t "Private key '~A' and public key '~A' was generated for ~D time periods~%" private-key-file public-key-file (getf (getf key :private-key) :time-periods))))

(defun update-key (private-key-file)
  (fail-quit (private-key-file "Please specify private key for update~%"))
  (let ((private-key (read-from-file-if-exists private-key-file)))
    (fail-quit (private-key "Incorrect private key~%"))
    (setf private-key (bm-signing:update-key private-key))
    (force-write-to-file private-key-file private-key)
    (format t "Private key '~A' was updated to ~D state~%" private-key-file (getf private-key :current-state))))

(defun sign (message-file private-key-file signature-file)
  (fail-quit (private-key-file "You should specify a private key for signing~%")
             (message-file "You can not sign nothing: please specify a file to sign~%")
             (signature-file "Please, provide a signature file name~%"))
  (let ((private-key (read-from-file-if-exists private-key-file))
        (message (read-bytes-from-file-if-exists message-file)))
    (fail-quit (private-key "Incorrect private key~%"))
    (force-write-to-file signature-file (bm-signing:sign message private-key))
    (format t "File ~A was signed with key '~A' (currently in ~D state)~%" message-file private-key-file (getf private-key :current-state))))

(defun verify (message-file signature-file public-key-file revoke-since)
  (fail-quit (public-key-file "You should specify a public key for verifying~%")
             (message-file "You can not verify nothing: please specify a file~%")
             (signature-file "You should provide a signature to check~%"))
  (let ((public-key (read-from-file-if-exists public-key-file))
        (message (read-bytes-from-file-if-exists message-file))
        (signature (read-from-file-if-exists signature-file)))
    (fail-quit (public-key "Incorrect public key~%")
               (signature "Incorrect signature~%"))
    (if (and (numberp revoke-since) (>= (getf signature :timestamp) revoke-since))
      (format t "~A: SIGNATURE GENERATED WITH REVOKED KEY~%ATTENTION: PROBABLY FORGERY ATTEMPT~%" signature-file)
      (if (bm-signing:verify message signature public-key)
        (format t "~A: valid signature for '~A'~%" signature-file message-file)
        (format t "~A: INVALID SIGNATURE FOR '~A'~%ATTENTION: MESSAGE OR SIGNATURE WERE MODIFIED~%" signature-file message-file)))))

(cond
  ((getf argv :generate-key)
   (generate-key (getf argv :private-key)
                 (getf argv :public-key)
                 (getf-int argv :time-periods)))
  ((getf argv :update-key)
   (update-key (getf argv :private-key)))
  ((getf argv :sign)
   (sign (getf argv :message)
         (getf argv :private-key)
         (getf argv :signature)))
  ((getf argv :verify)
   (verify (getf argv :message)
           (getf argv :signature)
           (getf argv :public-key)
           (getf-int argv :revoke-since))))