git.distorted.org.uk Git - u/mdw/catacomb/blob - utils/psstest-xlate.lisp

   1 ;;; blah
   2
   3 (cl-interpol:enable-interpol-syntax)
   4
   5 (loop
   6    for (mech hashsz hash) in '((sha1ppss 160 sha)
   7                                    (sha256ppss 256 sha256)
   8                                    (sha384ppss 384 sha384)
   9                                    (sha512ppss 512 sha512))
  10    do (setf (get mech 'hashsz) hashsz)
  11       (setf (get mech 'hash) hash))
  12
  13 (defun skip-blank-lines (stream)
  14   (loop
  15      (let ((ch (read-char stream nil nil)))
  16        (case ch
  17          (nil (return nil))
  18          (#\newline nil)
  19          (t (unread-char ch stream)
  20             (return t))))))
  21
  22 (defun parse-stanza (stream)
  23   (flet ((parse-header ()
  24            (let ((head (read-line stream nil nil)))
  25              (and head
  26                   (cl-ppcre:register-groups-bind
  27                       (mech (#'parse-integer nbits))
  28                       (#?/^(\w+),\s+mod(?:size|len)\s+(\d+)/ ;|)
  29                        head :sharedp t)
  30                     (values (intern (string-upcase mech)) nbits)))))
  31          (check-banner (banner)
  32            (let ((line (read-line stream)))
  33              (unless (string= line banner)
  34                (error "missing banner line `~A' (found `~A')" banner line))))
  35          (parse-hexgorp (bits)
  36            (with-output-to-string (gorp)
  37              (loop
  38                 (unless (plusp bits)
  39                   (return))
  40                 (let ((line (read-line stream)))
  41                   (when (string= line "")
  42                     (return))
  43                   (unless (cl-ppcre:scan #?/^[0-9A-F-a-f\s]+$/ line)
  44                     (error "bad hex string `~A'" line))
  45                   (setf line (cl-ppcre:regex-replace-all #?/\s+/ line ""))
  46                   (decf bits (* 4 (length line)))
  47                   (princ line gorp))))))
  48     (skip-blank-lines stream)
  49     (multiple-value-bind (mech nbits) (parse-header)
  50       (when mech
  51         (let (hash out)
  52           (check-banner "Input data is")
  53           (setf hash (parse-hexgorp (get mech 'hashsz)))
  54           (check-banner "Padded output is")
  55           (setf out (parse-hexgorp nbits))
  56           (format t "~
  57 ~(  ~A
  58     0x~A
  59     \"~A\" 0 \"\"
  60     ~A-mgf ~:*~A ~A~)~%"
  61                   nbits
  62                   out
  63                   hash
  64                   (get mech 'hash)
  65                   (get mech 'hashsz))
  66           t)))))
  67
  68 (with-open-file (str "/tmp/mdw/psstests")
  69   (parse-stanza str))