| 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)) |