Skip to content

Instantly share code, notes, and snippets.

@fukamachi
Created April 10, 2017 13:50

Revisions

  1. fukamachi created this gist Apr 10, 2017.
    132 changes: 132 additions & 0 deletions pkcs12-experiment.lisp
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,132 @@
    (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))))))