pkcs12-experiment.lisp

(ql:quickload '(:cl+ssl :fast-io))

(in-package #:cl-user)
(defpackage #:pkcs12-experiment
  (:use #:cl)
  (:import-from #:cffi)
  (:import-from #:cl+ssl))
(in-package #:pkcs12-experiment)

(cffi:defcfun ("EVP_PKEY_new" evp-pkey-new) :pointer)
(cffi:defcfun ("EVP_PKEY_free" evp-pkey-free) :void
  (evp-pkey :pointer))
(cffi:defcfun ("X509_new" x509-new) :pointer)
(cffi:defcfun ("X509_free" x509-free) :void
  (x509 :pointer))
(cffi:defcstruct stack-of-x509
  (stack :pointer))

(cffi:defcfun ("BIO_s_mem" bio-s-mem) :pointer)

(cffi:defcfun ("BIO_new_mem_buf" bio-new-mem-buf) :pointer
  (buf :pointer)
  (len :int))

(cffi:defcfun ("BIO_ctrl" bio-ctrl) :long
  (bio :pointer)
  (cmd :int)
  (larg :long)
  (parg :pointer))

(cffi:defcfun ("BIO_read" bio-read) :int
  (bio :pointer)
  (buf :pointer)
  (len :int))

(cffi:defcfun ("BIO_free" bio-free) :int
  (bio :pointer))

(cffi:defcfun ("X509_print_ex" x509-print-ex) :int
  (bio :pointer)
  (x :pointer)
  (nmflags :unsigned-long)
  (cflags :unsigned-long))

(cffi:defcfun ("d2i_PKCS12_bio" d2i-pkcs12-bio) :pointer
  (bio :pointer)
  (a :pointer))

(cffi:defcfun ("PKCS12_parse" pkcs12-parse) :int
  (p12 :pointer)
  (pass :string)
  (pkey :pointer)
  (cert :pointer)
  (ca :pointer))

(cffi:defcfun ("PKCS12_free" pkcs12-free) :void
  (p12 :pointer))

(cffi:defcfun ("PKCS12_verify_mac" pkcs12-verify-mac) :int
  (p12 :pointer)
  (pass :string)
  (passlen :int))

(cffi:defcfun ("ERR_print_errors" err-print-errors) :void
  (bio :pointer))

(cffi:defcfun ("OpenSSL_add_all_digests" openssl-add-all-digests) :void)

(cffi:defcfun ("PKCS12_PBE_add" pkcs12-pbe-add) :void)

(defun bio-to-data (bio)
  (let ((buffer (make-array (* 5 1024) :element-type '(integer -1 32))))
    (cffi:with-pointer-to-vector-data (buffer-sap buffer)
      (let ((len (bio-read bio buffer-sap (* 5 1024))))
        (if (= len -1)
            (subseq buffer 0 0)
            (subseq buffer 0 len))))))

(defun bio-to-string (bio)
  (map 'string #'code-char (bio-to-data bio)))

(defun slurp-file (file)
  (fast-io:with-fast-output (result)
    (let ((buffer (make-array 1024 :element-type '(unsigned-byte 8))))
      (with-open-file (in file :element-type '(unsigned-byte 8))
        (loop for read = (read-sequence buffer in)
              do (fast-io:fast-write-sequence buffer result 0 read)
              while (= read 1024))))))

(defun get-errors ()
  (let ((bio (cl+ssl::bio-new (bio-s-mem))))
    (unwind-protect
         (progn
           (err-print-errors bio)
           (bio-to-string bio))
      (bio-free bio))))

(defun load-pkcs12 (file &optional passphrase)
  (openssl-add-all-digests)
  (pkcs12-pbe-add)
  (let ((content (slurp-file file)))
    (cffi:with-pointer-to-vector-data (data-sap content)
      (let* ((bio (bio-new-mem-buf data-sap (length content)))
             (p12 (d2i-pkcs12-bio bio (cffi:null-pointer)))
             (pkey (evp-pkey-new))
             (cert (x509-new)))
        (unwind-protect
             (progn
               (let ((res (pkcs12-verify-mac p12 (or passphrase (cffi:null-pointer)) (length passphrase))))
                 (when (zerop res)
                   (error (format nil "Error while verifying mac~%~A" (get-errors)))))
               (cffi:with-foreign-objects ((*pkey :pointer)
                                           (*cert :pointer))
                 (setf (cffi:mem-ref *pkey :pointer) pkey
                       (cffi:mem-ref *cert :pointer) cert)
                 (let ((res
                         (pkcs12-parse p12
                                       (or passphrase (cffi:null-pointer))
                                       *pkey
                                       *cert
                                       (cffi:null-pointer))))
                   (when (zerop res)
                     (error "Error in pkcs12-parse~%~A" (get-errors)))))
               (pkcs12-free p12)
               (let ((bio (cl+ssl::bio-new (bio-s-mem))))
                 (unwind-protect
                      (progn
                        (x509-print-ex bio cert 0 0)
                        (bio-to-string bio))
                   (bio-free bio))))
          (evp-pkey-free pkey)
          (x509-free cert))))))