Moved in clext/pkcs11/. Sorry, but neither git filter-brancha or git subtree seem to keep the history at all.

Pascal J. Bourguignon [2018-09-23 21:15]
Moved in clext/pkcs11/.  Sorry, but neither git filter-brancha or git subtree seem to keep the history at all.
Filename
clext/pkcs11/Makefile
clext/pkcs11/cert.options
clext/pkcs11/cffi-debug.lisp
clext/pkcs11/cffi-utils.lisp
clext/pkcs11/com.informatimago.clext.pkcs11.asd
clext/pkcs11/com.informatimago.clext.pkcs11.tests.asd
clext/pkcs11/commands.sh
clext/pkcs11/debug.lisp
clext/pkcs11/loader.lisp
clext/pkcs11/notes.txt
clext/pkcs11/pkcs11-cffi.lisp
clext/pkcs11/pkcs11.lisp
clext/pkcs11/test-find-objects.c
clext/pkcs11/tests.lisp
clext/pkcs11/ulong.c
diff --git a/clext/pkcs11/Makefile b/clext/pkcs11/Makefile
new file mode 100644
index 0000000..f9d6691
--- /dev/null
+++ b/clext/pkcs11/Makefile
@@ -0,0 +1,35 @@
+all:ulong test-find-objects
+ulong:ulong.c
+	gcc $(DEBUG_FLAGS) -I. -L. -o $@ $<
+run::ulong
+	@ ./ulong && echo status = $$?
+clean::
+	-rm -f ulong test-find-objects
+	-rm -f core
+	-rm -f *.lx64fsl *.dx64fsl *.o
+
+DEBUG_FLAGS = -O0 -g3 -ggdb3 -g -ggdb -gdwarf
+INCLUDES    = -I$(HOME)/opt/include -I/usr/local/include -I. -I/usr/include/pkcs11-helper-1.0
+LIBDIRS     = -L$(HOME)/opt/lib     -L/usr/local/lib     -L.
+LIBRARIES   = -ldl
+LDFLAGS    += $(DEBUG_FLAGS) $(LIBDIRS)
+CFLAGS     += $(DEBUG_FLAGS) $(INCLUDES)
+test-find-objects.o:test-find-objects.c
+	gcc $(DEBUG_FLAGS) $(CFLAGS)  -c -o test-find-objects.o test-find-objects.c
+test-find-objects:test-find-objects.o
+	gcc $(DEBUG_FLAGS) $(LDFLAGS)    -o test-find-objects test-find-objects.o $(LIBRARIES)
+run::test-find-objects
+	gdb test-find-objects
+
+TEST_CERT_DIR=%TEST_CERT_DIR%
+TESTCERT=test-cert
+TESTKEY=test-key
+certificate:
+	openssl req -config $(TESTCERT).options -new \
+		-x509 -sha256 -newkey rsa:2048 -nodes \
+		-keyout $(TESTKEY).pem -out $(TESTCERT).pem -days 3650
+	 openssl x509 -in $(TESTCERT).pem -text -noout
+
+	@echo '# to install certificate use:'
+	@echo cp "$(TESTCERT).pem"                  "$(TEST_CERT_DIR)/Test_x509_cert_info.pem"
+	@echo cp Certificat-d-authentification1.pem "$(TEST_CERT_DIR)/Test_x509_cert_info.pem"
diff --git a/clext/pkcs11/cert.options b/clext/pkcs11/cert.options
new file mode 100644
index 0000000..79e53bc
--- /dev/null
+++ b/clext/pkcs11/cert.options
@@ -0,0 +1,55 @@
+[req]
+distinguished_name = subject
+x509_extensions = v3_logon_cert
+prompt = no
+
+[req_distinguished_name]
+C = US
+ST = OR
+L = Portland
+O = MyCompany
+OU = MyDivision
+CN = www.mycompany.com
+
+[v3_req]
+keyUsage = critical, digitalSignature, keyAgreement
+extendedKeyUsage = serverAuth
+subjectAltName = @alt_names
+
+[alt_names]
+DNS.1 = www.mycompany.com
+DNS.2 = mycompany.com
+DNS.3 = mycompany.net
+
+[v3_logon_cert]
+keyUsage = critical, nonRepudiation, digitalSignature, keyEncipherment
+extendedKeyUsage = critical, clientAuth, emailProtection, msSmartcardLogin
+basicConstraints = critical, CA:FALSE
+subjectKeyIdentifier = hash
+authorityKeyIdentifier = keyid,issuer
+#authorityInfoAccess = @customerca_aia
+subjectAltName = otherName:msUPN;UTF8:testjean.testmartin.9999999@mintest.fr, email:testjean.testmartin@test.gouv.fr
+certificatePolicies=ia5org
+#certificatePolicies=ia5org,@rootca_polsect
+
+[rootca_polsect]
+
+[customerca_aia]
+
+[subject]
+
+C = FR
+O = MINISTERE DES TESTS
+OU = 0002 110014016
+OU = PERSONNES
+UID = 9999999
+GN = TESTJEAN
+SN = TESTMARTIN
+CN = TESTJEAN TESTMARTIN 9999999
+
+[issuer]
+
+C = FR
+O = MINISTERE DES TESTS
+OU = 0002 110014016
+CN = ADMINISTRATION CENTRALE DES TESTS
diff --git a/clext/pkcs11/cffi-debug.lisp b/clext/pkcs11/cffi-debug.lisp
new file mode 100644
index 0000000..58f1b3d
--- /dev/null
+++ b/clext/pkcs11/cffi-debug.lisp
@@ -0,0 +1,42 @@
+(defpackage "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-DEBUG"
+  (:use "COMMON-LISP" "CFFI")
+  (:shadow "FOREIGN-ALLOC" "FOREIGN-FREE")
+  (:export "FOREIGN-ALLOC" "FOREIGN-FREE"
+           "*TRACE*"))
+(in-package "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-DEBUG")
+
+(defparameter *allocated* (make-hash-table))
+(defparameter *freed*     (make-hash-table))
+(defvar *trace* nil)
+
+(defun foreign-alloc (type
+                      &rest keyargs
+                      &key (initial-element nil) (initial-contents nil)
+                        (count 1) null-terminated-p)
+  (declare (ignorable initial-element initial-contents null-terminated-p))
+  (let ((ptr  (apply (function cffi:foreign-alloc) type keyargs))
+        (size (* (foreign-type-size type) count)))
+    (setf (gethash (pointer-address ptr) *allocated*) size)
+    (when *trace*
+      (format *trace-output* "~&(foreign-alloc ~S ~{~S~^ ~}) -> ~S~%"
+              type keyargs ptr))
+    ptr))
+
+
+(defun foreign-free (ptr)
+  (when *trace* (format *trace-output* "~&(foreign-free ~S)~%" ptr))
+  (let* ((address  (pointer-address ptr))
+         (size     (gethash address *allocated*)))
+    (if size
+        (progn
+          (setf (gethash address *freed*) size)
+          (remhash address *allocated*)
+          (cffi:foreign-free ptr))
+        (let ((size (gethash address *freed*)))
+          (if size
+              (warn "Double free of ~S (size = ~S)" ptr size)
+              (progn
+                (warn "Freeing unallocated pointer ~S" ptr)
+                (cffi:foreign-free ptr)))))))
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/cffi-utils.lisp b/clext/pkcs11/cffi-utils.lisp
new file mode 100644
index 0000000..9c79a1e
--- /dev/null
+++ b/clext/pkcs11/cffi-utils.lisp
@@ -0,0 +1,124 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               cffi-utils.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Small CFFI tools.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2018-04-25 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2018 - 2018
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-UTILS"
+  (:use "COMMON-LISP" "CFFI")
+  (:export "*DUMP-PREFIX*" "DUMP"
+           "FOREIGN-VECTOR" "FOREIGN-VECTOR-COPY-FROM" "FOREIGN-VECTOR-COPY-TO"
+           "MEMCPY"))
+(in-package "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-UTILS")
+
+
+(defun memcpy (destination source byte-count)
+  (loop
+    :repeat byte-count
+    :do (setf (mem-ref destination :uchar) (mem-ref source :uchar))
+        (incf-pointer destination)
+        (incf-pointer source)
+    :finally (return destination)))
+
+(defun foreign-vector-copy-from (pointer ctype size lisp-vector
+                                 &key (convert (function identity))
+                                   (startf 0) (startl 0) (endl (length lisp-vector)))
+  "Copies SIZE elements from  the lisp subsequence: VECTOR STARTL ENDL, to
+the foreign vector of CTYPE at POINTER offset by STARTF, each
+element being transformed by the CONVERT function.
+Returns POINTER."
+
+  "Copies SIZE elements from the lisp VECTOR to the foreign vector of CTYPE at POINTER.
+Returns the destination POINTER."
+  (loop
+    :repeat size
+    :for i :from startf
+    :for j :from startl :below endl
+    :do (setf (mem-aref pointer ctype i) (funcall convert (elt lisp-vector j)))
+    :finally (return pointer)))
+
+(defun foreign-vector-copy-to (pointer ctype size lisp-vector
+                               &key (convert (function identity))
+                                 (startf 0) (startl 0) (endl (length lisp-vector)))
+  "Copies SIZE elements from the foreign vector of CTYPE at POINTER
+offset by STARTF, to the lisp subsequence: LISP-VECTOR STARTL ENDL,
+each element being transformed by the CONVERT function.
+Returns the destination LISP-VECTOR."
+  (loop
+    :repeat size
+    :for i :from startf
+    :for j :from startl :below endl
+    :do (setf (elt lisp-vector j) (funcall convert (mem-aref pointer ctype i)))
+    :finally (return lisp-vector)))
+
+(defun foreign-vector (pointer ctype ltype size)
+  (foreign-vector-copy-to pointer ctype size (make-array size :element-type ltype)))
+
+(defun foreign-null-terminated-vector-length (pointer ctype)
+  (loop
+    :for i :from 0
+    :until (zerop (mem-aref pointer ctype i))
+    :finally (return i)))
+
+(defun foreign-null-terminated-vector (pointer ctype ltype size &key (convert (function identity)))
+  (let ((len (foreign-null-terminated-vector-length pointer ctype)))
+    (foreign-vector-copy-to pointer ctype len (make-array len :element-type ltype) :convert convert)))
+
+
+(defvar *dump-prefix* "")
+(defun dump (pointer size &key print-characters)
+  (let ((*print-circle* nil))
+    (loop
+      :for i :from 0 :by 16
+      :while (< i size)
+      :do (format t "~&~A~16,'0X: " *dump-prefix* (+ i (cffi:pointer-address pointer)))
+          (loop
+            :repeat 16
+            :for j :from i
+            :if (< j size)
+              :do (format t "~2,'0X " (cffi:mem-aref pointer :uint8 j))
+            :else
+              :do (write-string "   "))
+          (when print-characters
+           (loop
+             :repeat 16
+             :for j :from i
+             :if (< j size)
+               :do  (format t "~C" (let ((code (cffi:mem-aref pointer :uint8 j)))
+                                     (if (<= 32 code 126)
+                                         (code-char code)
+                                         #\.)))
+             :else
+               :do (write-string " "))))
+    :finally (terpri)))
+
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/com.informatimago.clext.pkcs11.asd b/clext/pkcs11/com.informatimago.clext.pkcs11.asd
new file mode 100644
index 0000000..a6b741b
--- /dev/null
+++ b/clext/pkcs11/com.informatimago.clext.pkcs11.asd
@@ -0,0 +1,47 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.clext.pkcs11.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Lispy interface over Cryptoki pkcs11 version 2.02
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2018-09-23 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2018 - 2018
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(asdf:defsystem "com.informatimago.clext.pkcs11"
+  :description "PKCS11 wrapper."
+  :author "Pascal J. Bourguignon"
+  :version "0.0.0"
+  :license "AGPL3"
+  :depends-on ("cffi" "babel" "asinine")
+  :components ((:file "pkcs11-cffi" :depends-on ())
+               (:file "cffi-utils"  :depends-on ())
+               (:file "cffi-debug"  :depends-on ())
+               (:file "pkcs11"      :depends-on ("pkcs11-cffi" "cffi-utils" "cffi-debug")))
+  #+adsf3 :in-order-to #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.clext.pkcs11.tests"))))
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/com.informatimago.clext.pkcs11.tests.asd b/clext/pkcs11/com.informatimago.clext.pkcs11.tests.asd
new file mode 100644
index 0000000..d0f3856
--- /dev/null
+++ b/clext/pkcs11/com.informatimago.clext.pkcs11.tests.asd
@@ -0,0 +1,46 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.clext.pkcs11.tests.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    System to test the com.informatimago.clext.pkcs11 package.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2018-09-23 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2018 - 2018
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+;;;;
+
+(asdf:defsystem "com.informatimago.clext.pkcs11.tests"
+  :description "PKCS11 wrapper tests."
+  :author "Pascal J. Bourguignon"
+  :version "0.0.0"
+  :license "AGPL3"
+  :depends-on ("com.informatimago.clext.pkcs11"
+               "com.informatimago.common-lisp.interactive")
+  :components ((:file "tests"       :depends-on ("pkcs11"))
+               (:file "debug"       :depends-on ("pkcs11"))))
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/commands.sh b/clext/pkcs11/commands.sh
new file mode 100644
index 0000000..e217eb1
--- /dev/null
+++ b/clext/pkcs11/commands.sh
@@ -0,0 +1,198 @@
+# -*- mode:shell-script -*-
+
+pkcs11_module=/usr/local/lib/libiaspkcs11.so
+pkcs11_module=/usr/local/lib/opensc-pkcs11.so
+
+
+pkcs11-tool --module "${pkcs11_module}"  --list-objects    > objects.txt
+pkcs11-tool --module "${pkcs11_module}"  --list-slots      > slots.txt
+pkcs11-tool --module "${pkcs11_module}"  --list-mechanisms > mechanisms.txt
+
+
+pkcs11-tool --module "${pkcs11_module}" --read-object --type pubkey --id e828bd080fd2500000104d494f4300010101 > 'Clé d'\''authentification1.public.der'
+pkcs11-tool --module "${pkcs11_module}" --read-object --type pubkey --id e828bd080fd2500000104d494f4300010103 > 'Clé de signature1.public.der'
+pkcs11-tool --module "${pkcs11_module}" --read-object --type cert   --id e828bd080fd2500000104d494f4300010101 > 'Clé d'\''authentification1.cert.der'
+pkcs11-tool --module "${pkcs11_module}" --read-object --type cert   --id e828bd080fd2500000104d494f4300010103 > 'Clé de signature1.cert.der'
+
+for f in *.cert.der ; do openssl x509 -in "${f}" -inform DER -out "${f/.der/.pem}" ; done
+
+
+
+pkcs11_module="/usr/local/lib/opensc-pkcs11.so"
+pkcs11_module="/usr/local/lib/libiaspkcs11.so"
+encr_key="e828bd080fd2500000104d494f4300010101"
+sign_key="e828bd080fd2500000104d494f4300010103"
+sign_mec="SHA1-RSA-PKCS"
+sign_mec="RSA-PKCS"
+
+echo "data to sign (max 100 bytes)" > "data"
+
+# prepare data with padding
+( echo -ne "\x00\x01" && for i in `seq 224`; do echo -ne "\xff"; done && echo -ne "\00" && cat "data") > "data_pad"
+
+# sign data
+pkcs11-tool --id "${sign_key}" --sign --pin "${pin}" --mechanism RSA-X-509 --module "${pkcs11_module}" < "data_pad" > "data_pad.sig"
+pkcs11-tool --id "${sign_key}" --sign                --mechanism RSA-X-509 --module "${pkcs11_module}" < "data_pad" > "data_pad.sig"
+
+# verify signature
+openssl rsautl -verify -inkey "${sign_key}.pub" -in "data_pad.sig" -pubin -raw
+
+
+
+
+
+echo "data to encrpyt should be longer, better, faster and whatever we need to hide in front of nasty eyes of the ones that should not see them. " > "data"
+
+
+# Get certificate
+pkcs11-tool -r -p "${pin}" --id "${encr_key}" --type cert --module  "${pkcs11_module}" > "${encr_key}.cert"
+pkcs11-tool -r             --id "${encr_key}" --type cert --module  "${pkcs11_module}" > "${encr_key}.cert"
+
+# convert certificate to pem:
+openssl x509 -inform DER -in "${encr_key}.cert" -pubkey > "${encr_key}.pub"
+
+
+
+
+
+
+
+
+
+
+
+
+# Sign/Verify using private key/certificate
+
+# Create a "data" to sign
+
+echo "data to sign (max 100 bytes)" > "data"
+
+# Get the certificate from the card:
+
+pkcs11-tool -r -p "${pin}" --id "${sign_key}" --type cert --module "${pkcs11_module}" > "${sign_key}.cert"
+
+# Convert it to the public key (PEM format)
+
+openssl x509 -inform DER -in "${sign_key}.cert" -pubkey > "${sign_key}.pub"
+
+# or
+
+# Get the public key from the card:
+
+pkcs11-tool -r -p "${pin}" --id "${sign_key}" --type pubkey --module "${pkcs11_module}" > "${sign_key}.der"
+
+# Convert it to PEM format:
+
+openssl rsa -inform DER -outform PEM -in "${sign_key}.der" -pubin > "${sign_key}.pub"
+
+## RSA-PKCS
+
+# Sign the "data" on the smartcard using private key:
+
+cat "data" | pkcs11-tool --id "${sign_key}" -s -p "${pin}" -m RSA-PKCS --module "${pkcs11_module}" > "data.sig"
+
+#Verify
+
+openssl rsautl -verify -inkey "${sign_key}.pub" -in "data.sig" -pubin
+
+## SHA1-RSA-PKCS
+
+# Sign the "data" on the smartcard using private key:
+
+cat "data" | pkcs11-tool --id "${sign_key}" -s -p "${pin}" -m SHA1-RSA-PKCS --module "${pkcs11_module}" > "data.sig"
+
+# Verify and parse the returned ASN1 structure:
+
+openssl rsautl -verify -inkey "${sign_key}.pub" -in "data.sig" -pubin | openssl asn1parse -inform DER
+
+# Compare the result with the sha1 sum of the input file:
+
+sha1sum "data"
+
+# Similarily can be tested the SHA256, SHA384 and SHA512, just by replacing SHA1 with these hashes in above commands.
+
+## SHA1-RSA-PKCS-PSS
+
+# Sign the "data" on the smartcard using private key:
+
+cat "data" | pkcs11-tool --id "${sign_key}" -s -p "${pin}" -m SHA1-RSA-PKCS-PSS --module "${pkcs11_module}" > "data.sig"
+
+# Verify
+
+openssl dgst -keyform DER -verify "${sign_key}.pub" -sha1 -sigopt rsa_padding_mode:pss -sigopt rsa_pss_saltlen:-1 -signature "data.sig" "data"
+
+# For other parameters, replace the hash algorithsm, add a `--salt-len` parameter for the `pkcs11-tool` and adjust `rsa_pss_saltlen` argument of `openssl`.
+
+## RSA-X-509
+
+# Prepare "data" with padding:
+
+(echo -ne "\x00\x01" && for i in `seq 224`; do echo -ne "\xff"; done && echo -ne "\00" && cat "data") > "data_pad"
+
+# Sign the "data" on the smartcard using private key:
+
+pkcs11-tool --id "${sign_key}" -s -p "${pin}" -m RSA-X-509 --module "${pkcs11_module}" <  "data_pad" > "data_pad.sig"
+
+# Verify
+
+openssl rsautl -verify -inkey "${sign_key}.pub" -in "data_pad.sig" -pubin -raw
+
+
+# Encrypt/Decrypt using private key/certificate
+
+# Create a "data" to encrypt
+
+echo "data to encrpyt should be longer, better, faster and whatever we need to hide in front of nasty eyes of the ones that should not see them. " > "data"
+
+# Get the certificate from the card:
+
+pkcs11-tool -r -p "${pin}" --id "${encr_key} "--type cert --module "${pkcs11_module}" > "${encr_key}.cert"
+
+# Convert it to the public key (PEM format)
+
+openssl x509 -inform DER -in "${encr_key}.cert" -pubkey > "${encr_key}.pub"
+
+## RSA-PKCS
+
+# Encrypt the "data" locally
+
+openssl rsautl -encrypt -inkey "${encr_key}.pub" -in "data" -pubin -out "data.crypt"
+
+# Decrypt the "data" on the card
+
+pkcs11-tool --id "${encr_key} "--decrypt -p "${pin}" -m RSA-PKCS --module "${pkcs11_module}" <  "data.crypt"
+
+## RSA-X-509
+
+# Prepare "data" with padding:
+
+(echo -ne "\x00\x02" && for i in `seq 113`; do echo -ne "\xff"; done && echo -ne "\00" && cat "data") > "data_pad"
+
+# Encrypt the "data" locally
+
+openssl rsautl -encrypt -inkey "${encr_key}.pub" -in "data_pad" -pubin -out "data_pad.crypt" -raw
+
+# Decrypt the "data" on the card
+
+pkcs11-tool --id "${encr_key} "--decrypt -p "${pin}" -m RSA-X-509 --module "${pkcs11_module}" < "data_pad.crypt"
+
+## RSA-PKCS-OAEP
+
+# Encrypt the "data" locally
+
+openssl rsautl -encrypt -inkey "${encr_key}.pub" -in "data" -pubin -out "data.crypt" -oaep
+
+#   or
+
+openssl pkeyutl -encrypt -inkey "${encr_key}.pub" -pubin -pkeyopt rsa_padding_mode:oaep -pkeyopt rsa_oaep_md:sha256 -pkeyopt rsa_mgf1_md:sha256 -in "data" -out "data.sha256.crypt"
+
+# Decrypt the "data" on the card
+
+pkcs11-tool --id "${encr_key} "--decrypt -p "${pin}" -m RSA-PKCS-OAEP --module "${pkcs11_module}" < "data.crypt"
+
+#    or
+
+pkcs11-tool --id "${encr_key} "--decrypt -p "${pin}" -m RSA-PKCS-OAEP --hash-algorithm=sha256  --module "${pkcs11_module}" < "data.sha256.crypt"
+
+
diff --git a/clext/pkcs11/debug.lisp b/clext/pkcs11/debug.lisp
new file mode 100644
index 0000000..c719966
--- /dev/null
+++ b/clext/pkcs11/debug.lisp
@@ -0,0 +1,57 @@
+(in-package "COM.INFORMATIMAGO.CLEXT.PKCS11")
+
+(defvar *dump-prefix* "")
+(defun dump-vector (vector &key print-characters)
+  (let ((*print-circle* nil)
+        (size (length vector)))
+    (loop
+      :for i :from 0 :by 16
+      :while (< i size)
+      :do (format t "~&~A~16,'0X: " *dump-prefix* i)
+          (loop
+            :repeat 16
+            :for j :from i
+            :if (< j size)
+              :do (format t "~2,'0X " (aref vector j))
+            :else
+              :do (write-string "   "))
+          (when print-characters
+           (loop
+             :repeat 16
+             :for j :from i
+             :if (< j size)
+               :do  (format t "~C" (let ((code (aref vector j)))
+                                     (if (<= 32 code 126)
+                                         (code-char code)
+                                         #\.)))
+             :else
+               :do (write-string " "))))
+    :finally (terpri)))
+
+             ;; (print (list :ok) *trace-output*) (finish-output *trace-output*)
+             ;; (let ((*template* template))
+             ;;   (declare (special *template*))
+             ;;   (proclaim '(special *template*))
+             ;;   (com.informatimago.common-lisp.interactive.interactive:repl))
+
+                 ;; (print '(:attribute-sensitive :attribute-type-invalid :buffer-too-small) *trace-output*)
+                 ;; (print (list 'get-attribute-value  (list 'template-decode template)) *trace-output*)
+                 ;; (finish-output *trace-output*)
+                 ;; (let ((*template* template)
+                 ;;       (*error* err))
+                 ;;   (declare (special *template* *error*))
+                 ;;   (proclaim '(special *template* *error*))
+;;   (com.informatimago.common-lisp.interactive.interactive:repl))
+
+(defun resume ()
+  (com.informatimago.common-lisp.interactive.interactive:repl-exit))
+
+(defun pause (bindings message &rest arguments)
+  (format t "~&~?~%" message arguments)
+  (format t "Type (resume) to resume.~%")
+  (progv
+      (mapcar (function first)  bindings)
+      (mapcar (function second) bindings)
+    (com.informatimago.common-lisp.interactive.interactive:repl)))
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/loader.lisp b/clext/pkcs11/loader.lisp
new file mode 100644
index 0000000..be04c74
--- /dev/null
+++ b/clext/pkcs11/loader.lisp
@@ -0,0 +1,3 @@
+;; (push #P"~/src/public/test/pkcs11/" asdf:*central-registry*)
+(ql:quickload :com.informatimago.clext.pkcs11)
+(com.informatimago.clext.pkcs11:load-library)
diff --git a/clext/pkcs11/notes.txt b/clext/pkcs11/notes.txt
new file mode 100644
index 0000000..d9f5e89
--- /dev/null
+++ b/clext/pkcs11/notes.txt
@@ -0,0 +1,319 @@
+https://stackoverflow.com/questions/22966461/reading-an-othername-value-from-a-subjectaltname-certificate-extension?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa
+
+--------------------------------------------------------------------------------
+
+Create a self signed certificate (notice the addition of -x509 option):
+
+openssl req -config example-com.conf -new -x509 -sha256 -newkey rsa:2048 -nodes \
+    -keyout example-com.key.pem -days 365 -out example-com.cert.pem
+
+Create a signing request (notice the lack of -x509 option):
+
+openssl req -config example-com.conf -new -sha256 -newkey rsa:2048 -nodes \
+    -keyout example-com.key.pem -days 365 -out example-com.req.pem
+
+Print a self signed certificate:
+
+openssl x509 -in example-com.cert.pem -text -noout
+
+Print a signing request:
+
+openssl req -in example-com.req.pem -text -noout
+
+Configuration file (passed via -config option)
+
+[ req ]
+default_bits        = 2048
+default_keyfile     = server-key.pem
+distinguished_name  = subject
+req_extensions      = req_ext
+x509_extensions     = x509_ext
+string_mask         = utf8only
+
+# The Subject DN can be formed using X501 or RFC 4514 (see RFC 4519 for a description).
+#   Its sort of a mashup. For example, RFC 4514 does not provide emailAddress.
+[ subject ]
+countryName         = Country Name (2 letter code)
+countryName_default     = US
+
+stateOrProvinceName     = State or Province Name (full name)
+stateOrProvinceName_default = NY
+
+localityName            = Locality Name (eg, city)
+localityName_default        = New York
+
+organizationName         = Organization Name (eg, company)
+organizationName_default    = Example, LLC
+
+# Use a friendly name here because its presented to the user. The server's DNS
+#   names are placed in Subject Alternate Names. Plus, DNS names here is deprecated
+#   by both IETF and CA/Browser Forums. If you place a DNS name here, then you
+#   must include the DNS name in the SAN too (otherwise, Chrome and others that
+#   strictly follow the CA/Browser Baseline Requirements will fail).
+commonName          = Common Name (e.g. server FQDN or YOUR name)
+commonName_default      = Example Company
+
+emailAddress            = Email Address
+emailAddress_default        = test@example.com
+
+# Section x509_ext is used when generating a self-signed certificate. I.e., openssl req -x509 ...
+[ x509_ext ]
+
+subjectKeyIdentifier        = hash
+authorityKeyIdentifier  = keyid,issuer
+
+# You only need digitalSignature below. *If* you don't allow
+#   RSA Key transport (i.e., you use ephemeral cipher suites), then
+#   omit keyEncipherment because that's key transport.
+basicConstraints        = CA:FALSE
+keyUsage            = digitalSignature, keyEncipherment
+subjectAltName          = @alternate_names
+nsComment           = "OpenSSL Generated Certificate"
+
+# RFC 5280, Section 4.2.1.12 makes EKU optional
+#   CA/Browser Baseline Requirements, Appendix (B)(3)(G) makes me confused
+#   In either case, you probably only need serverAuth.
+# extendedKeyUsage  = serverAuth, clientAuth
+
+# Section req_ext is used when generating a certificate signing request. I.e., openssl req ...
+[ req_ext ]
+
+subjectKeyIdentifier        = hash
+
+basicConstraints        = CA:FALSE
+keyUsage            = digitalSignature, keyEncipherment
+subjectAltName          = @alternate_names
+nsComment           = "OpenSSL Generated Certificate"
+
+# RFC 5280, Section 4.2.1.12 makes EKU optional
+#   CA/Browser Baseline Requirements, Appendix (B)(3)(G) makes me confused
+#   In either case, you probably only need serverAuth.
+# extendedKeyUsage  = serverAuth, clientAuth
+
+[ alternate_names ]
+
+DNS.1       = example.com
+DNS.2       = www.example.com
+DNS.3       = mail.example.com
+DNS.4       = ftp.example.com
+
+# Add these if you need them. But usually you don't want them or
+#   need them in production. You may need them for development.
+# DNS.5       = localhost
+# DNS.6       = localhost.localdomain
+# DNS.7       = 127.0.0.1
+
+# IPv6 localhost
+# DNS.8     = ::1
+
+
+
+--------------------------------------------------------------------------------
+
+This is Google's cache of http://unmitigatedrisk.com/?p=247
+It is a snapshot of the page as it appeared on 22 Apr 2018 16:27:52 GMT. The current page could have changed in the meantime. Learn more.
+Full versionText-only versionView source
+
+Tip: To quickly find your search term on this page, press Ctrl+F or ⌘-F (Mac) and use the find bar.
+UNMITIGATED RISK
+un.mit.i.gat.ed: Adj. Not diminished or moderated in intensity or severity; unrelieved. risk: N. The possibiity of suffering harm or loss; danger.
+Skip to content
+
+    Home
+    About
+
+Making a Windows smartcard login certificate with OpenSSL.
+4 Replies
+
+I use OpenSSL for testing certificate related stuff all the time, while using its test clients as a administrative tool can require contortions sometimes it’s very useful thing to have in my toolbox.
+
+Today I needed to throw together a certificate for Windows smartcard login, a valid Windows Smart Card Login certificate has the following attributes:
+
+    Is issued by an CA that is trusted as an Enterprise CA
+    Is issued by a CA that has the “Smartcard Logon” EKU (1.3.6.1.4.1.311.20.2.2)
+    Has the “Smartcard Logon” EKU
+    Has the “Digital Signature” “Key Usage”
+    Has the principal name of the subscriber in the SubjectAltName extension as a UPN (1.3.6.1.4.1.311.20.2.3)
+
+With that background how does one do this in OpenSSL? Well lets focus on the last 3 (3,4,5) as they are about the subscriber certificate.
+
+To create this certificate you would create an OpenSSL section that looks something like this:
+
+[ v3_logon_cert ]
+
+# Typical end-user certificate profile
+
+
+
+keyUsage = critical, nonRepudiation, digitalSignature, keyEncipherment
+
+extendedKeyUsage = critical, clientAuth, emailProtection, msSmartcardLogin
+
+basicConstraints = critical, CA:FALSE
+
+
+
+subjectKeyIdentifier = hash
+
+authorityKeyIdentifier = keyid,issuer
+
+
+
+authorityInfoAccess = @customerca_aia
+
+
+
+subjectAltName = otherName:msUPN;UTF8:[email protected], email:[email protected]
+
+
+
+certificatePolicies=ia5org,@rootca_polsect
+
+There are a few other “reference” sections you can find the INF file I used these additions with in my script for testing Qualified Subordination.
+
+Hope this helps you too,
+
+Ryan
+This entry was posted in Security and tagged OpenSSL, Smartcard Logon, Smartcards on November 20, 2012 by rmhrisk.
+Post navigation
+← Using CAPICOM on Windows x64 How Facebook can avoid losing $100M in revenue when they switch to always-on SSL →
+4 thoughts on “Making a Windows smartcard login certificate with OpenSSL.”
+
+    rmhrisk Post authorNovember 21, 2012 at 12:01 pm
+
+    From Erwann :
+
+    For more clarity, I’d replace the “1.3.6.1.4.1.311.20.2.2” by “msSmartcardLogin” in the extendedKeyUsage list, and the “1.3.6.1.4.1.311.20.2.3” by “msUPN” in the subjectAltName declaration.
+
+    I also usually write the subjectAltName like this:
+    subjectAltName = otherName:msUPN;UTF8:$ENV::UPN, email:$ENV::UPN
+
+    Before calling the certificate creation script, just add an environment variable named UPN.
+    The main drawback I found is that when the config file is loaded, even if the section containing the extension isn’t used (v3_logon_cert here), the $ENV::UPN is evaluated and must not fail, therefore the UPN environment variable MUST exist (just set a dummy value).
+    Reply ↓
+    rmhrisk Post authorNovember 21, 2012 at 12:04 pm
+
+    Based on Erwann’s comment Iused the two variables vs using the explicit OIDs I did not know OpenSSL had these configured. I did not include the $ENV approach as my script isnt doing this uniformly at this time.
+    Reply ↓
+    Gabi February 16, 2016 at 5:15 am
+
+    Hello,
+
+    I want to create a self signed certificate with openssl and contain the principal name(1.3.6.1.4.1.311.20.2.3).
+
+    Using the steps from here it fails to accept the certificate on my apache server. It fail with
+    Certificate Verification: Error (18): self signed certificate
+    SL Library Error: error:14089086:SSL routines:ssl3_get_client_certificate:certificate verify failed
+
+    Any suggestions?
+    Gabi
+    Reply ↓
+        rmhrisk Post authorFebruary 16, 2016 at 9:12 am
+
+        Gabi, you will have to configure apache to trust your self-signed certificate like it was a CA. See : http://www.cafesoft.com/products/cams/ps/docs32/admin/ConfiguringApache2ForSSLTLSMutualAuthentication.html
+        Reply ↓
+
+Leave a Reply
+
+Your email address will not be published. Required fields are marked *
+
+Comment
+
+Name *
+
+Email *
+
+Website
+
+Recent Posts
+
+    Risk variance and managing risk
+    The Evolution of Security Thinking
+    Positive Trust Indicators and SSL
+    Let’s talk about revocation checking, let’s talk about you and me.
+    My response, to his response, to my response? or short-lived certificates part 3
+
+Recent Comments
+
+    rmhrisk on Understanding Windows Automatic Root Update
+    Ken on Understanding Windows Automatic Root Update
+    Ken on Understanding Windows Automatic Root Update
+    Melih on Positive Trust Indicators and SSL
+    rmhrisk on Positive Trust Indicators and SSL
+
+Archives
+
+    March 2018
+    July 2017
+    May 2017
+    April 2017
+    March 2017
+    May 2016
+    January 2016
+    December 2015
+    November 2015
+    October 2015
+    September 2015
+    August 2015
+    July 2015
+    June 2015
+    May 2015
+    October 2014
+    September 2014
+    August 2014
+    July 2014
+    June 2014
+    May 2014
+    April 2014
+    October 2013
+    September 2013
+    August 2013
+    July 2013
+    June 2013
+    May 2013
+    April 2013
+    March 2013
+    February 2013
+    December 2012
+    November 2012
+    October 2012
+    September 2012
+    August 2012
+    July 2012
+    June 2012
+    May 2012
+    April 2012
+    March 2012
+    February 2012
+    January 2012
+    August 2011
+    May 2010
+    April 2010
+    November 2008
+    August 2007
+    April 2007
+    December 2006
+
+Tags
+Best Practices Biometrics bitcoin CA CAB Forum Certificates Chrome CRL CryptoAPI Cryptography Digital Signatures ecc Fingerprints IIS Internet Explorer Javascript Jobs key management Microsoft Mozilla My story Name Constraints Nginx OCSP OCSP Stapling OpenSSL Opera Performance PKI pki.js pkijs Programming Qualified Subordination REVOCATION Revocation Checking Safari Security short-lived certificates Smart Cards Smartcards SSL Standards TLS UX X509
+Blogroll
+
+    Bruce Schneier
+    Dan Kaminsky
+    ImperialViolet
+    Ivan Ristic
+    Netsekure
+    Random Oracle
+    Secure By Default
+    WSJ Law Blog
+
+Resources
+
+    OpenSSL
+    OpenSSL for Win32
+    Privacy Score
+    SSL Labs
+    SSL Pulse
+    SSLYze
+
+Proudly powered by WordPress
diff --git a/clext/pkcs11/pkcs11-cffi.lisp b/clext/pkcs11/pkcs11-cffi.lisp
new file mode 100644
index 0000000..b7cde41
--- /dev/null
+++ b/clext/pkcs11/pkcs11-cffi.lisp
@@ -0,0 +1,1177 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               pkcs11-cffi.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    XXX
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2018-04-18 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2018 - 2018
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.PKCS11.LOW"
+  (:use "COMMON-LISP" "CFFI")
+  (:nicknames "%CK")
+  (:export "LOAD-LIBRARY")
+  (:export "INITIALIZE" "FINALIZE" "GET-INFO" "GET-SLOT-LIST"
+           "GET-SLOT-INFO" "GET-TOKEN-INFO" "WAIT-FOR-SLOT-EVENT"
+           "GET-MECHANISM-LIST" "GET-MECHANISM-INFO" "INIT-TOKEN" "INIT-PIN"
+           "SET-PIN" "OPEN-SESSION" "CLOSE-SESSION" "CLOSE-ALL-SESSIONS"
+           "GET-SESSION-INFO" "GET-OPERATION-STATE" "SET-OPERATION-STATE"
+           "LOGIN" "LOGOUT" "CREATE-OBJECT" "COPY-OBJECT" "DESTROY-OBJECT"
+           "GET-OBJECT-SIZE" "GET-ATTRIBUTE-VALUE" "SET-ATTRIBUTE-VALUE"
+           "FIND-OBJECTS-INIT" "FIND-OBJECTS" "FIND-OBJECTS-FINAL"
+           "ENCRYPT-INIT" "ENCRYPT" "ENCRYPT-UPDATE" "ENCRYPT-FINAL"
+           "DECRYPT-INIT" "DECRYPT" "DECRYPT-UPDATE" "DECRYPT-FINAL"
+           "DIGEST-INIT" "DIGEST" "DIGEST-UPDATE" "DIGEST-KEY" "DIGEST-FINAL"
+           "SIGN-INIT" "SIGN" "SIGN-UPDATE" "SIGN-FINAL" "SIGN-RECOVER-INIT"
+           "SIGN-RECOVER" "VERIFY-INIT" "VERIFY" "VERIFY-UPDATE" "VERIFY-FINAL"
+           "VERIFY-RECOVER-INIT" "VERIFY-RECOVER" "DIGEST-ENCRYPT-UPDATE"
+           "DECRYPT-DIGEST-UPDATE" "SIGN-ENCRYPT-UPDATE"
+           "DECRYPT-VERIFY-UPDATE" "GENERATE-KEY" "GENERATE-KEY-PAIR"
+           "WRAP-KEY" "UNWRAP-KEY" "DERIVE-KEY" "SEED-RANDOM" "GENERATE-RANDOM"
+           "GET-FUNCTION-STATUS" "CANCEL-FUNCTION")
+
+  (:export "+TRUE+" "+FALSE+"
+           "+SURRENDER+" "+TOKEN-PRESENT+" "+REMOVABLE-DEVICE+"
+           "+HW-SLOT+" "+ARRAY-ATTRIBUTE+" "+RNG+" "+WRITE-PROTECTED+"
+           "+LOGIN-REQUIRED+" "+USER-PIN-INITIALIZED+" "+RESTORE-KEY-NOT-NEEDED+"
+           "+CLOCK-ON-TOKEN+" "+PROTECTED-AUTHENTICATION-PATH+"
+           "+DUAL-CRYPTO-OPERATIONS+" "+TOKEN-INITIALIZED+"
+           "+SECONDARY-AUTHENTICATION+" "+USER-PIN-COUNT-LOW+"
+           "+USER-PIN-FINAL-TRY+" "+USER-PIN-LOCKED+" "+USER-PIN-TO-BE-CHANGED+"
+           "+SO-PIN-COUNT-LOW+" "+SO-PIN-FINAL-TRY+" "+SO-PIN-LOCKED+"
+           "+SO-PIN-TO-BE-CHANGED+" "+UNAVAILABLE-INFORMATION+"
+           "+EFFECTIVELY-INFINITE+" "+INVALID-HANDLE+" "+SO+" "+USER+"
+           "+CONTEXT-SPECIFIC+" "+RO-PUBLIC-SESSION+" "+RO-USER-FUNCTIONS+"
+           "+RW-PUBLIC-SESSION+" "+RW-USER-FUNCTIONS+" "+RW-SO-FUNCTIONS+"
+           "+RW-SESSION+" "+SERIAL-SESSION+" "+O-DATA+" "+O-CERTIFICATE+"
+           "+O-PUBLIC-KEY+" "+O-PRIVATE-KEY+" "+O-SECRET-KEY+" "+O-HW-FEATURE+"
+           "+O-DOMAIN-PARAMETERS+" "+O-MECHANISM+" "+VENDOR-DEFINED+"
+           "+H-MONOTONIC-COUNTER+" "+H-CLOCK+" "+H-USER-INTERFACE+" "+K-RSA+"
+           "+K-DSA+" "+K-DH+" "+K-ECDSA+" "+K-EC+" "+K-X9-42-DH+" "+K-KEA+"
+           "+K-GENERIC-SECRET+" "+K-RC2+" "+K-RC4+" "+K-DES+" "+K-DES2+"
+           "+K-DES3+" "+K-CAST+" "+K-CAST3+" "+K-CAST128+" "+K-RC5+" "+K-IDEA+"
+           "+K-SKIPJACK+" "+K-BATON+" "+K-JUNIPER+" "+K-CDMF+" "+K-AES+"
+           "+K-BLOWFISH+" "+K-TWOFISH+" "+C-X-509+" "+C-X-509-ATTR-CERT+"
+           "+C-WTLS+" "+A-CLASS+" "+A-TOKEN+" "+A-PRIVATE+" "+A-LABEL+"
+           "+A-APPLICATION+" "+A-VALUE+" "+A-OBJECT-ID+" "+A-CERTIFICATE-TYPE+"
+           "+A-ISSUER+" "+A-SERIAL-NUMBER+" "+A-AC-ISSUER+" "+A-OWNER+"
+           "+A-ATTR-TYPES+" "+A-TRUSTED+" "+A-CERTIFICATE-CATEGORY+"
+           "+A-JAVA-MIDP-SECURITY-DOMAIN+" "+A-URL+"
+           "+A-HASH-OF-SUBJECT-PUBLIC-KEY+" "+A-HASH-OF-ISSUER-PUBLIC-KEY+"
+           "+A-CHECK-VALUE+" "+A-KEY-TYPE+" "+A-SUBJECT+" "+A-ID+"
+           "+A-SENSITIVE+" "+A-ENCRYPT+" "+A-DECRYPT+" "+A-WRAP+" "+A-UNWRAP+"
+           "+A-SIGN+" "+A-SIGN-RECOVER+" "+A-VERIFY+" "+A-VERIFY-RECOVER+"
+           "+A-DERIVE+" "+A-START-DATE+" "+A-END-DATE+" "+A-MODULUS+"
+           "+A-MODULUS-BITS+" "+A-PUBLIC-EXPONENT+" "+A-PRIVATE-EXPONENT+"
+           "+A-PRIME-1+" "+A-PRIME-2+" "+A-EXPONENT-1+" "+A-EXPONENT-2+"
+           "+A-COEFFICIENT+" "+A-PRIME+" "+A-SUBPRIME+" "+A-BASE+"
+           "+A-PRIME-BITS+" "+A-SUB-PRIME-BITS+" "+A-VALUE-BITS+" "+A-VALUE-LEN+"
+           "+A-EXTRACTABLE+" "+A-LOCAL+" "+A-NEVER-EXTRACTABLE+"
+           "+A-ALWAYS-SENSITIVE+" "+A-KEY-GEN-MECHANISM+" "+A-MODIFIABLE+"
+           "+A-ECDSA-PARAMS+" "+A-EC-PARAMS+" "+A-EC-POINT+" "+A-SECONDARY-AUTH+"
+           "+A-AUTH-PIN-FLAGS+" "+A-ALWAYS-AUTHENTICATE+" "+A-WRAP-WITH-TRUSTED+"
+           "+A-HW-FEATURE-TYPE+" "+A-RESET-ON-INIT+" "+A-HAS-RESET+"
+           "+A-PIXEL-X+" "+A-PIXEL-Y+" "+A-RESOLUTION+" "+A-CHAR-ROWS+"
+           "+A-CHAR-COLUMNS+" "+A-COLOR+" "+A-BITS-PER-PIXEL+" "+A-CHAR-SETS+"
+           "+A-ENCODING-METHODS+" "+A-MIME-TYPES+" "+A-MECHANISM-TYPE+"
+           "+A-REQUIRED-CMS-ATTRIBUTES+" "+A-DEFAULT-CMS-ATTRIBUTES+"
+           "+A-SUPPORTED-CMS-ATTRIBUTES+" "+A-WRAP-TEMPLATE+"
+           "+A-UNWRAP-TEMPLATE+" "+A-ALLOWED-MECHANISMS+"
+           "+M-RSA-PKCS-KEY-PAIR-GEN+" "+M-RSA-PKCS+" "+M-RSA-9796+"
+           "+M-RSA-X-509+" "+M-MD2-RSA-PKCS+" "+M-MD5-RSA-PKCS+"
+           "+M-SHA1-RSA-PKCS+" "+M-RIPEMD128-RSA-PKCS+" "+M-RIPEMD160-RSA-PKCS+"
+           "+M-RSA-PKCS-OAEP+" "+M-RSA-X9-31-KEY-PAIR-GEN+" "+M-RSA-X9-31+"
+           "+M-SHA1-RSA-X9-31+" "+M-RSA-PKCS-PSS+" "+M-SHA1-RSA-PKCS-PSS+"
+           "+M-DSA-KEY-PAIR-GEN+" "+M-DSA+" "+M-DSA-SHA1+"
+           "+M-DH-PKCS-KEY-PAIR-GEN+" "+M-DH-PKCS-DERIVE+"
+           "+M-X9-42-DH-KEY-PAIR-GEN+" "+M-X9-42-DH-DERIVE+"
+           "+M-X9-42-DH-HYBRID-DERIVE+" "+M-X9-42-MQV-DERIVE+"
+           "+M-SHA256-RSA-PKCS+" "+M-SHA384-RSA-PKCS+" "+M-SHA512-RSA-PKCS+"
+           "+M-SHA256-RSA-PKCS-PSS+" "+M-SHA384-RSA-PKCS-PSS+"
+           "+M-SHA512-RSA-PKCS-PSS+" "+M-RC2-KEY-GEN+" "+M-RC2-ECB+"
+           "+M-RC2-CBC+" "+M-RC2-MAC+" "+M-RC2-MAC-GENERAL+" "+M-RC2-CBC-PAD+"
+           "+M-RC4-KEY-GEN+" "+M-RC4+" "+M-DES-KEY-GEN+" "+M-DES-ECB+"
+           "+M-DES-CBC+" "+M-DES-MAC+" "+M-DES-MAC-GENERAL+" "+M-DES-CBC-PAD+"
+           "+M-DES2-KEY-GEN+" "+M-DES3-KEY-GEN+" "+M-DES3-ECB+" "+M-DES3-CBC+"
+           "+M-DES3-MAC+" "+M-DES3-MAC-GENERAL+" "+M-DES3-CBC-PAD+"
+           "+M-CDMF-KEY-GEN+" "+M-CDMF-ECB+" "+M-CDMF-CBC+" "+M-CDMF-MAC+"
+           "+M-CDMF-MAC-GENERAL+" "+M-CDMF-CBC-PAD+" "+M-MD2+" "+M-MD2-HMAC+"
+           "+M-MD2-HMAC-GENERAL+" "+M-MD5+" "+M-MD5-HMAC+" "+M-MD5-HMAC-GENERAL+"
+           "+M-SHA-1+" "+M-SHA-1-HMAC+" "+M-SHA-1-HMAC-GENERAL+" "+M-RIPEMD128+"
+           "+M-RIPEMD128-HMAC+" "+M-RIPEMD128-HMAC-GENERAL+" "+M-RIPEMD160+"
+           "+M-RIPEMD160-HMAC+" "+M-RIPEMD160-HMAC-GENERAL+" "+M-SHA256+"
+           "+M-SHA256-HMAC+" "+M-SHA256-HMAC-GENERAL+" "+M-SHA384+"
+           "+M-SHA384-HMAC+" "+M-SHA384-HMAC-GENERAL+" "+M-SHA512+"
+           "+M-SHA512-HMAC+" "+M-SHA512-HMAC-GENERAL+" "+M-CAST-KEY-GEN+"
+           "+M-CAST-ECB+" "+M-CAST-CBC+" "+M-CAST-MAC+" "+M-CAST-MAC-GENERAL+"
+           "+M-CAST-CBC-PAD+" "+M-CAST3-KEY-GEN+" "+M-CAST3-ECB+" "+M-CAST3-CBC+"
+           "+M-CAST3-MAC+" "+M-CAST3-MAC-GENERAL+" "+M-CAST3-CBC-PAD+"
+           "+M-CAST5-KEY-GEN+" "+M-CAST128-KEY-GEN+" "+M-CAST5-ECB+"
+           "+M-CAST128-ECB+" "+M-CAST5-CBC+" "+M-CAST128-CBC+" "+M-CAST5-MAC+"
+           "+M-CAST128-MAC+" "+M-CAST5-MAC-GENERAL+" "+M-CAST128-MAC-GENERAL+"
+           "+M-CAST5-CBC-PAD+" "+M-CAST128-CBC-PAD+" "+M-RC5-KEY-GEN+"
+           "+M-RC5-ECB+" "+M-RC5-CBC+" "+M-RC5-MAC+" "+M-RC5-MAC-GENERAL+"
+           "+M-RC5-CBC-PAD+" "+M-IDEA-KEY-GEN+" "+M-IDEA-ECB+" "+M-IDEA-CBC+"
+           "+M-IDEA-MAC+" "+M-IDEA-MAC-GENERAL+" "+M-IDEA-CBC-PAD+"
+           "+M-GENERIC-SECRET-KEY-GEN+" "+M-CONCATENATE-BASE-AND-KEY+"
+           "+M-CONCATENATE-BASE-AND-DATA+" "+M-CONCATENATE-DATA-AND-BASE+"
+           "+M-XOR-BASE-AND-DATA+" "+M-EXTRACT-KEY-FROM-KEY+"
+           "+M-SSL3-PRE-MASTER-KEY-GEN+" "+M-SSL3-MASTER-KEY-DERIVE+"
+           "+M-SSL3-KEY-AND-MAC-DERIVE+" "+M-SSL3-MASTER-KEY-DERIVE-DH+"
+           "+M-TLS-PRE-MASTER-KEY-GEN+" "+M-TLS-MASTER-KEY-DERIVE+"
+           "+M-TLS-KEY-AND-MAC-DERIVE+" "+M-TLS-MASTER-KEY-DERIVE-DH+"
+           "+M-SSL3-MD5-MAC+" "+M-SSL3-SHA1-MAC+" "+M-MD5-KEY-DERIVATION+"
+           "+M-MD2-KEY-DERIVATION+" "+M-SHA1-KEY-DERIVATION+"
+           "+M-PBE-MD2-DES-CBC+" "+M-PBE-MD5-DES-CBC+" "+M-PBE-MD5-CAST-CBC+"
+           "+M-PBE-MD5-CAST3-CBC+" "+M-PBE-MD5-CAST5-CBC+"
+           "+M-PBE-MD5-CAST128-CBC+" "+M-PBE-SHA1-CAST5-CBC+"
+           "+M-PBE-SHA1-CAST128-CBC+" "+M-PBE-SHA1-RC4-128+"
+           "+M-PBE-SHA1-RC4-40+" "+M-PBE-SHA1-DES3-EDE-CBC+"
+           "+M-PBE-SHA1-DES2-EDE-CBC+" "+M-PBE-SHA1-RC2-128-CBC+"
+           "+M-PBE-SHA1-RC2-40-CBC+" "+M-PKCS5-PBKD2+"
+           "+M-PBA-SHA1-WITH-SHA1-HMAC+" "+M-KEY-WRAP-LYNKS+"
+           "+M-KEY-WRAP-SET-OAEP+" "+M-SKIPJACK-KEY-GEN+" "+M-SKIPJACK-ECB64+"
+           "+M-SKIPJACK-CBC64+" "+M-SKIPJACK-OFB64+" "+M-SKIPJACK-CFB64+"
+           "+M-SKIPJACK-CFB32+" "+M-SKIPJACK-CFB16+" "+M-SKIPJACK-CFB8+"
+           "+M-SKIPJACK-WRAP+" "+M-SKIPJACK-PRIVATE-WRAP+" "+M-SKIPJACK-RELAYX+"
+           "+M-KEA-KEY-PAIR-GEN+" "+M-KEA-KEY-DERIVE+" "+M-FORTEZZA-TIMESTAMP+"
+           "+M-BATON-KEY-GEN+" "+M-BATON-ECB128+" "+M-BATON-ECB96+"
+           "+M-BATON-CBC128+" "+M-BATON-COUNTER+" "+M-BATON-SHUFFLE+"
+           "+M-BATON-WRAP+" "+M-ECDSA-KEY-PAIR-GEN+" "+M-EC-KEY-PAIR-GEN+"
+           "+M-ECDSA+" "+M-ECDSA-SHA1+" "+M-ECDH1-DERIVE+"
+           "+M-ECDH1-COFACTOR-DERIVE+" "+M-ECMQV-DERIVE+" "+M-JUNIPER-KEY-GEN+"
+           "+M-JUNIPER-ECB128+" "+M-JUNIPER-CBC128+" "+M-JUNIPER-COUNTER+"
+           "+M-JUNIPER-SHUFFLE+" "+M-JUNIPER-WRAP+" "+M-FASTHASH+"
+           "+M-AES-KEY-GEN+" "+M-AES-ECB+" "+M-AES-CBC+" "+M-AES-MAC+"
+           "+M-AES-MAC-GENERAL+" "+M-AES-CBC-PAD+" "+M-DSA-PARAMETER-GEN+"
+           "+M-DH-PKCS-PARAMETER-GEN+" "+M-X9-42-DH-PARAMETER-GEN+" "+F-HW+"
+           "+F-ENCRYPT+" "+F-DECRYPT+" "+F-DIGEST+" "+F-SIGN+" "+F-SIGN-RECOVER+"
+           "+F-VERIFY+" "+F-VERIFY-RECOVER+" "+F-GENERATE+"
+           "+F-GENERATE-KEY-PAIR+" "+F-WRAP+" "+F-UNWRAP+" "+F-DERIVE+"
+           "+F-EXTENSION+" "+DONT-BLOCK+")
+
+  (:export "+OK+" "+CANCEL+" "+HOST-MEMORY+" "+SLOT-ID-INVALID+"
+           "+GENERAL-ERROR+" "+FUNCTION-FAILED+" "+ARGUMENTS-BAD+" "+NO-EVENT+"
+           "+NEED-TO-CREATE-THREADS+" "+CANT-LOCK+" "+ATTRIBUTE-READ-ONLY+"
+           "+ATTRIBUTE-SENSITIVE+" "+ATTRIBUTE-TYPE-INVALID+"
+           "+ATTRIBUTE-VALUE-INVALID+" "+DATA-INVALID+" "+DATA-LEN-RANGE+"
+           "+DEVICE-ERROR+" "+DEVICE-MEMORY+" "+DEVICE-REMOVED+"
+           "+ENCRYPTED-DATA-INVALID+" "+ENCRYPTED-DATA-LEN-RANGE+"
+           "+FUNCTION-CANCELED+" "+FUNCTION-NOT-PARALLEL+"
+           "+FUNCTION-NOT-SUPPORTED+" "+KEY-HANDLE-INVALID+" "+KEY-SIZE-RANGE+"
+           "+KEY-TYPE-INCONSISTENT+" "+KEY-NOT-NEEDED+" "+KEY-CHANGED+"
+           "+KEY-NEEDED+" "+KEY-INDIGESTIBLE+" "+KEY-FUNCTION-NOT-PERMITTED+"
+           "+KEY-NOT-WRAPPABLE+" "+KEY-UNEXTRACTABLE+" "+MECHANISM-INVALID+"
+           "+MECHANISM-PARAM-INVALID+" "+OBJECT-HANDLE-INVALID+"
+           "+OPERATION-ACTIVE+" "+OPERATION-NOT-INITIALIZED+" "+PIN-INCORRECT+"
+           "+PIN-INVALID+" "+PIN-LEN-RANGE+" "+PIN-EXPIRED+" "+PIN-LOCKED+"
+           "+SESSION-CLOSED+" "+SESSION-COUNT+" "+SESSION-HANDLE-INVALID+"
+           "+SESSION-PARALLEL-NOT-SUPPORTED+" "+SESSION-READ-ONLY+"
+           "+SESSION-EXISTS+" "+SESSION-READ-ONLY-EXISTS+"
+           "+SESSION-READ-WRITE-SO-EXISTS+" "+SIGNATURE-INVALID+"
+           "+SIGNATURE-LEN-RANGE+" "+TEMPLATE-INCOMPLETE+"
+           "+TEMPLATE-INCONSISTENT+" "+TOKEN-NOT-PRESENT+"
+           "+TOKEN-NOT-RECOGNIZED+" "+TOKEN-WRITE-PROTECTED+"
+           "+UNWRAPPING-KEY-HANDLE-INVALID+" "+UNWRAPPING-KEY-SIZE-RANGE+"
+           "+UNWRAPPING-KEY-TYPE-INCONSISTENT+" "+USER-ALREADY-LOGGED-IN+"
+           "+USER-NOT-LOGGED-IN+" "+USER-PIN-NOT-INITIALIZED+"
+           "+USER-TYPE-INVALID+" "+USER-ANOTHER-ALREADY-LOGGED-IN+"
+           "+USER-TOO-MANY-TYPES+" "+WRAPPED-KEY-INVALID+"
+           "+WRAPPED-KEY-LEN-RANGE+" "+WRAPPING-KEY-HANDLE-INVALID+"
+           "+WRAPPING-KEY-SIZE-RANGE+" "+WRAPPING-KEY-TYPE-INCONSISTENT+"
+           "+RANDOM-SEED-NOT-SUPPORTED+" "+RANDOM-NO-RNG+"
+           "+DOMAIN-PARAMS-INVALID+" "+BUFFER-TOO-SMALL+" "+SAVED-STATE-INVALID+"
+           "+INFORMATION-SENSITIVE+" "+STATE-UNSAVEABLE+"
+           "+CRYPTOKI-NOT-INITIALIZED+" "+CRYPTOKI-ALREADY-INITIALIZED+"
+           "+MUTEX-BAD+" "+MUTEX-NOT-LOCKED+" "+FUNCTION-REJECTED+")
+
+  (:export "FLAGS" "RV" "NOTIFICATION" "SLOT-ID" "NOTIFY" "SESSION-HANDLE"
+           "USER-TYPE" "STATE" "OBJECT-HANDLE" "OBJECT-CLASS" "HW-FEATURE-TYPE"
+           "KEY-TYPE" "CERTIFICATE-TYPE" "ATTRIBUTE-TYPE" "MECHANISM-TYPE")
+
+  (:export "ATTRIBUTE" "CRYPTOKI-VERSION" "DATE" "DAY" "DEVICE-ERROR"
+           "FIRMWARE-VERSION" "FLAGS" "FREE-PRIVATE-MEMORY" "FREE-PUBLIC-MEMORY"
+           "HARDWARE-VERSION" "INFO" "LABEL" "LIBRARY-DESCRIPTION"
+           "LIBRARY-VERSION" "MAJOR" "MANUFACTURER-ID" "MAX-KEY-SIZE"
+           "MAX-PIN-LEN" "MAX-RW-SESSION-COUNT" "MAX-SESSION-COUNT" "MECHANISM"
+           "MECHANISM-INFO" "MIN-KEY-SIZE" "MIN-PIN-LEN" "MINOR" "MODEL" "MONTH"
+           "PARAMETER" "PARAMETER-LEN" "RW-SESSION-COUNT" "SERIAL-NUMBER"
+           "SESSION-COUNT" "SESSION-INFO" "SLOT-DESCRIPTION" "SLOT-ID"
+           "SLOT-INFO" "STATE" "TOKEN-INFO" "TOTAL-PRIVATE-MMEORY"
+           "TOTAL-PUBLIC-MEMORY" "TYPE" "UTC-TIME" "VALUE" "VALUE-LEN" "VERSION"
+           "YEAR")
+
+  (:documentation "CFFI interface over Cryptoki pkcs11 version 2.02"))
+
+(in-package "COM.INFORMATIMAGO.CLEXT.PKCS11.LOW")
+
+(defun load-library (&optional library-pathname)
+  "Load the Cryptoki pkcs11 library found at LIBRARY-PATHNAME, or some default path if not given."
+  (if library-pathname
+      (load-foreign-library library-pathname)
+      (progn
+
+        #+darwin (progn
+                   (load-foreign-library "/opt/local/lib/opensc-pkcs11.bundle/Contents/MacOS/opensc-pkcs11")
+                   #-(and) (load-foreign-library "/opt/local/lib/libopensc.dylib")
+                   #-(and) (load-foreign-library "/opt/local/lib/libpkcs11-helper.dylib"))
+        #+linux (progn
+                  (load-foreign-library "/usr/local/lib/opensc-pkcs11.so")
+                  #-(and) (load-foreign-library "/usr/lib/x86_64-linux-gnu/opensc-pkcs11.so") ; an old version without C_Initialize et a.
+                  #-(and) (load-foreign-library "/usr/local/lib/libiaspkcs11.so"))
+        #-(or darwin linux) (error "What Cryptoki pkcs11 library shall I load?"))))
+
+(defconstant +true+  1)
+(defconstant +false+ 0)
+
+(defcstruct version
+  (major :uchar)
+  (minor :uchar))
+
+
+
+(defctype flags         :ulong)
+(defctype rv            :ulong)
+
+(defconstant +OK+                                #x000)
+(defconstant +CANCEL+                            #x001)
+(defconstant +HOST-MEMORY+                       #x002)
+(defconstant +SLOT-ID-INVALID+                   #x003)
+(defconstant +GENERAL-ERROR+                     #x005)
+(defconstant +FUNCTION-FAILED+                   #x006)
+(defconstant +ARGUMENTS-BAD+                     #x007)
+(defconstant +NO-EVENT+                          #x008)
+(defconstant +NEED-TO-CREATE-THREADS+            #x009)
+(defconstant +CANT-LOCK+                         #x00a)
+(defconstant +ATTRIBUTE-READ-ONLY+               #x010)
+(defconstant +ATTRIBUTE-SENSITIVE+               #x011)
+(defconstant +ATTRIBUTE-TYPE-INVALID+            #x012)
+(defconstant +ATTRIBUTE-VALUE-INVALID+           #x013)
+(defconstant +DATA-INVALID+                      #x020)
+(defconstant +DATA-LEN-RANGE+                    #x021)
+(defconstant +DEVICE-ERROR+                      #x030)
+(defconstant +DEVICE-MEMORY+                     #x031)
+(defconstant +DEVICE-REMOVED+                    #x032)
+(defconstant +ENCRYPTED-DATA-INVALID+            #x040)
+(defconstant +ENCRYPTED-DATA-LEN-RANGE+          #x041)
+(defconstant +FUNCTION-CANCELED+                 #x050)
+(defconstant +FUNCTION-NOT-PARALLEL+             #x051)
+(defconstant +FUNCTION-NOT-SUPPORTED+            #x054)
+(defconstant +KEY-HANDLE-INVALID+                #x060)
+(defconstant +KEY-SIZE-RANGE+                    #x062)
+(defconstant +KEY-TYPE-INCONSISTENT+             #x063)
+(defconstant +KEY-NOT-NEEDED+                    #x064)
+(defconstant +KEY-CHANGED+                       #x065)
+(defconstant +KEY-NEEDED+                        #x066)
+(defconstant +KEY-INDIGESTIBLE+                  #x067)
+(defconstant +KEY-FUNCTION-NOT-PERMITTED+        #x068)
+(defconstant +KEY-NOT-WRAPPABLE+                 #x069)
+(defconstant +KEY-UNEXTRACTABLE+                 #x06a)
+(defconstant +MECHANISM-INVALID+                 #x070)
+(defconstant +MECHANISM-PARAM-INVALID+           #x071)
+(defconstant +OBJECT-HANDLE-INVALID+             #x082)
+(defconstant +OPERATION-ACTIVE+                  #x090)
+(defconstant +OPERATION-NOT-INITIALIZED+         #x091)
+(defconstant +PIN-INCORRECT+                     #x0a0)
+(defconstant +PIN-INVALID+                       #x0a1)
+(defconstant +PIN-LEN-RANGE+                     #x0a2)
+(defconstant +PIN-EXPIRED+                       #x0a3)
+(defconstant +PIN-LOCKED+                        #x0a4)
+(defconstant +SESSION-CLOSED+                    #x0b0)
+(defconstant +SESSION-COUNT+                     #x0b1)
+(defconstant +SESSION-HANDLE-INVALID+            #x0b3)
+(defconstant +SESSION-PARALLEL-NOT-SUPPORTED+    #x0b4)
+(defconstant +SESSION-READ-ONLY+                 #x0b5)
+(defconstant +SESSION-EXISTS+                    #x0b6)
+(defconstant +SESSION-READ-ONLY-EXISTS+          #x0b7)
+(defconstant +SESSION-READ-WRITE-SO-EXISTS+      #x0b8)
+(defconstant +SIGNATURE-INVALID+                 #x0c0)
+(defconstant +SIGNATURE-LEN-RANGE+               #x0c1)
+(defconstant +TEMPLATE-INCOMPLETE+               #x0d0)
+(defconstant +TEMPLATE-INCONSISTENT+             #x0d1)
+(defconstant +TOKEN-NOT-PRESENT+                 #x0e0)
+(defconstant +TOKEN-NOT-RECOGNIZED+              #x0e1)
+(defconstant +TOKEN-WRITE-PROTECTED+             #x0e2)
+(defconstant +UNWRAPPING-KEY-HANDLE-INVALID+     #x0f0)
+(defconstant +UNWRAPPING-KEY-SIZE-RANGE+         #x0f1)
+(defconstant +UNWRAPPING-KEY-TYPE-INCONSISTENT+  #x0f2)
+(defconstant +USER-ALREADY-LOGGED-IN+            #x100)
+(defconstant +USER-NOT-LOGGED-IN+                #x101)
+(defconstant +USER-PIN-NOT-INITIALIZED+          #x102)
+(defconstant +USER-TYPE-INVALID+                 #x103)
+(defconstant +USER-ANOTHER-ALREADY-LOGGED-IN+    #x104)
+(defconstant +USER-TOO-MANY-TYPES+               #x105)
+(defconstant +WRAPPED-KEY-INVALID+               #x110)
+(defconstant +WRAPPED-KEY-LEN-RANGE+             #x112)
+(defconstant +WRAPPING-KEY-HANDLE-INVALID+       #x113)
+(defconstant +WRAPPING-KEY-SIZE-RANGE+           #x114)
+(defconstant +WRAPPING-KEY-TYPE-INCONSISTENT+    #x115)
+(defconstant +RANDOM-SEED-NOT-SUPPORTED+         #x120)
+(defconstant +RANDOM-NO-RNG+                     #x121)
+(defconstant +DOMAIN-PARAMS-INVALID+             #x130)
+(defconstant +BUFFER-TOO-SMALL+                  #x150)
+(defconstant +SAVED-STATE-INVALID+               #x160)
+(defconstant +INFORMATION-SENSITIVE+             #x170)
+(defconstant +STATE-UNSAVEABLE+                  #x180)
+(defconstant +CRYPTOKI-NOT-INITIALIZED+          #x190)
+(defconstant +CRYPTOKI-ALREADY-INITIALIZED+      #x191)
+(defconstant +MUTEX-BAD+                         #x1a0)
+(defconstant +MUTEX-NOT-LOCKED+                  #x1a1)
+(defconstant +FUNCTION-REJECTED+                 #x200)
+;; +VENDOR-DEFINED+
+
+
+(defctype notification  :ulong)
+(defctype slot-id       :ulong)
+
+(defconstant +surrender+ 0)
+
+(defctype notify :pointer)
+;; typedef ck_rv_t (*ck_notify_t) (ck_session_handle_t session, ck_notification_t event, void *application);
+
+(defcstruct info
+  (cryptoki-version    (:struct version))
+  (manufacturer-id     :uchar :count 32)
+  (flags               flags)
+  (library-description :uchar :count 32)
+  (library-version     (:struct version)))
+
+
+(defcstruct slot-info
+  (slot-description :uchar :count 64)
+  (manufacturer-id  :uchar :count 32)
+  (flags            flags)
+  (hardware-version (:struct version))
+  (firmware-version (:struct version)))
+
+(defconstant +token-present+    (ash 1 0))
+(defconstant +removable-device+ (ash 1 1))
+(defconstant +hw-slot+          (ash 1 2))
+(defconstant +array-attribute+  (ash 1 30))
+
+
+(defcstruct token-info
+  (label                :uchar   :count 32)
+  (manufacturer-id      :uchar   :count 32)
+  (model                :uchar   :count 16)
+  (serial-number        :uchar   :count 16)
+  (flags                flags)
+  (max-session-count    :ulong)
+  (session-count        :ulong)
+  (max-rw-session-count :ulong)
+  (rw-session-count     :ulong)
+  (max-pin-len          :ulong)
+  (min-pin-len          :ulong)
+  (total-public-memory  :ulong)
+  (free-public-memory   :ulong)
+  (total-private-mmeory :ulong)
+  (free-private-memory  :ulong)
+  (hardware-version     (:struct version))
+  (firmware-version     (:struct version))
+  (utc-time             :uchar   :count 16))
+
+(defconstant +RNG+                           (ash 1 0))
+(defconstant +WRITE-PROTECTED+               (ash 1 1))
+(defconstant +LOGIN-REQUIRED+                (ash 1 2))
+(defconstant +USER-PIN-INITIALIZED+          (ash 1 3))
+(defconstant +RESTORE-KEY-NOT-NEEDED+        (ash 1 5))
+(defconstant +CLOCK-ON-TOKEN+                (ash 1 6))
+(defconstant +PROTECTED-AUTHENTICATION-PATH+ (ash 1 8))
+(defconstant +DUAL-CRYPTO-OPERATIONS+        (ash 1 9))
+(defconstant +TOKEN-INITIALIZED+             (ash 1 10))
+(defconstant +SECONDARY-AUTHENTICATION+      (ash 1 11))
+(defconstant +USER-PIN-COUNT-LOW+            (ash 1 16))
+(defconstant +USER-PIN-FINAL-TRY+            (ash 1 17))
+(defconstant +USER-PIN-LOCKED+               (ash 1 18))
+(defconstant +USER-PIN-TO-BE-CHANGED+        (ash 1 19))
+(defconstant +SO-PIN-COUNT-LOW+              (ash 1 20))
+(defconstant +SO-PIN-FINAL-TRY+              (ash 1 21))
+(defconstant +SO-PIN-LOCKED+                 (ash 1 22))
+(defconstant +SO-PIN-TO-BE-CHANGED+          (ash 1 23))
+
+(defconstant +unavailable-information+
+  #+(or (and ccl 64-bit-host))
+  (- (expt 2 64) 1)
+  #+(or (and ccl 32-bit-host))
+  (- (expt 2 32) 1))
+(defconstant +effectively-infinite+ 0)
+
+(defctype session-handle :ulong)
+(defconstant +invalid-handle+ 0)
+
+(defctype user-type :ulong)
+(defconstant +so+               0)
+(defconstant +user+             1)
+(defconstant +context-specific+ 2)
+
+(defctype state :ulong)
+
+(defconstant +RO-PUBLIC-SESSION+  0)
+(defconstant +RO-USER-FUNCTIONS+  1)
+(defconstant +RW-PUBLIC-SESSION+  2)
+(defconstant +RW-USER-FUNCTIONS+  3)
+(defconstant +RW-SO-FUNCTIONS+    4)
+
+
+(defcstruct session-info
+  (slot-id slot-id)
+  (state   state)
+  (flags   flags)
+  (device-error :ulong))
+
+(defconstant +RW-SESSION+      (ash 1 1))
+(defconstant +SERIAL-SESSION+  (ash 1 2))
+
+
+(defctype object-handle :ulong)
+(defctype object-class  :ulong)
+(defconstant +O-DATA+               0)
+(defconstant +O-CERTIFICATE+        1)
+(defconstant +O-PUBLIC-KEY+         2)
+(defconstant +O-PRIVATE-KEY+        3)
+(defconstant +O-SECRET-KEY+         4)
+(defconstant +O-HW-FEATURE+         5)
+(defconstant +O-DOMAIN-PARAMETERS+  6)
+(defconstant +O-MECHANISM+          7)
+
+(defconstant +VENDOR-DEFINED+       (ash 1 31))
+
+(defctype hw-feature-type :ulong)
+(defconstant +H-MONOTONIC-COUNTER+  1)
+(defconstant +H-CLOCK+              2)
+(defconstant +H-USER-INTERFACE+     3)
+;; +vendor-defined+
+
+
+(defctype key-type :ulong)
+(defconstant +K-RSA+             #x00)
+(defconstant +K-DSA+             #x01)
+(defconstant +K-DH+              #x02)
+(defconstant +K-ECDSA+           #x03)
+(defconstant +K-EC+              #x03)
+(defconstant +K-X9-42-DH+        #x04)
+(defconstant +K-KEA+             #x05)
+(defconstant +K-GENERIC-SECRET+  #x10)
+(defconstant +K-RC2+             #x11)
+(defconstant +K-RC4+             #x12)
+(defconstant +K-DES+             #x13)
+(defconstant +K-DES2+            #x14)
+(defconstant +K-DES3+            #x15)
+(defconstant +K-CAST+            #x16)
+(defconstant +K-CAST3+           #x17)
+(defconstant +K-CAST128+         #x18)
+(defconstant +K-RC5+             #x19)
+(defconstant +K-IDEA+            #x1a)
+(defconstant +K-SKIPJACK+        #x1b)
+(defconstant +K-BATON+           #x1c)
+(defconstant +K-JUNIPER+         #x1d)
+(defconstant +K-CDMF+            #x1e)
+(defconstant +K-AES+             #x1f)
+(defconstant +K-BLOWFISH+        #x20)
+(defconstant +K-TWOFISH+         #x21)
+;; +vendor-defined+
+
+(defctype certificate-type  :ulong)
+(defconstant +C-X-509+            0)
+(defconstant +C-X-509-ATTR-CERT+  1)
+(defconstant +C-WTLS+             2)
+;; +vendor-defined+
+
+(defctype attribute-type :ulong)
+(defconstant +A-CLASS+                       #x000)
+(defconstant +A-TOKEN+                       #x001)
+(defconstant +A-PRIVATE+                     #x002)
+(defconstant +A-LABEL+                       #x003)
+(defconstant +A-APPLICATION+                 #x010)
+(defconstant +A-VALUE+                       #x011)
+(defconstant +A-OBJECT-ID+                   #x012)
+(defconstant +A-CERTIFICATE-TYPE+            #x080)
+(defconstant +A-ISSUER+                      #x081)
+(defconstant +A-SERIAL-NUMBER+               #x082)
+(defconstant +A-AC-ISSUER+                   #x083)
+(defconstant +A-OWNER+                       #x084)
+(defconstant +A-ATTR-TYPES+                  #x085)
+(defconstant +A-TRUSTED+                     #x086)
+(defconstant +A-CERTIFICATE-CATEGORY+        #x087)
+(defconstant +A-JAVA-MIDP-SECURITY-DOMAIN+   #x088)
+(defconstant +A-URL+                         #x089)
+(defconstant +A-HASH-OF-SUBJECT-PUBLIC-KEY+  #x08a)
+(defconstant +A-HASH-OF-ISSUER-PUBLIC-KEY+   #x08b)
+(defconstant +A-CHECK-VALUE+                 #x090)
+(defconstant +A-KEY-TYPE+                    #x100)
+(defconstant +A-SUBJECT+                     #x101)
+(defconstant +A-ID+                          #x102)
+(defconstant +A-SENSITIVE+                   #x103)
+(defconstant +A-ENCRYPT+                     #x104)
+(defconstant +A-DECRYPT+                     #x105)
+(defconstant +A-WRAP+                        #x106)
+(defconstant +A-UNWRAP+                      #x107)
+(defconstant +A-SIGN+                        #x108)
+(defconstant +A-SIGN-RECOVER+                #x109)
+(defconstant +A-VERIFY+                      #x10a)
+(defconstant +A-VERIFY-RECOVER+              #x10b)
+(defconstant +A-DERIVE+                      #x10c)
+(defconstant +A-START-DATE+                  #x110)
+(defconstant +A-END-DATE+                    #x111)
+(defconstant +A-MODULUS+                     #x120)
+(defconstant +A-MODULUS-BITS+                #x121)
+(defconstant +A-PUBLIC-EXPONENT+             #x122)
+(defconstant +A-PRIVATE-EXPONENT+            #x123)
+(defconstant +A-PRIME-1+                     #x124)
+(defconstant +A-PRIME-2+                     #x125)
+(defconstant +A-EXPONENT-1+                  #x126)
+(defconstant +A-EXPONENT-2+                  #x127)
+(defconstant +A-COEFFICIENT+                 #x128)
+(defconstant +A-PRIME+                       #x130)
+(defconstant +A-SUBPRIME+                    #x131)
+(defconstant +A-BASE+                        #x132)
+(defconstant +A-PRIME-BITS+                  #x133)
+(defconstant +A-SUB-PRIME-BITS+              #x134)
+(defconstant +A-VALUE-BITS+                  #x160)
+(defconstant +A-VALUE-LEN+                   #x161)
+(defconstant +A-EXTRACTABLE+                 #x162)
+(defconstant +A-LOCAL+                       #x163)
+(defconstant +A-NEVER-EXTRACTABLE+           #x164)
+(defconstant +A-ALWAYS-SENSITIVE+            #x165)
+(defconstant +A-KEY-GEN-MECHANISM+           #x166)
+(defconstant +A-MODIFIABLE+                  #x170)
+(defconstant +A-ECDSA-PARAMS+                #x180)
+(defconstant +A-EC-PARAMS+                   #x180)
+(defconstant +A-EC-POINT+                    #x181)
+(defconstant +A-SECONDARY-AUTH+              #x200)
+(defconstant +A-AUTH-PIN-FLAGS+              #x201)
+(defconstant +A-ALWAYS-AUTHENTICATE+         #x202)
+(defconstant +A-WRAP-WITH-TRUSTED+           #x210)
+(defconstant +A-HW-FEATURE-TYPE+             #x300)
+(defconstant +A-RESET-ON-INIT+               #x301)
+(defconstant +A-HAS-RESET+                   #x302)
+(defconstant +A-PIXEL-X+                     #x400)
+(defconstant +A-PIXEL-Y+                     #x401)
+(defconstant +A-RESOLUTION+                  #x402)
+(defconstant +A-CHAR-ROWS+                   #x403)
+(defconstant +A-CHAR-COLUMNS+                #x404)
+(defconstant +A-COLOR+                       #x405)
+(defconstant +A-BITS-PER-PIXEL+              #x406)
+(defconstant +A-CHAR-SETS+                   #x480)
+(defconstant +A-ENCODING-METHODS+            #x481)
+(defconstant +A-MIME-TYPES+                  #x482)
+(defconstant +A-MECHANISM-TYPE+              #x500)
+(defconstant +A-REQUIRED-CMS-ATTRIBUTES+     #x501)
+(defconstant +A-DEFAULT-CMS-ATTRIBUTES+      #x502)
+(defconstant +A-SUPPORTED-CMS-ATTRIBUTES+    #x503)
+(defconstant +A-WRAP-TEMPLATE+               (logior +ARRAY-ATTRIBUTE+ #x211))
+(defconstant +A-UNWRAP-TEMPLATE+             (logior +ARRAY-ATTRIBUTE+ #x212))
+(defconstant +A-ALLOWED-MECHANISMS+          (logior +ARRAY-ATTRIBUTE+ #x600))
+;; +vendor-defined+
+
+
+(defcstruct attribute
+  (type       attribute-type)
+  (value     :pointer)
+  (value-len :ulong))
+
+(defcstruct date
+  (year  :uchar :count 4)
+  (month :uchar :count 2)
+  (day   :uchar :count 2))
+
+(defctype mechanism-type :ulong)
+(defconstant +M-RSA-PKCS-KEY-PAIR-GEN+      #x0000)
+(defconstant +M-RSA-PKCS+                   #x0001)
+(defconstant +M-RSA-9796+                   #x0002)
+(defconstant +M-RSA-X-509+                  #x0003)
+(defconstant +M-MD2-RSA-PKCS+               #x0004)
+(defconstant +M-MD5-RSA-PKCS+               #x0005)
+(defconstant +M-SHA1-RSA-PKCS+              #x0006)
+(defconstant +M-RIPEMD128-RSA-PKCS+         #x0007)
+(defconstant +M-RIPEMD160-RSA-PKCS+         #x0008)
+(defconstant +M-RSA-PKCS-OAEP+              #x0009)
+(defconstant +M-RSA-X9-31-KEY-PAIR-GEN+     #x000a)
+(defconstant +M-RSA-X9-31+                  #x000b)
+(defconstant +M-SHA1-RSA-X9-31+             #x000c)
+(defconstant +M-RSA-PKCS-PSS+               #x000d)
+(defconstant +M-SHA1-RSA-PKCS-PSS+          #x000e)
+(defconstant +M-DSA-KEY-PAIR-GEN+           #x0010)
+(defconstant +M-DSA+                        #x0011)
+(defconstant +M-DSA-SHA1+                   #x0012)
+(defconstant +M-DH-PKCS-KEY-PAIR-GEN+       #x0020)
+(defconstant +M-DH-PKCS-DERIVE+             #x0021)
+(defconstant +M-X9-42-DH-KEY-PAIR-GEN+      #x0030)
+(defconstant +M-X9-42-DH-DERIVE+            #x0031)
+(defconstant +M-X9-42-DH-HYBRID-DERIVE+     #x0032)
+(defconstant +M-X9-42-MQV-DERIVE+           #x0033)
+(defconstant +M-SHA256-RSA-PKCS+            #x0040)
+(defconstant +M-SHA384-RSA-PKCS+            #x0041)
+(defconstant +M-SHA512-RSA-PKCS+            #x0042)
+(defconstant +M-SHA256-RSA-PKCS-PSS+        #x0043)
+(defconstant +M-SHA384-RSA-PKCS-PSS+        #x0044)
+(defconstant +M-SHA512-RSA-PKCS-PSS+        #x0045)
+(defconstant +M-RC2-KEY-GEN+                #x0100)
+(defconstant +M-RC2-ECB+                    #x0101)
+(defconstant +M-RC2-CBC+                    #x0102)
+(defconstant +M-RC2-MAC+                    #x0103)
+(defconstant +M-RC2-MAC-GENERAL+            #x0104)
+(defconstant +M-RC2-CBC-PAD+                #x0105)
+(defconstant +M-RC4-KEY-GEN+                #x0110)
+(defconstant +M-RC4+                        #x0111)
+(defconstant +M-DES-KEY-GEN+                #x0120)
+(defconstant +M-DES-ECB+                    #x0121)
+(defconstant +M-DES-CBC+                    #x0122)
+(defconstant +M-DES-MAC+                    #x0123)
+(defconstant +M-DES-MAC-GENERAL+            #x0124)
+(defconstant +M-DES-CBC-PAD+                #x0125)
+(defconstant +M-DES2-KEY-GEN+               #x0130)
+(defconstant +M-DES3-KEY-GEN+               #x0131)
+(defconstant +M-DES3-ECB+                   #x0132)
+(defconstant +M-DES3-CBC+                   #x0133)
+(defconstant +M-DES3-MAC+                   #x0134)
+(defconstant +M-DES3-MAC-GENERAL+           #x0135)
+(defconstant +M-DES3-CBC-PAD+               #x0136)
+(defconstant +M-CDMF-KEY-GEN+               #x0140)
+(defconstant +M-CDMF-ECB+                   #x0141)
+(defconstant +M-CDMF-CBC+                   #x0142)
+(defconstant +M-CDMF-MAC+                   #x0143)
+(defconstant +M-CDMF-MAC-GENERAL+           #x0144)
+(defconstant +M-CDMF-CBC-PAD+               #x0145)
+(defconstant +M-MD2+                        #x0200)
+(defconstant +M-MD2-HMAC+                   #x0201)
+(defconstant +M-MD2-HMAC-GENERAL+           #x0202)
+(defconstant +M-MD5+                        #x0210)
+(defconstant +M-MD5-HMAC+                   #x0211)
+(defconstant +M-MD5-HMAC-GENERAL+           #x0212)
+(defconstant +M-SHA-1+                      #x0220)
+(defconstant +M-SHA-1-HMAC+                 #x0221)
+(defconstant +M-SHA-1-HMAC-GENERAL+         #x0222)
+(defconstant +M-RIPEMD128+                  #x0230)
+(defconstant +M-RIPEMD128-HMAC+             #x0231)
+(defconstant +M-RIPEMD128-HMAC-GENERAL+     #x0232)
+(defconstant +M-RIPEMD160+                  #x0240)
+(defconstant +M-RIPEMD160-HMAC+             #x0241)
+(defconstant +M-RIPEMD160-HMAC-GENERAL+     #x0242)
+(defconstant +M-SHA256+                     #x0250)
+(defconstant +M-SHA256-HMAC+                #x0251)
+(defconstant +M-SHA256-HMAC-GENERAL+        #x0252)
+(defconstant +M-SHA384+                     #x0260)
+(defconstant +M-SHA384-HMAC+                #x0261)
+(defconstant +M-SHA384-HMAC-GENERAL+        #x0262)
+(defconstant +M-SHA512+                     #x0270)
+(defconstant +M-SHA512-HMAC+                #x0271)
+(defconstant +M-SHA512-HMAC-GENERAL+        #x0272)
+(defconstant +M-CAST-KEY-GEN+               #x0300)
+(defconstant +M-CAST-ECB+                   #x0301)
+(defconstant +M-CAST-CBC+                   #x0302)
+(defconstant +M-CAST-MAC+                   #x0303)
+(defconstant +M-CAST-MAC-GENERAL+           #x0304)
+(defconstant +M-CAST-CBC-PAD+               #x0305)
+(defconstant +M-CAST3-KEY-GEN+              #x0310)
+(defconstant +M-CAST3-ECB+                  #x0311)
+(defconstant +M-CAST3-CBC+                  #x0312)
+(defconstant +M-CAST3-MAC+                  #x0313)
+(defconstant +M-CAST3-MAC-GENERAL+          #x0314)
+(defconstant +M-CAST3-CBC-PAD+              #x0315)
+(defconstant +M-CAST5-KEY-GEN+              #x0320)
+(defconstant +M-CAST128-KEY-GEN+            #x0320)
+(defconstant +M-CAST5-ECB+                  #x0321)
+(defconstant +M-CAST128-ECB+                #x0321)
+(defconstant +M-CAST5-CBC+                  #x0322)
+(defconstant +M-CAST128-CBC+                #x0322)
+(defconstant +M-CAST5-MAC+                  #x0323)
+(defconstant +M-CAST128-MAC+                #x0323)
+(defconstant +M-CAST5-MAC-GENERAL+          #x0324)
+(defconstant +M-CAST128-MAC-GENERAL+        #x0324)
+(defconstant +M-CAST5-CBC-PAD+              #x0325)
+(defconstant +M-CAST128-CBC-PAD+            #x0325)
+(defconstant +M-RC5-KEY-GEN+                #x0330)
+(defconstant +M-RC5-ECB+                    #x0331)
+(defconstant +M-RC5-CBC+                    #x0332)
+(defconstant +M-RC5-MAC+                    #x0333)
+(defconstant +M-RC5-MAC-GENERAL+            #x0334)
+(defconstant +M-RC5-CBC-PAD+                #x0335)
+(defconstant +M-IDEA-KEY-GEN+               #x0340)
+(defconstant +M-IDEA-ECB+                   #x0341)
+(defconstant +M-IDEA-CBC+                   #x0342)
+(defconstant +M-IDEA-MAC+                   #x0343)
+(defconstant +M-IDEA-MAC-GENERAL+           #x0344)
+(defconstant +M-IDEA-CBC-PAD+               #x0345)
+(defconstant +M-GENERIC-SECRET-KEY-GEN+     #x0350)
+(defconstant +M-CONCATENATE-BASE-AND-KEY+   #x0360)
+(defconstant +M-CONCATENATE-BASE-AND-DATA+  #x0362)
+(defconstant +M-CONCATENATE-DATA-AND-BASE+  #x0363)
+(defconstant +M-XOR-BASE-AND-DATA+          #x0364)
+(defconstant +M-EXTRACT-KEY-FROM-KEY+       #x0365)
+(defconstant +M-SSL3-PRE-MASTER-KEY-GEN+    #x0370)
+(defconstant +M-SSL3-MASTER-KEY-DERIVE+     #x0371)
+(defconstant +M-SSL3-KEY-AND-MAC-DERIVE+    #x0372)
+(defconstant +M-SSL3-MASTER-KEY-DERIVE-DH+  #x0373)
+(defconstant +M-TLS-PRE-MASTER-KEY-GEN+     #x0374)
+(defconstant +M-TLS-MASTER-KEY-DERIVE+      #x0375)
+(defconstant +M-TLS-KEY-AND-MAC-DERIVE+     #x0376)
+(defconstant +M-TLS-MASTER-KEY-DERIVE-DH+   #x0377)
+(defconstant +M-SSL3-MD5-MAC+               #x0380)
+(defconstant +M-SSL3-SHA1-MAC+              #x0381)
+(defconstant +M-MD5-KEY-DERIVATION+         #x0390)
+(defconstant +M-MD2-KEY-DERIVATION+         #x0391)
+(defconstant +M-SHA1-KEY-DERIVATION+        #x0392)
+(defconstant +M-PBE-MD2-DES-CBC+            #x03a0)
+(defconstant +M-PBE-MD5-DES-CBC+            #x03a1)
+(defconstant +M-PBE-MD5-CAST-CBC+           #x03a2)
+(defconstant +M-PBE-MD5-CAST3-CBC+          #x03a3)
+(defconstant +M-PBE-MD5-CAST5-CBC+          #x03a4)
+(defconstant +M-PBE-MD5-CAST128-CBC+        #x03a4)
+(defconstant +M-PBE-SHA1-CAST5-CBC+         #x03a5)
+(defconstant +M-PBE-SHA1-CAST128-CBC+       #x03a5)
+(defconstant +M-PBE-SHA1-RC4-128+           #x03a6)
+(defconstant +M-PBE-SHA1-RC4-40+            #x03a7)
+(defconstant +M-PBE-SHA1-DES3-EDE-CBC+      #x03a8)
+(defconstant +M-PBE-SHA1-DES2-EDE-CBC+      #x03a9)
+(defconstant +M-PBE-SHA1-RC2-128-CBC+       #x03aa)
+(defconstant +M-PBE-SHA1-RC2-40-CBC+        #x03ab)
+(defconstant +M-PKCS5-PBKD2+                #x03b0)
+(defconstant +M-PBA-SHA1-WITH-SHA1-HMAC+    #x03c0)
+(defconstant +M-KEY-WRAP-LYNKS+             #x0400)
+(defconstant +M-KEY-WRAP-SET-OAEP+          #x0401)
+(defconstant +M-SKIPJACK-KEY-GEN+           #x1000)
+(defconstant +M-SKIPJACK-ECB64+             #x1001)
+(defconstant +M-SKIPJACK-CBC64+             #x1002)
+(defconstant +M-SKIPJACK-OFB64+             #x1003)
+(defconstant +M-SKIPJACK-CFB64+             #x1004)
+(defconstant +M-SKIPJACK-CFB32+             #x1005)
+(defconstant +M-SKIPJACK-CFB16+             #x1006)
+(defconstant +M-SKIPJACK-CFB8+              #x1007)
+(defconstant +M-SKIPJACK-WRAP+              #x1008)
+(defconstant +M-SKIPJACK-PRIVATE-WRAP+      #x1009)
+(defconstant +M-SKIPJACK-RELAYX+            #x100a)
+(defconstant +M-KEA-KEY-PAIR-GEN+           #x1010)
+(defconstant +M-KEA-KEY-DERIVE+             #x1011)
+(defconstant +M-FORTEZZA-TIMESTAMP+         #x1020)
+(defconstant +M-BATON-KEY-GEN+              #x1030)
+(defconstant +M-BATON-ECB128+               #x1031)
+(defconstant +M-BATON-ECB96+                #x1032)
+(defconstant +M-BATON-CBC128+               #x1033)
+(defconstant +M-BATON-COUNTER+              #x1034)
+(defconstant +M-BATON-SHUFFLE+              #x1035)
+(defconstant +M-BATON-WRAP+                 #x1036)
+(defconstant +M-ECDSA-KEY-PAIR-GEN+         #x1040)
+(defconstant +M-EC-KEY-PAIR-GEN+            #x1040)
+(defconstant +M-ECDSA+                      #x1041)
+(defconstant +M-ECDSA-SHA1+                 #x1042)
+(defconstant +M-ECDH1-DERIVE+               #x1050)
+(defconstant +M-ECDH1-COFACTOR-DERIVE+      #x1051)
+(defconstant +M-ECMQV-DERIVE+               #x1052)
+(defconstant +M-JUNIPER-KEY-GEN+            #x1060)
+(defconstant +M-JUNIPER-ECB128+             #x1061)
+(defconstant +M-JUNIPER-CBC128+             #x1062)
+(defconstant +M-JUNIPER-COUNTER+            #x1063)
+(defconstant +M-JUNIPER-SHUFFLE+            #x1064)
+(defconstant +M-JUNIPER-WRAP+               #x1065)
+(defconstant +M-FASTHASH+                   #x1070)
+(defconstant +M-AES-KEY-GEN+                #x1080)
+(defconstant +M-AES-ECB+                    #x1081)
+(defconstant +M-AES-CBC+                    #x1082)
+(defconstant +M-AES-MAC+                    #x1083)
+(defconstant +M-AES-MAC-GENERAL+            #x1084)
+(defconstant +M-AES-CBC-PAD+                #x1085)
+(defconstant +M-DSA-PARAMETER-GEN+          #x2000)
+(defconstant +M-DH-PKCS-PARAMETER-GEN+      #x2001)
+(defconstant +M-X9-42-DH-PARAMETER-GEN+     #x2002)
+;; +VENDOR-DEFINED+
+
+(defcstruct mechanism
+  (mechanism mechanism-type)
+  (parameter       :pointer)
+  (parameter-len   :ulong))
+
+(defcstruct mechanism-info
+  (min-key-size :ulong)
+  (max-key-size :ulong)
+  (flags        flags))
+
+(defconstant +F-HW+                 (ash 1 0))
+(defconstant +F-ENCRYPT+            (ash 1 8))
+(defconstant +F-DECRYPT+            (ash 1 9))
+(defconstant +F-DIGEST+             (ash 1 10))
+(defconstant +F-SIGN+               (ash 1 11))
+(defconstant +F-SIGN-RECOVER+       (ash 1 12))
+(defconstant +F-VERIFY+             (ash 1 13))
+(defconstant +F-VERIFY-RECOVER+     (ash 1 14))
+(defconstant +F-GENERATE+           (ash 1 15))
+(defconstant +F-GENERATE-KEY-PAIR+  (ash 1 16))
+(defconstant +F-WRAP+               (ash 1 17))
+(defconstant +F-UNWRAP+             (ash 1 18))
+(defconstant +F-DERIVE+             (ash 1 19))
+(defconstant +F-EXTENSION+          (ash 1 31))
+
+;; Flags for C-WaitForSlotEvent.
+(defconstant +DONT-BLOCK+  1)
+
+(defcfun (initialize "C_Initialize") rv (init-args :pointer))
+(defcfun (finalize   "C_Finalize")   rv (reserved  :pointer))
+(defcfun (get-info   "C_GetInfo")    rv (info     (:pointer (:struct info))))
+
+
+(defcfun (get-slot-list       "C_GetSlotList")      rv
+  (token-present :uchar)
+  (slot-list (:pointer slot-id))
+  (count (:pointer :ulong)))
+
+(defcfun (get-slot-info       "C_GetSlotInfo")      rv
+  (slot-id       slot-id)
+  (info      (:pointer (:struct slot-info))))
+
+(defcfun (get-token-info      "C_GetTokenInfo")     rv
+  (slot-id       slot-id)
+  (info      (:pointer (:struct token-info))))
+
+(defcfun (wait-for-slot-event "C_WaitForSlotEvent") rv
+  (flags         flags)
+  (slot      (:pointer slot-id))
+  (reserved  :pointer))
+
+(defcfun (get-mechanism-list "C_GetMechanismList")    rv
+  (slot-id        slot-id)
+  (mechanism-list (:pointer mechanism-type))  (count (:pointer :ulong)))
+
+(defcfun (get-mechanism-info "C_GetMechanismInfo")    rv
+  (slot-id slot-id)
+  (type    mechanism-type)
+  (info    (:pointer (:struct mechanism-info))))
+
+(defcfun (init-token "C_InitToken")    rv
+  (slot-id slot-id)
+  (pin     (:pointer :uchar))
+  (pin-len :ulong)
+  (label   (:pointer :uchar)))
+
+(defcfun (init-pin "C_InitPIN") rv
+  (session session-handle)
+  (pin     (:pointer :uchar))
+  (pin-len :ulong))
+
+(defcfun (set-pin "C_SetPIN")    rv
+  (session session-handle)
+  (old-pin (:pointer :uchar))
+  (old-len :ulong)
+  (new-pin (:pointer :uchar))
+  (new-len :ulong))
+
+(defcfun (open-session "C_OpenSession")    rv
+  (slot-id     slot-id)
+  (flags       flags)
+  (application :pointer)
+  (notify      notify)
+  (session     (:pointer session-handle)))
+
+(defcfun (close-session "C_CloseSession") rv
+  (session session-handle))
+
+(defcfun (close-all-sessions "C_CloseAllSessions") rv
+  (slot-id slot-id))
+
+(defcfun (get-session-info "C_GetSessionInfo")    rv
+  (session session-handle)
+  (info    (:pointer (:struct session-info))))
+
+(defcfun (get-operation-state "C_GetOperationState")    rv
+  (session             session-handle)
+  (operation-state     (:pointer :uchar))
+  (operation-state-len (:pointer :ulong)))
+
+(defcfun (set-operation-state "C_SetOperationState")    rv
+  (session             session-handle)
+  (operation-state     (:pointer :uchar))
+  (operation-state-len :ulong)
+  (encryption-key      object-handle)
+  (authentication-key  object-handle))
+
+(defcfun (login "C_Login")    rv
+  (session   session-handle)
+  (user-type user-type)
+  (pin       (:pointer :uchar))
+  (pin-len   :ulong))
+
+(defcfun (logout "C_Logout") rv
+  (session session-handle))
+
+(defcfun (create-object "C_CreateObject")    rv
+  (session session-handle)
+  (templ (:pointer (:struct attribute)))
+  (count :ulong)
+  (object (:pointer object-handle)))
+
+(defcfun (copy-object "C_CopyObject")    rv
+  (session    session-handle)
+  (object     object-handle)
+  (templ      (:pointer (:struct attribute)))
+  (count      :ulong)
+  (new-object (:pointer object-handle)))
+
+(defcfun (destroy-object "C_DestroyObject") rv
+  (session session-handle)
+  (object object-handle))
+
+(defcfun (get-object-size "C_GetObjectSize")    rv
+  (session session-handle)
+  (object  object-handle)
+  (size    (:pointer :ulong)))
+
+(defcfun (get-attribute-value "C_GetAttributeValue")    rv
+  (session session-handle)
+  (object  object-handle)
+  (templ   (:pointer (:struct attribute)))
+  (count   :ulong))
+
+(defcfun (set-attribute-value "C_SetAttributeValue")    rv
+  (session session-handle)
+  (object  object-handle)
+  (templ   (:pointer (:struct attribute)))
+  (count   :ulong))
+
+(defcfun (find-objects-init "C_FindObjectsInit")    rv
+  (session session-handle)
+  (templ   (:pointer (:struct attribute)))
+  (count   :ulong))
+
+(defcfun (find-objects "C_FindObjects")    rv
+  (session          session-handle)
+  (object           (:pointer object-handle))
+  (max-object-count :ulong)
+  (object-count     (:pointer :ulong)))
+
+(defcfun (find-objects-final "C_FindObjectsFinal") rv (session session-handle))
+
+(defcfun (encrypt-init "C_EncryptInit")    rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (key       object-handle))
+
+(defcfun (encrypt "C_Encrypt")    rv
+  (session            session-handle)
+  (data               (:pointer :uchar))
+  (data-len           :ulong)
+  (encrypted-data     (:pointer :uchar))
+  (encrypted-data-len (:pointer :ulong)))
+
+(defcfun (encrypt-update "C_EncryptUpdate")    rv
+  (session            session-handle)
+  (part               (:pointer :uchar))
+  (part-len           :ulong)
+  (encrypted-part     (:pointer :uchar))
+  (encrypted-part-len (:pointer :ulong)))
+
+(defcfun (encrypt-final "C_EncryptFinal")    rv
+  (session                 session-handle)
+  (last-encrypted-part     (:pointer :uchar))
+  (last-encrypted-part-len (:pointer :ulong)))
+
+(defcfun (decrypt-init "C_DecryptInit")    rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (key       object-handle))
+
+(defcfun (decrypt "C_Decrypt")    rv
+  (session            session-handle)
+  (encrypted-data     (:pointer :uchar))
+  (encrypted-data-len :ulong)
+  (data               (:pointer :uchar))
+  (data-len           (:pointer :ulong)))
+
+(defcfun (decrypt-update "C_DecryptUpdate")    rv
+  (session            session-handle)
+  (encrypted-part     (:pointer :uchar))
+  (encrypted-part-len :ulong)
+  (part               (:pointer :uchar))
+  (part-len           (:pointer :ulong)))
+
+(defcfun (decrypt-final "C_DecryptFinal")    rv
+  (session       session-handle)
+  (last-part     (:pointer :uchar))
+  (last-part-len (:pointer :ulong)))
+
+(defcfun (digest-init "C_DigestInit") rv (session session-handle) (mechanism (:pointer (:struct mechanism))))
+
+(defcfun (digest "C_Digest")    rv
+  (session    session-handle)
+  (data       (:pointer :uchar))
+  (data-len   :ulong)
+  (digest     (:pointer :uchar))
+  (digest-len (:pointer :ulong)))
+
+(defcfun (digest-update "C_DigestUpdate") rv (session session-handle) (part (:pointer :uchar)) (part-len :ulong))
+(defcfun (digest-key    "C_DigestKey")    rv (session session-handle) (key  object-handle))
+
+(defcfun (digest-final "C_DigestFinal")    rv
+  (session    session-handle)
+  (digest     (:pointer :uchar))
+  (digest-len (:pointer :ulong)))
+
+(defcfun (sign-init "C_SignInit")    rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (key       object-handle))
+
+(defcfun (sign "C_Sign")    rv
+  (session       session-handle)
+  (data          (:pointer :uchar))
+  (data-len      :ulong)
+  (signature     (:pointer :uchar))
+  (signature-len (:pointer :ulong)))
+
+(defcfun (sign-update "C_SignUpdate") rv
+  (session  session-handle)
+  (part     (:pointer :uchar))
+  (part-len :ulong))
+
+(defcfun (sign-final "C_SignFinal")    rv
+  (session       session-handle)
+  (signature     (:pointer :uchar))
+  (signature-len (:pointer :ulong)))
+
+(defcfun (sign-recover-init "C_SignRecoverInit")    rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (key       object-handle))
+
+(defcfun (sign-recover "C_SignRecover")    rv
+  (session       session-handle)
+  (data          (:pointer :uchar))
+  (data-len      :ulong)
+  (signature     (:pointer :uchar))
+  (signature-len (:pointer :ulong)))
+
+(defcfun (verify-init "C_VerifyInit")    rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (key       object-handle))
+
+(defcfun (verify "C_Verify")    rv
+  (session       session-handle)
+  (data          (:pointer :uchar))
+  (data-len      :ulong)
+  (signature     (:pointer :uchar))
+  (signature-len :ulong))
+
+(defcfun (verify-update "C_VerifyUpdate") rv
+  (session  session-handle)
+  (part     (:pointer :uchar))
+  (part-len :ulong))
+
+(defcfun (verify-final "C_VerifyFinal")    rv
+  (session       session-handle)
+  (signature     (:pointer :uchar))
+  (signature-len :ulong))
+
+(defcfun (verify-recover-init "C_VerifyRecoverInit")    rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (key       object-handle))
+
+(defcfun (verify-recover "C_VerifyRecover")    rv
+  (session       session-handle)
+  (signature     (:pointer :uchar))
+  (signature-len :ulong)
+  (data          (:pointer :uchar))
+  (data-len      (:pointer :ulong)))
+
+(defcfun (digest-encrypt-update "C_DigestEncryptUpdate")    rv
+  (session            session-handle)
+  (part               (:pointer :uchar))
+  (part-len           :ulong)
+  (encrypted-part     (:pointer :uchar))
+  (encrypted-part-len (:pointer :ulong)))
+
+(defcfun (decrypt-digest-update "C_DecryptDigestUpdate")    rv
+  (session            session-handle)
+  (encrypted-part     (:pointer :uchar))
+  (encrypted-part-len :ulong)
+  (part               (:pointer :uchar))
+  (part-len           (:pointer :ulong)))
+
+(defcfun (sign-encrypt-update "C_SignEncryptUpdate")    rv
+  (session            session-handle)
+  (part               (:pointer :uchar))
+  (part-len           :ulong)
+  (encrypted-part     (:pointer :uchar))
+  (encrypted-part-len (:pointer :ulong)))
+
+(defcfun (decrypt-verify-update "C_DecryptVerifyUpdate")  rv
+  (session            session-handle)
+  (encrypted-part     (:pointer :uchar))
+  (encrypted-part-len :ulong)
+  (part               (:pointer :uchar))
+  (part-len           (:pointer :ulong)))
+
+(defcfun (generate-key "C_GenerateKey")  rv
+  (session   session-handle)
+  (mechanism (:pointer (:struct mechanism)))
+  (templ     (:pointer (:struct attribute)))
+  (count     :ulong)
+  (key       (:pointer object-handle)))
+
+(defcfun (generate-key-pair "C_GenerateKeyPair") rv
+  (session                     session-handle)
+  (mechanism                   (:pointer (:struct mechanism)))
+  (public-key-template         (:pointer (:struct attribute)))
+  (public-key-attribute-count  :ulong)
+  (private-key-template        (:pointer (:struct attribute)))
+  (private-key-attribute-count :ulong)
+  (public-key                  (:pointer object-handle))
+  (private-key                 (:pointer object-handle)))
+
+(defcfun (wrap-key "C_WrapKey")    rv
+  (session         session-handle)
+  (mechanism       (:pointer (:struct mechanism)))
+  (wrapping-key    object-handle)
+  (key             object-handle)
+  (wrapped-key     (:pointer :uchar))
+  (wrapped-key-len (:pointer :ulong)))
+
+(defcfun (unwrap-key "C_UnwrapKey")    rv
+  (session         session-handle)
+  (mechanism       (:pointer (:struct mechanism)))
+  (unwrapping-key  object-handle)
+  (wrapped-key     (:pointer :uchar))
+  (wrapped-key-len :ulong)
+  (templ           (:pointer (:struct attribute)))
+  (attribute-count :ulong)
+  (key             (:pointer object-handle)))
+
+(defcfun (derive-key "C_DeriveKey")    rv
+  (session         session-handle)
+  (mechanism       (:pointer (:struct mechanism)))
+  (base-key        object-handle)
+  (templ           (:pointer (:struct attribute)))
+  (attribute-count :ulong)
+  (key             (:pointer object-handle)))
+
+(defcfun (seed-random         "C_SeedRandom")        rv  (session session-handle)  (seed        (:pointer :uchar))  (seed-len   :ulong))
+(defcfun (generate-random     "C_GenerateRandom")    rv  (session session-handle)  (random-data (:pointer :uchar))  (random-len :ulong))
+(defcfun (get-function-status "C_GetFunctionStatus") rv  (session session-handle))
+(defcfun (cancel-function     "C_CancelFunction")    rv  (session session-handle))
+
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/pkcs11.lisp b/clext/pkcs11/pkcs11.lisp
new file mode 100644
index 0000000..ece3bdc
--- /dev/null
+++ b/clext/pkcs11/pkcs11.lisp
@@ -0,0 +1,2195 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               pkcs11.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Lispy interface over Cryptoki pkcs11 version 2.02.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2018-04-18 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2018 - 2018
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.PKCS11"
+  (:use "COMMON-LISP" "CFFI" "BABEL")
+  (:use "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-UTILS")
+  (:import-from "COM.INFORMATIMAGO.CLEXT.PKCS11.LOW" "LOAD-LIBRARY")
+  (:shadowing-import-from "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-DEBUG"
+                          "FOREIGN-ALLOC" "FOREIGN-FREE")
+  (:export "PKCS11-ERROR"
+           "PKCS11-ERROR-CODE" "PKCS11-ERROR-LABEL" "PKCS11-ERROR-FUNCTION"
+           "CHECK-RV" "WITH-PKCS11"
+           "RETURN-VALUE" "CONVERT-SLOT-INFO-FLAGS" "CONVERT-TOKEN-INFO-FLAGS"
+           "USER-TYPE" "STATE" "CONVERT-SESSION-INFO-FLAGS"
+           "CONVERT-WAIT-FOR-SLOT-EVENT-FLAGS" "OBJECT-CLASS" "HARDWARE-FEATURE"
+           "KEY-TYPE" "CERTIFICATE-TYPE" "ATTRIBUTE-TYPE" "MECHANISM-TYPE"
+           "CONVERT-MECHANISM-INFO-FLAGS" "CKBOOL" "UNAVAILABLE-INFORMATION-P"
+           "INVALID-POINTER-P" "VERSION" "MAKE-VERSION" "VERSION-P"
+           "COPY-VERSION" "VERSION-MAJOR" "VERSION-MINOR" "VERSION" "INFO"
+           "MAKE-INFO" "INFO-P" "COPY-INFO" "INFO-CRYPTOKI-VERSION"
+           "INFO-MANUFACTURER-ID" "INFO-FLAGS" "INFO-LIBRARY-DESCRIPTION"
+           "INFO-LIBRARY-VERSION" "GET-INFO" "GET-SLOT-LIST" "SLOT-INFO"
+           "MAKE-SLOT-INFO" "SLOT-INFO-P" "COPY-SLOT-INFO"
+           "SLOT-INFO-SLOT-DESCRIPTION" "SLOT-INFO-MANUFACTURER-ID"
+           "SLOT-INFO-FLAGS" "SLOT-INFO-HARDWARE-VERSION"
+           "SLOT-INFO-FIRMWARE-VERSION" "GET-SLOT-INFO" "TOKEN-INFO"
+           "MAKE-TOKEN-INFO" "TOKEN-INFO-P" "COPY-TOKEN-INFO" "TOKEN-INFO-LABEL"
+           "TOKEN-INFO-MANUFACTURER-ID" "TOKEN-INFO-MODEL"
+           "TOKEN-INFO-SERIAL-NUMBER" "TOKEN-INFO-FLAGS"
+           "TOKEN-INFO-MAX-SESSION-COUNT" "TOKEN-INFO-SESSION-COUNT"
+           "TOKEN-INFO-MAX-RW-SESSION-COUNT" "TOKEN-INFO-RW-SESSION-COUNT"
+           "TOKEN-INFO-MAX-PIN-LEN" "TOKEN-INFO-MIN-PIN-LEN"
+           "TOKEN-INFO-TOTAL-PUBLIC-MEMORY" "TOKEN-INFO-FREE-PUBLIC-MEMORY"
+           "TOKEN-INFO-TOTAL-PRIVATE-MMEORY" "TOKEN-INFO-FREE-PRIVATE-MEMORY"
+           "TOKEN-INFO-HARDWARE-VERSION" "TOKEN-INFO-FIRMWARE-VERSION"
+           "TOKEN-INFO-UTC-TIME" "GET-TOKEN-INFO" "WAIT-FOR-SLOT-EVENT"
+           "GET-MECHANISM-LIST" "MECHANISM-INFO" "MAKE-MECHANISM-INFO"
+           "MECHANISM-INFO-P" "COPY-MECHANISM-INFO" "MECHANISM-INFO-MIN-KEY-SIZE"
+           "MECHANISM-INFO-MAX-KEY-SIZE" "MECHANISM-INFO-FLAGS"
+           "GET-MECHANISM-INFO" "STRING-FROM-UTF-8" "INIT-TOKEN" "OPEN-SESSION"
+           "CLOSE-SESSION" "CLOSE-ALL-SESSIONS" "WITH-OPEN-SESSION"
+           "SESSION-INFO" "MAKE-SESSION-INFO" "SESSION-INFO-P"
+           "COPY-SESSION-INFO" "SESSION-INFO-SLOT-ID" "SESSION-INFO-STATE"
+           "SESSION-INFO-FLAGS" "SESSION-INFO-DEVICE-ERROR" "GET-SESSION-INFO"
+           "GET-OPERATION-STATE" "SET-OPERATION-STATE" "LOGIN" "LOGOUT"
+           "INIT-PIN" "SET-PIN" "READ-PIN" "CREATE-OBJECT" "COPY-OBJECT"
+           "DESTROY-OBJECT" "GET-OBJECT-SIZE" "GET-ATTRIBUTE-VALUE"
+           "SET-ATTRIBUTE-VALUE" "FIND-OBJECTS-INIT" "FIND-OBJECTS"
+           "FIND-OBJECTS-FINAL" "FIND-ALL-OBJECTS" "OBJECT-GET-ALL-ATTRIBUTES"
+           "SEED-RANDOM" "GENERATE-RANDOM" "LOAD-LIBRARY"
+           "CALL-LOGGED-IN" "DO-LOGGED-IN")
+
+  (:documentation "Lispy interface over Cryptoki pkcs11 version 2.02
+
+License:
+
+    AGPL3
+
+    Copyright Pascal J. Bourguignon 2018 - 2018
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Affero General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Affero General Public License for more details.
+
+    You should have received a copy of the GNU Affero General Public License
+    along with this program.
+    If not, see <http://www.gnu.org/licenses/>
+
+"))
+
+(in-package "COM.INFORMATIMAGO.CLEXT.PKCS11")
+
+(deftype octet           () '(unsigned-byte 8))
+
+(deftype session-handle  () `(unsigned-byte 32))
+(deftype slot-id         () `(unsigned-byte 32))
+(deftype mechanismi-type () `(unsigned-byte 32))
+(deftype object-handle   () `(unsigned-byte 32))
+
+
+
+(defun flags (operation flags map)
+  (ecase operation
+    ((:decode)
+     (loop :for (flag . keyword) :in map
+           :when (= flag (logand flags flag))
+             :collect keyword))
+    ((:encode)
+     (loop :for (flag . keyword) :in map
+           :when (member keyword flags)
+             :sum flag))))
+
+(defun enum (operation value map)
+  (ecase operation
+    ((:decode) (or (cdr (assoc  value map)) value))
+    ((:encode) (or (car (rassoc value map))
+                   (error "Unknown enum keyword ~S, expected one of `{~S~^ ~}."
+                          value (mapcar (function cdr) map))))))
+
+(defmacro define-flag-converter (name map)
+  `(defun ,name (operation value)
+     (flags operation value (load-time-value
+                             (list ,@(mapcar (lambda (entry)
+                                               "(ck-constant keyword) -> (cons ck-constant keyword)"
+                                               `(cons ,@entry))
+                                             map))))))
+
+(defmacro define-enum-converter (name map)
+  `(defun ,name (operation value)
+     (enum operation value (load-time-value
+                            (list ,@(mapcar (lambda (entry)
+                                              "(ck-constant keyword) -> (cons ck-constant keyword)"
+                                              `(cons ,@entry))
+                                            map))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Converters
+
+(define-enum-converter return-value
+    ((%ck:+ok+                                 :ok)
+     (%ck:+cancel+                             :cancel)
+     (%ck:+host-memory+                        :host-memory)
+     (%ck:+slot-id-invalid+                    :slot-id-invalid)
+     (%ck:+general-error+                      :general-error)
+     (%ck:+function-failed+                    :function-failed)
+     (%ck:+arguments-bad+                      :arguments-bad)
+     (%ck:+no-event+                           :no-event)
+     (%ck:+need-to-create-threads+             :need-to-create-threads)
+     (%ck:+cant-lock+                          :cant-lock)
+     (%ck:+attribute-read-only+                :attribute-read-only)
+     (%ck:+attribute-sensitive+                :attribute-sensitive)
+     (%ck:+attribute-type-invalid+             :attribute-type-invalid)
+     (%ck:+attribute-value-invalid+            :attribute-value-invalid)
+     (%ck:+data-invalid+                       :data-invalid)
+     (%ck:+data-len-range+                     :data-len-range)
+     (%ck:+device-error+                       :device-error)
+     (%ck:+device-memory+                      :device-memory)
+     (%ck:+device-removed+                     :device-removed)
+     (%ck:+encrypted-data-invalid+             :encrypted-data-invalid)
+     (%ck:+encrypted-data-len-range+           :encrypted-data-len-range)
+     (%ck:+function-canceled+                  :function-canceled)
+     (%ck:+function-not-parallel+              :function-not-parallel)
+     (%ck:+function-not-supported+             :function-not-supported)
+     (%ck:+key-handle-invalid+                 :key-handle-invalid)
+     (%ck:+key-size-range+                     :key-size-range)
+     (%ck:+key-type-inconsistent+              :key-type-inconsistent)
+     (%ck:+key-not-needed+                     :key-not-needed)
+     (%ck:+key-changed+                        :key-changed)
+     (%ck:+key-needed+                         :key-needed)
+     (%ck:+key-indigestible+                   :key-indigestible)
+     (%ck:+key-function-not-permitted+         :key-function-not-permitted)
+     (%ck:+key-not-wrappable+                  :key-not-wrappable)
+     (%ck:+key-unextractable+                  :key-unextractable)
+     (%ck:+mechanism-invalid+                  :mechanism-invalid)
+     (%ck:+mechanism-param-invalid+            :mechanism-param-invalid)
+     (%ck:+object-handle-invalid+              :object-handle-invalid)
+     (%ck:+operation-active+                   :operation-active)
+     (%ck:+operation-not-initialized+          :operation-not-initialized)
+     (%ck:+pin-incorrect+                      :pin-incorrect)
+     (%ck:+pin-invalid+                        :pin-invalid)
+     (%ck:+pin-len-range+                      :pin-len-range)
+     (%ck:+pin-expired+                        :pin-expired)
+     (%ck:+pin-locked+                         :pin-locked)
+     (%ck:+session-closed+                     :session-closed)
+     (%ck:+session-count+                      :session-count)
+     (%ck:+session-handle-invalid+             :session-handle-invalid)
+     (%ck:+session-parallel-not-supported+     :session-parallel-not-supported)
+     (%ck:+session-read-only+                  :session-read-only)
+     (%ck:+session-exists+                     :session-exists)
+     (%ck:+session-read-only-exists+           :session-read-only-exists)
+     (%ck:+session-read-write-so-exists+       :session-read-write-so-exists)
+     (%ck:+signature-invalid+                  :signature-invalid)
+     (%ck:+signature-len-range+                :signature-len-range)
+     (%ck:+template-incomplete+                :template-incomplete)
+     (%ck:+template-inconsistent+              :template-inconsistent)
+     (%ck:+token-not-present+                  :token-not-present)
+     (%ck:+token-not-recognized+               :token-not-recognized)
+     (%ck:+token-write-protected+              :token-write-protected)
+     (%ck:+unwrapping-key-handle-invalid+      :unwrapping-key-handle-invalid)
+     (%ck:+unwrapping-key-size-range+          :unwrapping-key-size-range)
+     (%ck:+unwrapping-key-type-inconsistent+   :unwrapping-key-type-inconsistent)
+     (%ck:+user-already-logged-in+             :user-already-logged-in)
+     (%ck:+user-not-logged-in+                 :user-not-logged-in)
+     (%ck:+user-pin-not-initialized+           :user-pin-not-initialized)
+     (%ck:+user-type-invalid+                  :user-type-invalid)
+     (%ck:+user-another-already-logged-in+     :user-another-already-logged-in)
+     (%ck:+user-too-many-types+                :user-too-many-types)
+     (%ck:+wrapped-key-invalid+                :wrapped-key-invalid)
+     (%ck:+wrapped-key-len-range+              :wrapped-key-len-range)
+     (%ck:+wrapping-key-handle-invalid+        :wrapping-key-handle-invalid)
+     (%ck:+wrapping-key-size-range+            :wrapping-key-size-range)
+     (%ck:+wrapping-key-type-inconsistent+     :wrapping-key-type-inconsistent)
+     (%ck:+random-seed-not-supported+          :random-seed-not-supported)
+     (%ck:+random-no-rng+                      :random-no-rng)
+     (%ck:+domain-params-invalid+              :domain-params-invalid)
+     (%ck:+buffer-too-small+                   :buffer-too-small)
+     (%ck:+saved-state-invalid+                :saved-state-invalid)
+     (%ck:+information-sensitive+              :information-sensitive)
+     (%ck:+state-unsaveable+                   :state-unsaveable)
+     (%ck:+cryptoki-not-initialized+           :cryptoki-not-initialized)
+     (%ck:+cryptoki-already-initialized+       :cryptoki-already-initialized)
+     (%ck:+mutex-bad+                          :mutex-bad)
+     (%ck:+mutex-not-locked+                   :mutex-not-locked)
+     (%ck:+function-rejected+                  :function-rejected)))
+
+(define-flag-converter convert-slot-info-flags
+    ((%ck:+token-present+     :token-present)
+     (%ck:+removable-device+  :removable-device)
+     (%ck:+hw-slot+           :hardware-slot)
+     (%ck:+array-attribute+   :array-attribute)))
+
+(define-flag-converter convert-token-info-flags
+    ((%ck:+rng+                            :rng)
+     (%ck:+write-protected+                :write-protected)
+     (%ck:+login-required+                 :login-required)
+     (%ck:+user-pin-initialized+           :user-pin-initialized)
+     (%ck:+restore-key-not-needed+         :restore-key-not-needed)
+     (%ck:+clock-on-token+                 :clock-on-token)
+     (%ck:+protected-authentication-path+  :protected-authentication-path)
+     (%ck:+dual-crypto-operations+         :dual-crypto-operations)
+     (%ck:+token-initialized+              :token-initialized)
+     (%ck:+secondary-authentication+       :secondary-authentication)
+     (%ck:+user-pin-count-low+             :user-pin-count-low)
+     (%ck:+user-pin-final-try+             :user-pin-final-try)
+     (%ck:+user-pin-locked+                :user-pin-locked)
+     (%ck:+user-pin-to-be-changed+         :user-pin-to-be-changed)
+     (%ck:+so-pin-count-low+               :so-pin-count-low)
+     (%ck:+so-pin-final-try+               :so-pin-final-try)
+     (%ck:+so-pin-locked+                  :so-pin-locked)
+     (%ck:+so-pin-to-be-changed+           :so-pin-to-be-changed)))
+
+(define-enum-converter user-type
+    ((%ck:+so+                :so)
+     (%ck:+user+              :user)
+     (%ck:+context-specific+  :context-specific)))
+
+(define-enum-converter state
+    ((%ck:+ro-public-session+  :ro-public-session)
+     (%ck:+ro-user-functions+  :ro-user-functions)
+     (%ck:+rw-public-session+  :rw-public-session)
+     (%ck:+rw-user-functions+  :rw-user-functions)
+     (%ck:+rw-so-functions+    :rw-so-functions)))
+
+(define-flag-converter convert-session-info-flags
+    ((%ck:+rw-session+        :rw-session)
+     (%ck:+serial-session+    :serial-session)))
+
+(define-flag-converter convert-wait-for-slot-event-flags
+    ((%ck:+DONT-BLOCK+ :dont-block)))
+
+(define-enum-converter object-class
+    ((%ck:+o-data+              :data)
+     (%ck:+o-certificate+       :certificate)
+     (%ck:+o-public-key+        :public-key)
+     (%ck:+o-private-key+       :private-key)
+     (%ck:+o-secret-key+        :secret-key)
+     (%ck:+o-hw-feature+        :hw-feature)
+     (%ck:+o-domain-parameters+ :domain-parameters)
+     (%ck:+o-mechanism+         :mechanism)
+     (%ck:+vendor-defined+      :vendor-defined)))
+
+(define-enum-converter hardware-feature
+    ((%ck:+h-monotonic-counter+ :monotonic-count)
+     (%ck:+h-clock+             :clock)
+     (%ck:+h-user-interface+    :user-interface)
+     (%ck:+vendor-defined+      :vendor-defined)))
+
+(define-enum-converter key-type
+    ((%ck:+k-rsa+             :rsa)
+     (%ck:+k-dsa+             :dsa)
+     (%ck:+k-dh+              :dh)
+     (%ck:+k-ecdsa+           :ecdsa)
+     (%ck:+k-ec+              :ec)
+     (%ck:+k-x9-42-dh+        :x9-42-dh)
+     (%ck:+k-kea+             :kea)
+     (%ck:+k-generic-secret+  :generic-secret)
+     (%ck:+k-rc2+             :rc2)
+     (%ck:+k-rc4+             :rc4)
+     (%ck:+k-des+             :des)
+     (%ck:+k-des2+            :des2)
+     (%ck:+k-des3+            :des3)
+     (%ck:+k-cast+            :cast)
+     (%ck:+k-cast3+           :cast3)
+     (%ck:+k-cast128+         :cast128)
+     (%ck:+k-rc5+             :rc5)
+     (%ck:+k-idea+            :idea)
+     (%ck:+k-skipjack+        :skipjack)
+     (%ck:+k-baton+           :baton)
+     (%ck:+k-juniper+         :juniper)
+     (%ck:+k-cdmf+            :cdmf)
+     (%ck:+k-aes+             :aes)
+     (%ck:+k-blowfish+        :blowfish)
+     (%ck:+k-twofish+         :twofish)
+     (%ck:+vendor-defined+    :vendor-defined)))
+
+(define-enum-converter certificate-type
+    ((%ck:+c-x-509+            :x-509)
+     (%ck:+c-x-509-attr-cert+  :x-509-attr-cert)
+     (%ck:+c-wtls+             :wtls)
+     (%ck:+vendor-defined+     :vendor-defined)))
+
+(define-enum-converter attribute-type
+    ((%ck:+a-class+                       :class)
+     (%ck:+a-token+                       :token)
+     (%ck:+a-private+                     :private)
+     (%ck:+a-label+                       :label)
+     (%ck:+a-application+                 :application)
+     (%ck:+a-value+                       :value)
+     (%ck:+a-object-id+                   :object-id)
+     (%ck:+a-certificate-type+            :certificate-type)
+     (%ck:+a-issuer+                      :issuer)
+     (%ck:+a-serial-number+               :serial-number)
+     (%ck:+a-ac-issuer+                   :ac-issuer)
+     (%ck:+a-owner+                       :owner)
+     (%ck:+a-attr-types+                  :attr-types)
+     (%ck:+a-trusted+                     :trusted)
+     (%ck:+a-certificate-category+        :certificate-category)
+     (%ck:+a-java-midp-security-domain+   :java-midp-security-domain)
+     (%ck:+a-url+                         :url)
+     (%ck:+a-hash-of-subject-public-key+  :hash-of-subject-public-key)
+     (%ck:+a-hash-of-issuer-public-key+   :hash-of-issuer-public-key)
+     (%ck:+a-check-value+                 :check-value)
+     (%ck:+a-key-type+                    :key-type)
+     (%ck:+a-subject+                     :subject)
+     (%ck:+a-id+                          :id)
+     (%ck:+a-sensitive+                   :sensitive)
+     (%ck:+a-encrypt+                     :encrypt)
+     (%ck:+a-decrypt+                     :decrypt)
+     (%ck:+a-wrap+                        :wrap)
+     (%ck:+a-unwrap+                      :unwrap)
+     (%ck:+a-sign+                        :sign)
+     (%ck:+a-sign-recover+                :sign-recover)
+     (%ck:+a-verify+                      :verify)
+     (%ck:+a-verify-recover+              :verify-recover)
+     (%ck:+a-derive+                      :derive)
+     (%ck:+a-start-date+                  :start-date)
+     (%ck:+a-end-date+                    :end-date)
+     (%ck:+a-modulus+                     :modulus)
+     (%ck:+a-modulus-bits+                :modulus-bits)
+     (%ck:+a-public-exponent+             :public-exponent)
+     (%ck:+a-private-exponent+            :private-exponent)
+     (%ck:+a-prime-1+                     :prime-1)
+     (%ck:+a-prime-2+                     :prime-2)
+     (%ck:+a-exponent-1+                  :exponent-1)
+     (%ck:+a-exponent-2+                  :exponent-2)
+     (%ck:+a-coefficient+                 :coefficient)
+     (%ck:+a-prime+                       :prime)
+     (%ck:+a-subprime+                    :subprime)
+     (%ck:+a-base+                        :base)
+     (%ck:+a-prime-bits+                  :prime-bits)
+     (%ck:+a-sub-prime-bits+              :sub-prime-bits)
+     (%ck:+a-value-bits+                  :value-bits)
+     (%ck:+a-value-len+                   :value-len)
+     (%ck:+a-extractable+                 :extractable)
+     (%ck:+a-local+                       :local)
+     (%ck:+a-never-extractable+           :never-extractable)
+     (%ck:+a-always-sensitive+            :always-sensitive)
+     (%ck:+a-key-gen-mechanism+           :key-gen-mechanism)
+     (%ck:+a-modifiable+                  :modifiable)
+     (%ck:+a-ecdsa-params+                :ecdsa-params)
+     (%ck:+a-ec-params+                   :ec-params)
+     (%ck:+a-ec-point+                    :ec-point)
+     (%ck:+a-secondary-auth+              :secondary-auth)
+     (%ck:+a-auth-pin-flags+              :auth-pin-flags)
+     (%ck:+a-always-authenticate+         :always-authenticate)
+     (%ck:+a-wrap-with-trusted+           :wrap-with-trusted)
+     (%ck:+a-hw-feature-type+             :hw-feature-type)
+     (%ck:+a-reset-on-init+               :reset-on-init)
+     (%ck:+a-has-reset+                   :has-reset)
+     (%ck:+a-pixel-x+                     :pixel-x)
+     (%ck:+a-pixel-y+                     :pixel-y)
+     (%ck:+a-resolution+                  :resolution)
+     (%ck:+a-char-rows+                   :char-rows)
+     (%ck:+a-char-columns+                :char-columns)
+     (%ck:+a-color+                       :color)
+     (%ck:+a-bits-per-pixel+              :bits-per-pixel)
+     (%ck:+a-char-sets+                   :char-sets)
+     (%ck:+a-encoding-methods+            :encoding-methods)
+     (%ck:+a-mime-types+                  :mime-types)
+     (%ck:+a-mechanism-type+              :mechanism-type)
+     (%ck:+a-required-cms-attributes+     :required-cms-attributes)
+     (%ck:+a-default-cms-attributes+      :default-cms-attributes)
+     (%ck:+a-supported-cms-attributes+    :supported-cms-attributes)
+     (%ck:+a-wrap-template+               :wrap-template)
+     (%ck:+a-unwrap-template+             :unwrap-template)
+     (%ck:+a-allowed-mechanisms+          :allowed-mechanisms)
+     (%ck:+vendor-defined+                :vendor-defined)))
+
+(define-enum-converter mechanism-type
+    ((%ck:+m-rsa-pkcs-key-pair-gen+      :rsa-pkcs-key-pair-gen)
+     (%ck:+m-rsa-pkcs+                   :rsa-pkcs)
+     (%ck:+m-rsa-9796+                   :rsa-9796)
+     (%ck:+m-rsa-x-509+                  :rsa-x-509)
+     (%ck:+m-md2-rsa-pkcs+               :md2-rsa-pkcs)
+     (%ck:+m-md5-rsa-pkcs+               :md5-rsa-pkcs)
+     (%ck:+m-sha1-rsa-pkcs+              :sha1-rsa-pkcs)
+     (%ck:+m-ripemd128-rsa-pkcs+         :ripemd128-rsa-pkcs)
+     (%ck:+m-ripemd160-rsa-pkcs+         :ripemd160-rsa-pkcs)
+     (%ck:+m-rsa-pkcs-oaep+              :rsa-pkcs-oaep)
+     (%ck:+m-rsa-x9-31-key-pair-gen+     :rsa-x9-31-key-pair-gen)
+     (%ck:+m-rsa-x9-31+                  :rsa-x9-31)
+     (%ck:+m-sha1-rsa-x9-31+             :sha1-rsa-x9-31)
+     (%ck:+m-rsa-pkcs-pss+               :rsa-pkcs-pss)
+     (%ck:+m-sha1-rsa-pkcs-pss+          :sha1-rsa-pkcs-pss)
+     (%ck:+m-dsa-key-pair-gen+           :dsa-key-pair-gen)
+     (%ck:+m-dsa+                        :dsa)
+     (%ck:+m-dsa-sha1+                   :dsa-sha1)
+     (%ck:+m-dh-pkcs-key-pair-gen+       :dh-pkcs-key-pair-gen)
+     (%ck:+m-dh-pkcs-derive+             :dh-pkcs-derive)
+     (%ck:+m-x9-42-dh-key-pair-gen+      :x9-42-dh-key-pair-gen)
+     (%ck:+m-x9-42-dh-derive+            :x9-42-dh-derive)
+     (%ck:+m-x9-42-dh-hybrid-derive+     :x9-42-dh-hybrid-derive)
+     (%ck:+m-x9-42-mqv-derive+           :x9-42-mqv-derive)
+     (%ck:+m-sha256-rsa-pkcs+            :sha256-rsa-pkcs)
+     (%ck:+m-sha384-rsa-pkcs+            :sha384-rsa-pkcs)
+     (%ck:+m-sha512-rsa-pkcs+            :sha512-rsa-pkcs)
+     (%ck:+m-sha256-rsa-pkcs-pss+        :sha256-rsa-pkcs-pss)
+     (%ck:+m-sha384-rsa-pkcs-pss+        :sha384-rsa-pkcs-pss)
+     (%ck:+m-sha512-rsa-pkcs-pss+        :sha512-rsa-pkcs-pss)
+     (%ck:+m-rc2-key-gen+                :rc2-key-gen)
+     (%ck:+m-rc2-ecb+                    :rc2-ecb)
+     (%ck:+m-rc2-cbc+                    :rc2-cbc)
+     (%ck:+m-rc2-mac+                    :rc2-mac)
+     (%ck:+m-rc2-mac-general+            :rc2-mac-general)
+     (%ck:+m-rc2-cbc-pad+                :rc2-cbc-pad)
+     (%ck:+m-rc4-key-gen+                :rc4-key-gen)
+     (%ck:+m-rc4+                        :rc4)
+     (%ck:+m-des-key-gen+                :des-key-gen)
+     (%ck:+m-des-ecb+                    :des-ecb)
+     (%ck:+m-des-cbc+                    :des-cbc)
+     (%ck:+m-des-mac+                    :des-mac)
+     (%ck:+m-des-mac-general+            :des-mac-general)
+     (%ck:+m-des-cbc-pad+                :des-cbc-pad)
+     (%ck:+m-des2-key-gen+               :des2-key-gen)
+     (%ck:+m-des3-key-gen+               :des3-key-gen)
+     (%ck:+m-des3-ecb+                   :des3-ecb)
+     (%ck:+m-des3-cbc+                   :des3-cbc)
+     (%ck:+m-des3-mac+                   :des3-mac)
+     (%ck:+m-des3-mac-general+           :des3-mac-general)
+     (%ck:+m-des3-cbc-pad+               :des3-cbc-pad)
+     (%ck:+m-cdmf-key-gen+               :cdmf-key-gen)
+     (%ck:+m-cdmf-ecb+                   :cdmf-ecb)
+     (%ck:+m-cdmf-cbc+                   :cdmf-cbc)
+     (%ck:+m-cdmf-mac+                   :cdmf-mac)
+     (%ck:+m-cdmf-mac-general+           :cdmf-mac-general)
+     (%ck:+m-cdmf-cbc-pad+               :cdmf-cbc-pad)
+     (%ck:+m-md2+                        :md2)
+     (%ck:+m-md2-hmac+                   :md2-hmac)
+     (%ck:+m-md2-hmac-general+           :md2-hmac-general)
+     (%ck:+m-md5+                        :md5)
+     (%ck:+m-md5-hmac+                   :md5-hmac)
+     (%ck:+m-md5-hmac-general+           :md5-hmac-general)
+     (%ck:+m-sha-1+                      :sha-1)
+     (%ck:+m-sha-1-hmac+                 :sha-1-hmac)
+     (%ck:+m-sha-1-hmac-general+         :sha-1-hmac-general)
+     (%ck:+m-ripemd128+                  :ripemd128)
+     (%ck:+m-ripemd128-hmac+             :ripemd128-hmac)
+     (%ck:+m-ripemd128-hmac-general+     :ripemd128-hmac-general)
+     (%ck:+m-ripemd160+                  :ripemd160)
+     (%ck:+m-ripemd160-hmac+             :ripemd160-hmac)
+     (%ck:+m-ripemd160-hmac-general+     :ripemd160-hmac-general)
+     (%ck:+m-sha256+                     :sha256)
+     (%ck:+m-sha256-hmac+                :sha256-hmac)
+     (%ck:+m-sha256-hmac-general+        :sha256-hmac-general)
+     (%ck:+m-sha384+                     :sha384)
+     (%ck:+m-sha384-hmac+                :sha384-hmac)
+     (%ck:+m-sha384-hmac-general+        :sha384-hmac-general)
+     (%ck:+m-sha512+                     :sha512)
+     (%ck:+m-sha512-hmac+                :sha512-hmac)
+     (%ck:+m-sha512-hmac-general+        :sha512-hmac-general)
+     (%ck:+m-cast-key-gen+               :cast-key-gen)
+     (%ck:+m-cast-ecb+                   :cast-ecb)
+     (%ck:+m-cast-cbc+                   :cast-cbc)
+     (%ck:+m-cast-mac+                   :cast-mac)
+     (%ck:+m-cast-mac-general+           :cast-mac-general)
+     (%ck:+m-cast-cbc-pad+               :cast-cbc-pad)
+     (%ck:+m-cast3-key-gen+              :cast3-key-gen)
+     (%ck:+m-cast3-ecb+                  :cast3-ecb)
+     (%ck:+m-cast3-cbc+                  :cast3-cbc)
+     (%ck:+m-cast3-mac+                  :cast3-mac)
+     (%ck:+m-cast3-mac-general+          :cast3-mac-general)
+     (%ck:+m-cast3-cbc-pad+              :cast3-cbc-pad)
+     (%ck:+m-cast5-key-gen+              :cast5-key-gen)
+     (%ck:+m-cast128-key-gen+            :cast128-key-gen)
+     (%ck:+m-cast5-ecb+                  :cast5-ecb)
+     (%ck:+m-cast128-ecb+                :cast128-ecb)
+     (%ck:+m-cast5-cbc+                  :cast5-cbc)
+     (%ck:+m-cast128-cbc+                :cast128-cbc)
+     (%ck:+m-cast5-mac+                  :cast5-mac)
+     (%ck:+m-cast128-mac+                :cast128-mac)
+     (%ck:+m-cast5-mac-general+          :cast5-mac-general)
+     (%ck:+m-cast128-mac-general+        :cast128-mac-general)
+     (%ck:+m-cast5-cbc-pad+              :cast5-cbc-pad)
+     (%ck:+m-cast128-cbc-pad+            :cast128-cbc-pad)
+     (%ck:+m-rc5-key-gen+                :rc5-key-gen)
+     (%ck:+m-rc5-ecb+                    :rc5-ecb)
+     (%ck:+m-rc5-cbc+                    :rc5-cbc)
+     (%ck:+m-rc5-mac+                    :rc5-mac)
+     (%ck:+m-rc5-mac-general+            :rc5-mac-general)
+     (%ck:+m-rc5-cbc-pad+                :rc5-cbc-pad)
+     (%ck:+m-idea-key-gen+               :idea-key-gen)
+     (%ck:+m-idea-ecb+                   :idea-ecb)
+     (%ck:+m-idea-cbc+                   :idea-cbc)
+     (%ck:+m-idea-mac+                   :idea-mac)
+     (%ck:+m-idea-mac-general+           :idea-mac-general)
+     (%ck:+m-idea-cbc-pad+               :idea-cbc-pad)
+     (%ck:+m-generic-secret-key-gen+     :generic-secret-key-gen)
+     (%ck:+m-concatenate-base-and-key+   :concatenate-base-and-key)
+     (%ck:+m-concatenate-base-and-data+  :concatenate-base-and-data)
+     (%ck:+m-concatenate-data-and-base+  :concatenate-data-and-base)
+     (%ck:+m-xor-base-and-data+          :xor-base-and-data)
+     (%ck:+m-extract-key-from-key+       :extract-key-from-key)
+     (%ck:+m-ssl3-pre-master-key-gen+    :ssl3-pre-master-key-gen)
+     (%ck:+m-ssl3-master-key-derive+     :ssl3-master-key-derive)
+     (%ck:+m-ssl3-key-and-mac-derive+    :ssl3-key-and-mac-derive)
+     (%ck:+m-ssl3-master-key-derive-dh+  :ssl3-master-key-derive-dh)
+     (%ck:+m-tls-pre-master-key-gen+     :tls-pre-master-key-gen)
+     (%ck:+m-tls-master-key-derive+      :tls-master-key-derive)
+     (%ck:+m-tls-key-and-mac-derive+     :tls-key-and-mac-derive)
+     (%ck:+m-tls-master-key-derive-dh+   :tls-master-key-derive-dh)
+     (%ck:+m-ssl3-md5-mac+               :ssl3-md5-mac)
+     (%ck:+m-ssl3-sha1-mac+              :ssl3-sha1-mac)
+     (%ck:+m-md5-key-derivation+         :md5-key-derivation)
+     (%ck:+m-md2-key-derivation+         :md2-key-derivation)
+     (%ck:+m-sha1-key-derivation+        :sha1-key-derivation)
+     (%ck:+m-pbe-md2-des-cbc+            :pbe-md2-des-cbc)
+     (%ck:+m-pbe-md5-des-cbc+            :pbe-md5-des-cbc)
+     (%ck:+m-pbe-md5-cast-cbc+           :pbe-md5-cast-cbc)
+     (%ck:+m-pbe-md5-cast3-cbc+          :pbe-md5-cast3-cbc)
+     (%ck:+m-pbe-md5-cast5-cbc+          :pbe-md5-cast5-cbc)
+     (%ck:+m-pbe-md5-cast128-cbc+        :pbe-md5-cast128-cbc)
+     (%ck:+m-pbe-sha1-cast5-cbc+         :pbe-sha1-cast5-cbc)
+     (%ck:+m-pbe-sha1-cast128-cbc+       :pbe-sha1-cast128-cbc)
+     (%ck:+m-pbe-sha1-rc4-128+           :pbe-sha1-rc4-128)
+     (%ck:+m-pbe-sha1-rc4-40+            :pbe-sha1-rc4-40)
+     (%ck:+m-pbe-sha1-des3-ede-cbc+      :pbe-sha1-des3-ede-cbc)
+     (%ck:+m-pbe-sha1-des2-ede-cbc+      :pbe-sha1-des2-ede-cbc)
+     (%ck:+m-pbe-sha1-rc2-128-cbc+       :pbe-sha1-rc2-128-cbc)
+     (%ck:+m-pbe-sha1-rc2-40-cbc+        :pbe-sha1-rc2-40-cbc)
+     (%ck:+m-pkcs5-pbkd2+                :pkcs5-pbkd2)
+     (%ck:+m-pba-sha1-with-sha1-hmac+    :pba-sha1-with-sha1-hmac)
+     (%ck:+m-key-wrap-lynks+             :key-wrap-lynks)
+     (%ck:+m-key-wrap-set-oaep+          :key-wrap-set-oaep)
+     (%ck:+m-skipjack-key-gen+           :skipjack-key-gen)
+     (%ck:+m-skipjack-ecb64+             :skipjack-ecb64)
+     (%ck:+m-skipjack-cbc64+             :skipjack-cbc64)
+     (%ck:+m-skipjack-ofb64+             :skipjack-ofb64)
+     (%ck:+m-skipjack-cfb64+             :skipjack-cfb64)
+     (%ck:+m-skipjack-cfb32+             :skipjack-cfb32)
+     (%ck:+m-skipjack-cfb16+             :skipjack-cfb16)
+     (%ck:+m-skipjack-cfb8+              :skipjack-cfb8)
+     (%ck:+m-skipjack-wrap+              :skipjack-wrap)
+     (%ck:+m-skipjack-private-wrap+      :skipjack-private-wrap)
+     (%ck:+m-skipjack-relayx+            :skipjack-relayx)
+     (%ck:+m-kea-key-pair-gen+           :kea-key-pair-gen)
+     (%ck:+m-kea-key-derive+             :kea-key-derive)
+     (%ck:+m-fortezza-timestamp+         :fortezza-timestamp)
+     (%ck:+m-baton-key-gen+              :baton-key-gen)
+     (%ck:+m-baton-ecb128+               :baton-ecb128)
+     (%ck:+m-baton-ecb96+                :baton-ecb96)
+     (%ck:+m-baton-cbc128+               :baton-cbc128)
+     (%ck:+m-baton-counter+              :baton-counter)
+     (%ck:+m-baton-shuffle+              :baton-shuffle)
+     (%ck:+m-baton-wrap+                 :baton-wrap)
+     (%ck:+m-ecdsa-key-pair-gen+         :ecdsa-key-pair-gen)
+     (%ck:+m-ec-key-pair-gen+            :ec-key-pair-gen)
+     (%ck:+m-ecdsa+                      :ecdsa)
+     (%ck:+m-ecdsa-sha1+                 :ecdsa-sha1)
+     (%ck:+m-ecdh1-derive+               :ecdh1-derive)
+     (%ck:+m-ecdh1-cofactor-derive+      :ecdh1-cofactor-derive)
+     (%ck:+m-ecmqv-derive+               :ecmqv-derive)
+     (%ck:+m-juniper-key-gen+            :juniper-key-gen)
+     (%ck:+m-juniper-ecb128+             :juniper-ecb128)
+     (%ck:+m-juniper-cbc128+             :juniper-cbc128)
+     (%ck:+m-juniper-counter+            :juniper-counter)
+     (%ck:+m-juniper-shuffle+            :juniper-shuffle)
+     (%ck:+m-juniper-wrap+               :juniper-wrap)
+     (%ck:+m-fasthash+                   :fasthash)
+     (%ck:+m-aes-key-gen+                :aes-key-gen)
+     (%ck:+m-aes-ecb+                    :aes-ecb)
+     (%ck:+m-aes-cbc+                    :aes-cbc)
+     (%ck:+m-aes-mac+                    :aes-mac)
+     (%ck:+m-aes-mac-general+            :aes-mac-general)
+     (%ck:+m-aes-cbc-pad+                :aes-cbc-pad)
+     (%ck:+m-dsa-parameter-gen+          :dsa-parameter-gen)
+     (%ck:+m-dh-pkcs-parameter-gen+      :dh-pkcs-parameter-gen)
+     (%ck:+m-x9-42-dh-parameter-gen+     :x9-42-dh-parameter-gen)
+     (%ck:+vendor-defined+               :vendor-defined)))
+
+(define-flag-converter convert-mechanism-info-flags
+    ((%ck:+f-hw+                 :hw)
+     (%ck:+f-encrypt+            :encrypt)
+     (%ck:+f-decrypt+            :decrypt)
+     (%ck:+f-digest+             :digest)
+     (%ck:+f-sign+               :sign)
+     (%ck:+f-sign-recover+       :sign-recover)
+     (%ck:+f-verify+             :verify)
+     (%ck:+f-verify-recover+     :verify-recover)
+     (%ck:+f-generate+           :generate)
+     (%ck:+f-generate-key-pair+  :generate-key-pair)
+     (%ck:+f-wrap+               :wrap)
+     (%ck:+f-unwrap+             :unwrap)
+     (%ck:+f-derive+             :derive)
+     (%ck:+f-extension+          :extension)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; PKCS11-ERROR
+
+(define-condition pkcs11-error (error)
+  ((label      :initarg :label     :reader pkcs11-error-label)
+   (code       :initarg :code      :reader pkcs11-error-code)
+   (function   :initarg :function  :reader pkcs11-error-function))
+  (:report (lambda (condition stream)
+             (format stream "PKCS11 Error: ~A (~A) in ~A"
+                     (pkcs11-error-label condition)
+                     (pkcs11-error-code condition)
+                     (pkcs11-error-function condition))
+             condition)))
+
+(defun check-rv (rv &optional function continue)
+  (unless (zerop rv)
+    (let ((args  (list 'pkcs11-error :label (return-value :decode rv)
+                                     :code rv
+                                     :function function)))
+      (if continue
+          (apply (function cerror) "Ignore and continue" args)
+          (apply (function error) args))))
+  (values))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+
+(defun ckbool (generalized-boolean)
+  (if (integerp generalized-boolean)
+      (if (zerop generalized-boolean)
+          %ck:+false+
+          %ck:+true+)
+      (if generalized-boolean
+          %ck:+true+
+          %ck:+false+)))
+
+(defun unavailable-information-p (value)
+  (= %ck:+unavailable-information+
+     (logand %ck:+unavailable-information+ value)))
+
+(defun invalid-pointer-p (pointer)
+  (or (null-pointer-p pointer)
+      (unavailable-information-p (pointer-address pointer))))
+
+(defmacro with-pkcs11 (&body body)
+  `(progn
+     (check-rv (%ck:initialize (null-pointer)) "C_Initialize" :continue)
+     (unwind-protect (progn ,@body)
+       (check-rv (%ck:finalize (null-pointer)) "C_Finalize" :continue))))
+
+(defstruct version
+  major
+  minor)
+
+(defun version (operation version)
+  (ecase operation
+    ((:decode) (with-foreign-slots ((%ck:major %ck:minor) version (:struct %ck:version))
+                 (make-version :major %ck:major
+                               :minor %ck:minor)))))
+
+(defstruct info
+  cryptoki-version
+  manufacturer-id
+  flags
+  library-description
+  library-version)
+
+(defun get-info ()
+  "RETURN: an INFO structure."
+  (with-foreign-object (info '(:struct %ck:info))
+    (check-rv (%ck:get-info info) "C_GetInfo")
+    (flet ((str (slot size)
+             (foreign-string-to-lisp
+              (foreign-slot-pointer info '(:struct %ck:info) slot)
+              :count size :encoding :ascii))
+           (ver (slot)
+             (version :decode (foreign-slot-pointer info '(:struct %ck:info) slot))))
+      (make-info
+       :cryptoki-version    (ver '%ck:cryptoki-version)
+       :manufacturer-id     (str '%ck:manufacturer-id 32)
+       ;; flags is reserved for future extensions, should be 0.
+       :flags               (foreign-slot-value info '(:struct %ck:info) '%ck:flags)
+       :library-description (str '%ck:library-description 32)
+       :library-version     (ver '%ck:library-version)))))
+
+(defun get-slot-list (token-present)
+  "RETURN: a list of SLOT-IDs."
+  (with-foreign-object (count :ulong)
+    (check-rv (%ck:get-slot-list (ckbool token-present) (null-pointer) count) "C_GetSlotList")
+    (let ((slot-count  (mem-ref count :ulong)))
+      (when (plusp slot-count)
+        (with-foreign-object (slot-ids '%ck:slot-id slot-count)
+          (check-rv (%ck:get-slot-list (ckbool token-present) slot-ids count))
+          (loop :for i :below slot-count
+                :collect (mem-aref slot-ids '%ck:slot-id i)))))))
+
+(defstruct slot-info
+  slot-description
+  manufacturer-id
+  flags
+  hardware-version
+  firmware-version)
+
+(defun get-slot-info (slot-id)
+  "RETURN: a SLOT-INFO structure."
+  (check-type slot-id slot-id)
+  (with-foreign-object (info '(:struct %ck:slot-info))
+    (check-rv (%ck:get-slot-info slot-id info) "C_GetSlotInfo")
+    (flet ((str (slot size)
+             (foreign-string-to-lisp
+              (foreign-slot-pointer info '(:struct %ck:slot-info) slot)
+              :count size :encoding :ascii))
+           (ver (slot)
+             (version :decode (foreign-slot-pointer info '(:struct %ck:slot-info) slot))))
+      (make-slot-info
+       :slot-description (str '%ck:slot-description 64)
+       :manufacturer-id  (str '%ck:manufacturer-id  32)
+       :flags            (convert-slot-info-flags :decode (foreign-slot-value info '(:struct %ck:slot-info) '%ck:flags))
+       :hardware-version (ver '%ck:hardware-version)
+       :firmware-version (ver '%ck:firmware-version)))))
+
+(defstruct token-info
+  label manufacturer-id model serial-number flags max-session-count
+  session-count max-rw-session-count rw-session-count max-pin-len
+  min-pin-len total-public-memory free-public-memory
+  total-private-mmeory free-private-memory hardware-version
+  firmware-version utc-time)
+
+(defun get-token-info (slot-id)
+  "RETURN: a TOKEN-INFO structure."
+  (check-type slot-id slot-id)
+  (with-foreign-object (info '(:struct %ck:token-info))
+    (check-rv (%ck:get-token-info slot-id info) "C_GetTokenInfo")
+    (flet ((str (slot size)
+             (foreign-string-to-lisp
+              (foreign-slot-pointer info '(:struct %ck:token-info) slot)
+              :count size :encoding :ascii))
+           (ver (slot)
+             (version :decode (foreign-slot-pointer info '(:struct %ck:token-info) slot)))
+           (long (slot)
+             (let ((value (foreign-slot-value info '(:struct %ck:token-info) slot)))
+               (cond
+                 ((= value %ck:+unavailable-information+) nil)
+                 ((= value %ck:+effectively-infinite+)    :infinite)
+                 (t                                       value)))))
+      (make-token-info
+       :label                (str '%ck:label            32)
+       :manufacturer-id      (str '%ck:manufacturer-id  32)
+       :model                (str '%ck:model            16)
+       :serial-number        (str '%ck:serial-number    16)
+       :flags                (convert-token-info-flags :decode (foreign-slot-value info '(:struct %ck:token-info) '%ck:flags))
+       :max-session-count    (long '%ck:max-session-count)
+       :session-count        (long '%ck:session-count)
+       :max-rw-session-count (long '%ck:max-rw-session-count)
+       :rw-session-count     (long '%ck:rw-session-count)
+       :max-pin-len          (long '%ck:max-pin-len)
+       :min-pin-len          (long '%ck:min-pin-len)
+       :total-public-memory  (long '%ck:total-public-memory)
+       :free-public-memory   (long '%ck:free-public-memory)
+       :total-private-mmeory (long '%ck:total-private-mmeory)
+       :free-private-memory  (long '%ck:free-private-memory)
+       :hardware-version     (ver '%ck:hardware-version)
+       :firmware-version     (ver '%ck:firmware-version)
+       :utc-time             (str '%ck:utc-time 16)))))
+
+(defun wait-for-slot-event (flags)
+  "RETURN: The SLOT-ID where an event occured."
+  (check-type flags (or integer keyword))
+  (with-foreign-object (slot-id :ulong)
+    (check-rv (%ck:wait-for-slot-event (if (integerp flags)
+                                           flags
+                                           (convert-wait-for-slot-event-flags :encode flags))
+                                       slot-id
+                                       (null-pointer))
+              "C_WaitForSlotEvent")
+    (mem-ref slot-id :ulong)))
+
+(defun get-mechanism-list (slot-id)
+  "RETURN: a list of MECHANISM-TYPE."
+  (check-type slot-id slot-id)
+  (with-foreign-object (count :ulong)
+    (check-rv (%ck:get-mechanism-list slot-id (null-pointer) count) "C_GetMechanismList")
+    (let ((mechanism-count  (mem-ref count :ulong)))
+      (when (plusp mechanism-count)
+        (with-foreign-object (mechanism-types '%ck:mechanism-type mechanism-count)
+          (check-rv (%ck:get-mechanism-list slot-id mechanism-types count))
+          (loop :for i :below mechanism-count
+                :collect (mechanism-type :decode (mem-aref mechanism-types '%ck:mechanism-type i))))))))
+
+(defstruct mechanism-info
+  min-key-size max-key-size flags)
+
+(defun get-mechanism-info (slot-id mechanism-type)
+  "RETURN: a MECHANIS-INFO structure."
+  (check-type slot-id slot-id)
+  (check-type mechanism-type mechanism-type)
+  (with-foreign-object (info '(:struct %ck:mechanism-info))
+    (check-rv (%ck:get-mechanism-info slot-id
+                                      (if (integerp mechanism-type)
+                                          mechanism-type
+                                          (mechanism-type :encode mechanism-type))
+                                      info)
+              "C_GetMechanismInfo")
+    (flet ((long (slot)
+             (foreign-slot-value info '(:struct %ck:mechanism-info) slot)))
+      (make-mechanism-info
+       :min-key-size (long '%ck:min-key-size)
+       :max-key-size (long '%ck:min-key-size)
+       :flags        (convert-mechanism-info-flags :decode (foreign-slot-value info '(:struct %ck:mechanism-info) '%ck:flags))))))
+
+(defun string-from-utf-8 (bytes)
+  (octets-to-string bytes :encoding :utf-8 :errorp t))
+
+(defun string-to-utf-8 (string &key size padchar)
+  ;; Note: we could be more optimized by storing directly a pre-allocated result vector,
+  ;;       but it's expected to be used only on small strings…
+  (let ((bytes (string-to-octets string :encoding :utf-8 :use-bom nil)))
+    (when (and size (< size (length bytes)))
+      (setf bytes (subseq bytes 0 size))
+      (unless (ignore-errors (octets-to-string bytes :encoding :utf-8 :errorp t))
+        (error "Truncated utf-8 byte sequence in the middle of a utf-8 code sequence!~%string: ~S~%bytes: ~S~%"
+               string bytes)))
+    (if (and padchar size (< (length bytes) size))
+        (let ((padstring (string-to-octets (string padchar) :encoding :utf-8 :use-bom nil)))
+          (unless (zerop (mod (- size (length bytes)) (length padstring)))
+            (error "pad character is encoded as a utf-8 code sequence of length ~D, which is not a divisor of the required padding length ~D. Try to specify an ASCII character as pad character!"
+                   (length padstring)  (- size (length bytes))))
+          (let ((result (apply (function make-array) size :element-type 'octet
+                               (when (= 1 (length padstring))
+                                 (list :initial-element (aref padstring 0))))))
+            (replace result bytes)
+            (unless (= 1 (length padstring))
+              (loop :for s :from (length bytes) :below (length result) :by (length padstring)
+                    :do (replace result padstring :start1 s)))
+            result))
+        bytes)))
+
+(defun init-token (slot-id pin label)
+  "RETURN: the PIN string as returned by C_InitToken."
+  (check-type slot-id slot-id)
+  (check-type pin     string)
+  (check-type label   string)
+  (warn "Not tested yet! Please, provide new smart-cards!")
+  (let* ((label  (string-to-utf-8 label :size 32 :padchar #\space))
+         (pin    (string-to-utf-8 pin))
+         (pinlen (length pin)))
+    (with-foreign-objects ((flabel  :uchar 32)
+                           (fpin    :uchar pinlen)
+                           (fpinlen :ulong))
+      (dotimes (i 32)     (setf (mem-aref flabel :uchar i) (aref label i)))
+      (dotimes (i pinlen) (setf (mem-aref fpin   :uchar i) (aref pin   i)))
+      (setf (mem-ref fpinlen :ulong) pinlen)
+      (check-rv (%ck:init-token slot-id fpin fpinlen flabel) "C_InitToken")
+      (foreign-string-to-lisp fpin :count fpinlen :encoding :ascii))))
+
+(defparameter *references* '() "A-list mapping foreign pointers with lisp objets")
+(defstruct entry
+  slot-id reference pointer session)
+(defun enter-reference (slot-id reference)
+  (let ((pointer (foreign-alloc :ulong :initial-element #x1BADBEEF)))
+    (push (make-entry :slot-id slot-id :pointer pointer :reference reference) *references*)
+    pointer))
+(defun find-entry-with-pointer (pointer)
+  (find pointer *references* :key (function entry-pointer)))
+(defun find-entry-with-session (session)
+  (find session *references* :key (function entry-session)))
+(defun associate-pointer-with-session (pointer session)
+  (let ((entry (find-entry-with-pointer pointer)))
+    (when entry
+      (setf (entry-session entry) session))))
+(defun clear-entry-with-pointer (pointer)
+  (setf *references* (delete (find-entry-with-pointer pointer) *references*)))
+(defun clear-entry-with-session (session)
+  (setf *references* (delete (find-entry-with-session session) *references*)))
+(defun clear-entries-with-slot-id (slot-id)
+  (setf *references* (delete slot-id  *references* :key (function entry-slot-id))))
+
+(defun open-session (slot-id flags application-reference notify-function)
+  "RETURN: a SESSION-HANDLER."
+  (check-type slot-id slot-id)
+  (check-type notify-function null "TODO: Sorry, notify-function are not supported yet.") ; TODO.
+  (let ((application-reference (if application-reference
+                                   (enter-reference slot-id application-reference)
+                                   (null-pointer))))
+    (with-foreign-object (session-handle '%ck:session-handle)
+      (check-rv (%ck:open-session slot-id
+                                  (if (integerp flags)
+                                      flags
+                                      (convert-session-info-flags :encode flags))
+                                  application-reference
+                                  (null-pointer) ; TODO notify-function
+                                  session-handle)
+                "C_OpenSession")
+      (let ((session (mem-ref session-handle '%ck:session-handle)))
+        (associate-pointer-with-session application-reference session)
+        session))))
+
+(defun close-session (session-handle)
+  (check-type session-handle session-handle)
+  (check-rv (%ck:close-session session-handle) "C_CloseSession")
+  (clear-entry-with-session session-handle)
+  (values))
+
+(defun close-all-sessions (slot-id)
+  (check-type slot-id slot-id)
+  (check-rv (%ck:close-all-sessions slot-id) "C_CloseAllSessions")
+  (clear-entries-with-slot-id slot-id)
+  (values))
+
+(defmacro with-open-session ((session-var slot-id &key flags application-reference notify-function
+                                                    (if-open-session-fails :error)) &body body)
+  (let ((vflags (gensym))
+        (vsession (gensym)))
+    `(flet ((open-it ()
+              (open-session ,slot-id
+                            (let ((,vflags ,flags))
+                              (if (integerp ,vflags)
+                                  (logior ,vflags %ck:+serial-session+)
+                                  (cons :serial-session ,vflags)))
+                            ,application-reference
+                            ,notify-function)))
+       (let* ((,vsession (ecase ,if-open-session-fails
+                           ((:error)  (open-it))
+                           ((nil)     (ignore-errors (open-it)))))
+              (,session-var ,vsession))
+         (unwind-protect (progn ,@body)
+           (when ,vsession (close-session ,vsession)))))))
+
+(defstruct session-info
+  slot-id state flags device-error)
+
+(defun get-session-info (session)
+  "RETURN: a SESSION-INFO structure."
+  (check-type session session-handle)
+  (with-foreign-object (info '(:struct %ck:session-info))
+    (check-rv (%ck:get-session-info session info) "C_GetSessionInfo")
+    (flet ((long (slot)
+             (foreign-slot-value info '(:struct %ck:session-info) slot)))
+      (make-session-info
+       :slot-id      (long '%ck:slot-id)
+       :state        (state :decode (long '%ck:state))
+       :flags        (convert-session-info-flags :decode (long '%ck:flags))
+       :device-error (long '%ck:device-error)))))
+
+;; Probably better not to keep long lived C buffers.
+;; Furthermore, the operation can be resumed in a different process,
+;; so it's better to convert to lisp data that's more easily
+;; serializable.
+;;
+;; (defstruct operation-state
+;;   data
+;;   size)
+;; (defun free-operation-state (operation-state)
+;;   (foreign-free (operation-state-data operation-state)))
+;;         (make-operation-state :data operation-state
+;;                               :size (mem-ref operation-state-len :ulong))
+
+(defun get-operation-state (session)
+  "RETURN: a vector of octet containing the session state."
+  (check-type session session-handle)
+  (with-foreign-object (operation-state-len :ulong)
+    (check-rv (%ck:get-operation-state session (null-pointer) operation-state-len) "C_GetOperationState")
+    (with-foreign-object (operation-state :uchar (mem-ref operation-state-len :ulong))
+      (check-rv (%ck:get-operation-state session operation-state operation-state-len) "C_GetOperationState")
+      (foreign-vector operation-state :uchar 'octet (mem-ref operation-state-len :ulong)))))
+
+
+(defun set-operation-state (session state &key (encryption-key 0) (authentication-key 0))
+  (check-type session             session-handle)
+  (check-type state               (vector octet))
+  (check-type encryption-key      object-handle)
+  (check-type authentication-key  object-handle)
+  (with-foreign-objects ((operation-state     :uchar (length state))
+                         (operation-state-len :ulong))
+    (loop :for i :below (length state)
+          :do (setf (mem-aref operation-state :uchar i) (aref state i)))
+    (setf (mem-ref operation-state-len :ulong) (length state))
+    (check-rv (%ck:set-operation-state session operation-state operation-state-len
+                                       encryption-key authentication-key)
+              "C_SetOperationState")))
+
+(defun login (session user-type pin)
+  (check-type session   session-handle)
+  (check-type user-type (or integer keyword))
+  (check-type pin       (or null string))
+  (if pin
+      (let* ((pin    (string-to-utf-8 pin))
+             (pinlen (length pin)))
+        (with-foreign-objects ((fpin    :uchar pinlen))
+          (dotimes (i pinlen) (setf (mem-aref fpin :uchar i) (aref pin i)))
+          (check-rv (%ck:login session (if (integerp user-type)
+                                           user-type
+                                           (user-type :encode user-type))
+                               fpin pinlen)
+                    "C_Login")))
+      (check-rv (%ck:login session (if (integerp user-type)
+                                       user-type
+                                       (user-type :encode user-type))
+                           (null-pointer) 0)
+                "C_Login")))
+
+(defun logout (session)
+  (check-type session   session-handle)
+  (check-rv (%ck:logout session) "C_Logout"))
+
+(defvar *verbose* t)
+
+(defun call-logged-in (session slot-id thunk &key why)
+  "RETURN: the results of THUNK, or NIL when login was impossible."
+  (check-type session session-handle)
+  (check-type slot-id slot-id)
+  (check-type thunk   (or function symbol))
+  (when (handler-case
+            (let* ((info  (get-token-info slot-id))
+                   (flags (token-info-flags info)))
+              (login session %ck:+user+ (if (member :protected-authentication-path flags)
+                                            (progn
+                                              (format t "~&~@[Logging for ~A.~%~]Please, enter pin on pin-pad (~:[~D digits~;~D to ~D digits~]).~%"
+                                                      why
+                                                      (/= (token-info-min-pin-len info) (token-info-max-pin-len info))
+                                                      (token-info-min-pin-len info)
+                                                      (token-info-max-pin-len info))
+                                              (finish-output)
+                                              nil)
+                                            (read-pin (token-info-min-pin-len info) (token-info-max-pin-len info))))
+              t)
+          (pkcs11-error (err)
+            (princ err *error-output*)
+            (terpri *error-output*)
+            nil))
+    (unwind-protect (progn
+                      (when *verbose*
+                        (fresh-line)
+                        (format t "~&Logged in~@[, for ~A~].~%" why)
+                        (finish-output))
+                      (funcall thunk))
+      (logout session)
+      (when *verbose*
+        (fresh-line)
+        (format t "~&Logged out~@[ for ~A~].~%" why)
+        (finish-output)))))
+
+(defmacro do-logged-in ((session slot-id &optional why) &body body)
+  `(call-logged-in ,session ,slot-id (lambda () ,@body) :why ,why))
+
+(defun init-pin (session pin)
+  (check-type session   session-handle)
+  (check-type pin       string)
+  (let* ((pin    (string-to-utf-8 pin))
+         (pinlen (length pin)))
+    (with-foreign-objects ((fpin    :uchar pinlen)
+                           (fpinlen :ulong))
+      (dotimes (i pinlen) (setf (mem-aref fpin :uchar i) (aref pin i)))
+      (setf (mem-ref fpinlen :ulong) pinlen)
+      (check-rv (%ck:init-pin session fpin fpinlen) "C_InitPIN"))))
+
+(defun set-pin (session old-pin new-pin)
+  (check-type session   session-handle)
+  (check-type old-pin   string)
+  (check-type new-pin   string)
+  (let* ((old-pin    (string-to-utf-8 old-pin))
+         (new-pin    (string-to-utf-8 new-pin))
+         (old-pinlen (length old-pin))
+         (new-pinlen (length new-pin)))
+    (with-foreign-objects ((fold-pin    :uchar old-pinlen)
+                           (fnew-pin    :uchar new-pinlen)
+                           (fold-pinlen :ulong)
+                           (fnew-pinlen :ulong))
+      (dotimes (i old-pinlen) (setf (mem-aref fold-pin :uchar i) (aref old-pin i)))
+      (dotimes (i new-pinlen) (setf (mem-aref fnew-pin :uchar i) (aref new-pin i)))
+      (setf (mem-ref fold-pinlen :ulong) old-pinlen)
+      (setf (mem-ref fnew-pinlen :ulong) new-pinlen)
+      (check-rv (%ck:set-pin session fold-pin fold-pinlen fnew-pin fnew-pinlen) "C_SetPIN"))))
+
+(defun read-pin (&optional min (max min))
+  "Reads a PIN as a string, prompting for at least MIN characters, and at most MAX."
+  (format *query-io* "~%Please enter your PIN~@[~* (~:[~D digits~;~D to ~D digits~])~]: "
+          min (and min max (/= min max)) min max)
+  (finish-output *query-io*)
+  (prog1 (read-line *query-io*)
+    (terpri *query-io*)))
+
+(defun integer-to-bytes (value &key (endian :little)
+                                 (step 8)    ; bits
+                                 size        ; bits
+                                 min-size    ; bits
+                                 max-size)   ; bits
+  "Converts an integer into a byte vector.
+ENDIAN:     the byte order :little or :big -endian.
+SIZE:       the size in bits of the integer.
+MIN-SIZE:   the minimum size in bits for the integer.
+MAX-SIZE:   the maximum size in bits for the integer.
+STEP:       SIZE, MIN-SIZE and MAX-SIZE, when specified,
+            should be multiples of STEP.
+            The integer size is ceiled by STEP.
+SIZE and (MIN-SIZE or MAX-SIZE) are mutually exclusive.
+"
+  (check-type endian (member :little :big))
+  (assert (not (and size (or min-size max-size)))
+          (size min-size max-size)
+          "size and (min-size or max-size) are mutually exclusive.")
+  (flet ((call-do-size (size thunk-i thunk-l)
+           (cond
+             ((null size))
+             ((integerp size) (funcall thunk-i size))
+             ((and (consp size) (eql 'member (first size)))
+              (dolist (size (rest size))
+                (funcall thunk-l size)))
+             (t (error "Invalid size: ~S  Should be an integer or (member integer…)." size)))))
+    (macrolet ((do-size ((size) &body body)
+                 (let ((fbody (gensym)))
+                  `(flet ((,fbody (,size) ,@body))
+                     (call-do-size ,size (function ,fbody) (function ,fbody))))))
+      (macrolet ((check-step (size)
+                   `(assert (or (null ,size) (zerop (mod ,size step)))
+                            (,size step)
+                            "~A = ~D should be a multiple of ~A = ~D"
+                            ',size ,size 'step step)))
+        (do-size (size) (check-step size))
+        (check-step min-size)
+        (check-step max-size))
+
+      (let ((value-length (* (ceiling (integer-length value) step) step)))
+
+        (when size
+          (block size-ok
+            (call-do-size size
+                          (lambda (size)
+                            (if (<= value-length size)
+                                (setf value-length size)
+                                (error "Value #x~X has ~D bits (rounded to ~D) which is more than the specified size ~D"
+                                       value value-length step size))
+                            (return-from size-ok))
+                          (lambda (size)
+                            (when (= value-length size)
+                              (return-from size-ok))))
+            (error "Value #x~X has ~D bits (rounded to ~D) which is not one of ~S"
+                   value value-length step (rest size))))
+        (when (and min-size (< value-length min-size))
+          (setf value-length min-size))
+        (when (and max-size (< max-size value-length))
+          (error "Value #x~X has ~D bits (rounded to ~D) which is less than the specified max-size ~D"
+                 value value-length step max-size))
+
+        (loop :with vector := (make-array (ceiling value-length 8) :element-type 'octet)
+              :with increment := (if (eql endian :little) +1 -1)
+              :repeat (length vector)
+              :for i := (if (eql endian :little) 0 (1- (length vector))) :then (+ i increment)
+              :for b :from 0 :by 8
+              :do (setf (aref vector i) (ldb (byte 8 b) value))
+              :finally (return vector))))))
+
+(defun test/integer-to-bytes ()
+
+  (assert (equalp (list (integer-to-bytes #x312312312312312301020304 :endian :little)
+                        (integer-to-bytes #x312312312312312301020304 :endian :big))
+                  '(#(4 3 2 1 35 49 18 35 49 18 35 49)
+                    #(49 35 18 49 35 18 49 35 1 2 3 4))))
+
+  (assert (equalp (list (integer-to-bytes #x312312312312312301020304 :endian :little :step 64)
+                        (integer-to-bytes #x312312312312312301020304 :endian :big    :step 64))
+                  '(#(4 3 2 1 35 49 18 35 49 18 35 49 0 0 0 0)
+                    #(0 0 0 0 49 35 18 49 35 18 49 35 1 2 3 4))))
+
+  (assert (equalp (list (integer-to-bytes #x312312312312312301020304 :endian :little :size 128)
+                        (integer-to-bytes #x312312312312312301020304 :endian :big    :step 128))
+                  '(#(4 3 2 1 35 49 18 35 49 18 35 49 0 0 0 0)
+                    #(0 0 0 0 49 35 18 49 35 18 49 35 1 2 3 4))))
+
+  (assert (equalp (list (integer-to-bytes #x312312312312312301020304 :endian :little :step 32 :min-size 160)
+                        (integer-to-bytes #x312312312312312301020304 :endian :big    :step 32 :min-size 160))
+                  '(#(4 3 2 1 35 49 18 35 49 18 35 49 0 0 0 0 0 0 0 0)
+                    #(0 0 0 0 0 0 0 0 49 35 18 49 35 18 49 35 1 2 3 4))))
+
+  :success)
+
+(test/integer-to-bytes)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Attribute
+
+(defmacro attr-> (struct slot)
+  `(foreign-slot-value ,struct '(:struct %ck:attribute) ',slot))
+
+(defun attr-aptr (template index)
+  (mem-aptr template '(:struct %ck:attribute) index))
+
+;; For conversion of integers to:
+;; :big-integer is most significant byte first (Big endian).
+;; :der is  most significant byte first (Big endian).
+;; :bytes is less significant byte first (Little endian).
+;; :bytes-noint rejects integers.
+
+;; (:big-integer [:size s])
+;; (:big-integer [:min-size s1] [:max-size s2] [:step s3])
+;; s := integer | (member integer…)
+
+
+(defparameter *attribute-type-map*
+  '((:class                       (:ulong object-class))
+    (:token                       :bool)
+    (:private                     :bool)
+    (:label                       :string) ; rfc2279 (utf-8)
+    (:application                 :string) ; rfc2279 (utf-8)
+    (:value                       :bytes-noint)  ; or rfc2279 (utf-8)
+    (:object-id                   :bytes)  ; DER encoding of the OID indicating the data object type (empty by default)
+    (:certificate-type            (:ulong certificate-type))
+    (:issuer                      :bytes)
+    (:serial-number               :bytes)
+    (:ac-issuer                   :string)
+    (:owner                       :string)
+    (:attr-types                  (:ulong attribute-type))
+    (:trusted                     :bool)
+    (:certificate-category        :ulong)
+    (:java-midp-security-domain   :bytes)
+    (:url                         :string)
+    (:hash-of-subject-public-key  :bytes)
+    (:hash-of-issuer-public-key   :bytes)
+    (:check-value                 :bytes)
+    (:key-type                    (:ulong key-type))
+    (:subject                     :bytes)
+    (:id                          :bytes) ; DER-encoding of the object identifier indicating the domain parameters
+                                        ; Big endian: #xe828bd080fd2500000104d494f4300010101
+                                        ;  <-> #(#xe8 #x28 #xbd #x08 #x0f #xd2 #x50 #x00 #x00
+                                        ;        #x10 #x4d #x49 #x4f #x43 #x00 #x01 #x01 #x01)
+    (:sensitive                   :bool)
+    (:encrypt                     :bool)
+    (:decrypt                     :bool)
+    (:wrap                        :bool)
+    (:unwrap                      :bool)
+    (:sign                        :bool)
+    (:sign-recover                :bool)
+    (:verify                      :bool)
+    (:verify-recover              :bool)
+    (:derive                      :bool)
+    (:start-date                  :date)
+    (:end-date                    :date)
+    (:modulus                     :big-integer)
+    (:modulus-bits                :ulong)
+    (:public-exponent             :big-integer)
+    (:private-exponent            :big-integer)
+    (:prime-1                     :big-integer)
+    (:prime-2                     :big-integer)
+    (:exponent-1                  :big-integer)
+    (:exponent-2                  :big-integer)
+    (:coefficient                 :big-integer)
+    (:prime                       (:big-integer :min-size 512 :max-size 1024 :step 64))
+    (:subprime                    (:big-integer :size (member 160 224 256)))
+    (:base                        :big-integer)
+    (:prime-bits                  :ulong)
+    (:sub-prime-bits              :ulong)
+    (:value-bits                  :ulong)
+    (:value-len                   :ulong)
+    (:extractable                 :bool)
+    (:local                       :bool)
+    (:never-extractable           :bool)
+    (:always-sensitive            :bool)
+    (:key-gen-mechanism           (:ulong mechanism-type))
+    (:modifiable                  :bool)
+    (:ecdsa-params                :bytes)
+    (:ec-params                   :bytes)
+    (:ec-point                    :bytes)
+    (:secondary-auth              :bytes)
+    (:auth-pin-flags              :bytes)
+    (:always-authenticate         :bool)
+    (:wrap-with-trusted           :bool)
+    (:hw-feature-type             (:ulong hardware-feature))
+    (:reset-on-init               :bool)
+    (:has-reset                   :bool)
+    (:pixel-x                     :ulong)
+    (:pixel-y                     :ulong)
+    (:resolution                  :ulong)
+    (:char-rows                   :ulong)
+    (:char-columns                :ulong)
+    (:color                       :bool)
+    (:bits-per-pixel              :ulong)
+    (:char-sets                   :string) ; rfc2279 (utf-8)
+    (:encoding-methods            :string) ; rfc2279 (utf-8)
+    (:mime-types                  :string) ; rfc2279 (utf-8)
+    (:mechanism-type              (:ulong mechanism-type))
+    (:required-cms-attributes     :bytes)
+    (:default-cms-attributes      :bytes)
+    (:supported-cms-attributes    :bytes)
+    (:wrap-template               (:array :attribute))
+    (:unwrap-template             (:array :attribute))
+    (:allowed-mechanisms          (:array (:ulong mechanism-type)))
+    (:vendor-defined              :bytes)))
+
+(defun attribute-type-to-ltype (atype &optional type)
+  (or (second (assoc (attribute-type :decode atype) *attribute-type-map*))
+      (error "Unknown attribute type: ~S~@[ (type = ~S)~]"
+             (attribute-type :decode atype) type)))
+
+(defun attribute-copy (destination source)
+  (setf (attr-> destination %ck:type)      (attr-> source %ck:type)
+        (attr-> destination %ck:value-len) (attr-> source %ck:value-len)
+        (attr-> destination %ck:value)     (attr-> source %ck:value))
+  destination)
+
+(defun attribute-allocate-buffer (attribute)
+  (let* ((len (attr-> attribute %ck:value-len))
+         (val (foreign-alloc :uchar :count len :initial-element 0)))
+    (setf (attr-> attribute %ck:value) val)))
+
+(defun attribute-allocate-ulong-array (attribute)
+  (let* ((len  (attr-> attribute %ck:value-len))
+         (val  (foreign-alloc :ulong :count len :initial-element 0)))
+    (setf (attr-> attribute  %ck:value) val)))
+
+(defun attribute-allocate-attribute-array (attribute)
+  (let* ((len (attr-> attribute %ck:value-len))
+         (val (foreign-alloc :pointer :count len :initial-element (null-pointer))))
+    (setf (attr-> attribute %ck:value) val)))
+
+(defun base-ltype-p (ltype)
+  (if (atom ltype)
+      ltype
+      (find (first ltype) '(:big-integer))))
+
+(defun big-integer-attributes (ltype)
+  (cond
+    ((atom ltype)                     '())
+    ((eql :big-integer (first ltype)) (rest ltype))
+    (t                                '())))
+
+(defun attribute-fill (attribute type value)
+  ;; :ulong               - 4 bytes in big-endian order?
+  ;; :bool                - 1 byte 0 or 1
+  ;; :string              - any number of bytes. the strings are utf-8 encoded.
+  ;;                        if we get a byte vector in, we pass it as is.
+  ;; :bytes               - a vector of bytes. If we get a string, we encode it in utf-8, if we get an integer, we encode in little-endian order.
+  ;; :bytes-noint         - a vector of bytes. If we get a string, we encode it in utf-8, if we get an integer, we reject it.
+  ;; :big-integer         - a vector of bytes. If we get an integer, we encode in big-endian order.
+  ;; :date                - a date (string) or universal-time.
+  ;; (:array :ulong)      - a vector of ulong.
+  ;; (:array :attribute)  - a vector of attributes (passed to the C_ function is a vector of pointers to attribute structures).
+  ;; For strings, bytes and arrays, if the value is nil, then we set the pValue to NULL.
+  (flet ((set-attribute-fields (attribute atype ctype count &optional value)
+           (assert (not (and (null count) value)))
+           (let* ((len (* (or count 0) (foreign-type-size ctype)))
+                  (val (cond
+                         ((null count) (null-pointer))
+                         (value        value)
+                         (t            (foreign-alloc :uchar :count len)))))
+             (setf (attr-> attribute %ck:type)      atype
+                   (attr-> attribute %ck:value)     val
+                   (attr-> attribute %ck:value-len) len)
+             val)))
+
+    (let* ((atype      (if (integerp type)
+                           type
+                           (attribute-type :encode type)))
+           (ltype      (attribute-type-to-ltype atype type))
+           (base-ltype (base-ltype-p ltype)))
+
+      (case base-ltype
+
+        ((:ulong)  (set-attribute-fields attribute atype :ulong 1
+                                         (foreign-alloc :ulong :initial-element value)))
+
+
+
+        ((:bool)   (set-attribute-fields attribute atype :uchar 1
+                                         (foreign-alloc :uchar :initial-element (ckbool value))))
+
+        ((:string :bytes :bytes-noint :big-integer)
+         (let* ((value (typecase value
+                         (null nil)
+                         (integer (case base-ltype
+                                    (:string       (prin1-to-string value))
+                                    (:bytes        (integer-to-bytes value :endian :little))
+                                    (:big-integer  (apply (function integer-to-bytes) value :endian :big (big-integer-attributes ltype)))
+                                    (:bytes-noint  (error "Please give a vector of bytes, not an integer for ~S" attribute))))
+                         ((or string symbol character)  (string value))
+                         ((or vector list)
+                          (if (every (lambda (element)
+                                       (typep element 'octet))
+                                     value)
+                              value
+                              (prin1-to-string value)))
+                         (t (prin1-to-string value))))
+                (value (if (stringp value)
+                           (string-to-utf-8 value)
+                           value)))
+           (set-attribute-fields attribute atype :uchar
+                                 (when value (length value)) ;; TODO: why nil instead of 0?
+                                 (when value (foreign-vector-copy-from
+                                              (foreign-alloc :uchar :count (length value))
+                                              :uchar
+                                              (length value) value)))))
+
+        ((:date)
+         (let ((value (etypecase value
+                        (integer (multiple-value-bind (se mi ho da mo ye) (decode-universal-time value 0)
+                                   (format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D00"
+                                           ye mo da ho mi se)))
+                        (string value))))
+
+           (set-attribute-fields attribute atype :uchar  (length value)
+                                 (foreign-vector-copy-from
+                                  (foreign-alloc :uchar :count (length value))
+                                  :uchar
+                                  (length value) value))))
+
+        (otherwise
+
+         (unless (consp ltype)
+           (error "Bad attribute lisp type: ~S from attribute type: ~S" ltype type))
+
+         (ecase (first ltype)
+           ((:ulong)
+            (set-attribute-fields attribute atype :ulong 1
+                                  (foreign-alloc :ulong
+                                                 :initial-element
+                                                 (if (integerp value)
+                                                     value
+                                                     (funcall (second ltype) :encode value)))))
+           ((:array)
+            (set-attribute-fields attribute atype :uchar
+                                  (* (foreign-type-size :ulong)
+                                     (length value))
+                                  (foreign-vector-copy-from
+                                   (foreign-alloc :ulong :count (length value))
+                                   :ulong (length value)
+                                   value)))
+           ((:attribute)
+            ;; value is a sequence of attributes
+            (let ((template  (template-encode value)))
+              (set-attribute-fields attribute atype :uchar
+                                    (car template) (cdr template))))
+
+           (otherwise
+            (ecase (first (second ltype))
+              ((:ulong)
+               ;; value is a sequence of integers.
+               (set-attribute-fields attribute atype :uchar
+                                     (* (foreign-type-size :ulong)
+                                        (length value))
+                                     (let ((converter (second (second ltype))))
+                                       (foreign-vector-copy-from value :ulong (length value)
+                                                                 (map 'vector (lambda (value)
+                                                                                (if (integerp value)
+                                                                                    value
+                                                                                    (funcall converter :encode value)))
+                                                                      value))))))))))))
+  attribute)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Template
+
+(deftype template ()
+  `(cons integer
+         #+ccl ccl:macptr
+         #-ccl (progn (warn "What is the type of foreign pointer in ~A" (lisp-implementation-type))
+                      t)))
+
+(defun template-find-attribute (template atype)
+  "RETURN: a foreign pointer to the attribute of type ATYPE in the TEMPLATE, or the foreign null pointer."
+  (check-type template template)
+  (loop
+    :with atype := (attribute-type :encode atype)
+    :with attributes := (cdr template)
+    :for i :below (car template)
+    :for attribute := (attr-aptr attributes i)
+    :unless (null-pointer-p attribute)
+      :do (when (= (attr-> attribute %ck:type) atype)
+            (return attribute)))
+  (null-pointer))
+
+(defun template-free (template)
+  "TEMPLATE is a cons (count . foreign-vector).
+foreign-vector is a CK_ATTRIBUTE[count] array.
+This function frees each foreign pointer in the foreign vector, and frees the foreign vector.
+The cdr of the TEMPLATE cons cell is set to NIL."
+  (check-type template template)
+  (let ((vector (cdr template)))
+    (dotimes (i (car template))
+      (let ((attribute (attr-aptr vector i)))
+        (when (= (logand %ck:+array-attribute+ (attr-> attribute %ck:type))
+                 %ck:+array-attribute+)
+          (template-free (cons (attr-> attribute %ck:value-len)
+                               (attr-> attribute %ck:value))))))
+    (foreign-free vector)
+    (setf (cdr template) nil)
+    (values)))
+
+(defun attribute-dump (attribute)
+  "RETURN: ATTRIBUTE"
+  (let ((*print-circle* nil))
+    (format t "~1@*~16,'0X~%~0@*~A~2@*type=~4X(hex) ~:*~D(dec)~%~0@*~A~4@*size=~4D~%~0@*~A~5@*value=~16,'0X~%"
+            *dump-prefix*
+            (pointer-address attribute)
+            (attr-> attribute %ck:type)
+            (attribute-type :decode (attr-> attribute %ck:type))
+            (attr-> attribute %ck:value-len)
+            (pointer-address (attr-> attribute %ck:value)))
+    (if (= %ck:+array-attribute+ (logand %ck:+array-attribute+ (attr-> attribute  %ck:type)))
+        (let ((*dump-prefix* (concatenate 'string *dump-prefix* "    ")))
+          (template-dump (cons (attr-> attribute %ck:value-len)
+                               (attr-> attribute %ck:value))))
+        (let ((*dump-prefix* (concatenate 'string *dump-prefix* "  ")))
+          (cond ((unavailable-information-p (attr-> attribute %ck:value-len))
+                 (format t "~AType indicates unavailable information.~%" *dump-prefix*))
+                ((null-pointer-p (attr-> attribute %ck:value))
+                 (format t "~AValue is NULL!~%" *dump-prefix*))
+                ((unavailable-information-p (pointer-address (attr-> attribute %ck:value)))
+                 (format t "~AValue indicates unavailable information.~%" *dump-prefix*))
+                (t
+                 (dump (attr-> attribute %ck:value)
+                       (attr-> attribute %ck:value-len)
+                       :print-characters t))))))
+  attribute)
+
+(defun validate-pointer (pointer)
+  "RETURN: POINTER"
+  (let ((address (pointer-address pointer)))
+    (assert (/= 0 address)      () "Null pointer!")
+    (assert (/= -1 address)     () "Unavailable_information in pointer!")
+    (assert (< #x10000 address) () "Small address!"))
+  pointer)
+
+(defun template-dump (template)
+  "TEMPLATE is a cons (count . foreign-vector).
+This function frees each foreign pointer in the foreign vector, and frees the foreign vector.
+The cdr of the TEMPLATE cons cell is set to NIL.
+RETURN: TEMPLATE"
+  (check-type template template)
+  (let ((vector (cdr template))
+        (*print-circle* nil))
+    (format t "~&~ADumping template ~S~%"  *dump-prefix* template)
+    (unless (null-pointer-p vector)
+      (validate-pointer vector)
+      (dump vector (* (car template) (foreign-type-size '(:struct %ck:attribute))))
+      (let ((*dump-prefix* (concatenate 'string *dump-prefix* "  ")))
+        (dotimes (i (car template))
+          (let ((attribute (attr-aptr vector i)))
+            (format t "~AAttribute[~D]="  *dump-prefix* i)
+            (let ((*dump-prefix* (concatenate 'string *dump-prefix* "    ")))
+              (attribute-dump attribute))))))
+    (finish-output)
+    #-(and)(pause () "dumped"))
+  template)
+
+(defun attribute-decode (attribute)
+  "RETURN: a cons cell containing the ATTRIBUTE key value pair,
+           (:UNAVAILABLE-INFORMATION . NIL) if attribute is invalid, or
+           NIL if ATTRIBUTE is the foreign null pointer."
+  (cond
+    ((null-pointer-p attribute)
+     nil)
+    ((invalid-pointer-p attribute)
+     '(:unavailable-information))
+    (t
+     (let ((type (attr-> attribute %ck:type)))
+       ;; CONS here matches TEMPLATE-ENCODE (atype . value).
+       (cons (attribute-type :decode type)
+             (let* ((ltype (or (second (assoc (attribute-type :decode type) *attribute-type-map*))
+                               (error "Unknown attribute type: ~S" type)))
+                    (base-ltype (base-ltype-p ltype))
+                    (len (attr-> attribute %ck:value-len))
+                    (val (attr-> attribute %ck:value)))
+               (if (or (unavailable-information-p type) (invalid-pointer-p val))
+                   :unavailable-information
+                   (case base-ltype
+                     ((:ulong)
+                      (assert (= (foreign-type-size :ulong) len))
+                      (mem-ref val :ulong))
+                     ((:bool)
+                      (assert (= (foreign-type-size :uchar) len))
+                      (mem-ref val :uchar))
+                     ((:bytes :bytes-noint :big-integer)
+                      (foreign-vector-copy-to val :uchar len (make-array len :element-type 'octet)))
+                     ((:string)
+                      (foreign-string-to-lisp val :count len :encoding :utf-8))
+                     ((:date)
+                      (foreign-string-to-lisp val :count len :encoding :utf-8)
+                      #-(and) (let ((date (foreign-string-to-lisp var :count len :encoding :utf-8)))
+                                (encode-universal-time
+                                 (parse-integer date :start 12 :end 14 :junk-allowed nil)
+                                 (parse-integer date :start 10 :end 12 :junk-allowed nil)
+                                 (parse-integer date :start  8 :end 10 :junk-allowed nil)
+                                 (parse-integer date :start  6 :end  8 :junk-allowed nil)
+                                 (parse-integer date :start  4 :end  6 :junk-allowed nil)
+                                 (parse-integer date :start  0 :end  4 :junk-allowed nil)
+                                 0)))
+                     (otherwise
+                      (unless (consp ltype)
+                        (error "Bad attribute lisp type: ~S from attribute type: ~S" ltype type))
+                      (ecase (first ltype)
+                        ((:ulong)
+                         (funcall (second ltype) :decode (mem-ref val :ulong)))
+                        ((:array)
+                         (if (atom (second ltype))
+                             (ecase (second ltype)
+                               ((:ulong)
+                                ;; value is a sequence of integers.
+                                (foreign-vector-copy-from val :ulong len (make-array len)))
+                               ((:attribute)
+                                ;; value is a sequence of attributes
+                                (template-decode (cons len val))))
+                             (ecase (first (second ltype))
+                               ((:ulong)
+                                ;; value is a sequence of integer codes.
+                                (let ((converter (second (second ltype))))
+                                  (map 'list (lambda (value)
+                                               (funcall converter :encode value))
+                                       (foreign-vector-copy-from val :ulong len (make-array len))))))))))))))))))
+
+(defun template-decode (template)
+  "TEMPLATE:  a cons containing the number of attributes and a foreign pointer to the attributes.
+RETURN: An a-list of (key . value) decoded attributes."
+  (check-type template template)
+  (handler-bind ((error (function invoke-debugger)))
+    (let ((vector (cdr template))
+          (result '()))
+      (dotimes (i (car template) (nreverse result))
+        (let ((attribute (attr-aptr vector i)))
+          ;; Could test for value-len=-1 and skip those,
+          ;; but attribute-decode returns :unavailable-information for them.
+          (push (attribute-decode attribute) result))))))
+
+(defun template-allocate-buffers (template)
+    "Allocates buffers for all the attributes in the template.
+TEMPLATE:  a cons containing the number of attributes and a foreign pointer to the attributes.
+RETURN: TEMPLATE"
+  (check-type template template)
+  ;; Allocate for the value attribute a buffer of size the value of the attribute value-len.
+  (let ((vector (cdr template)))
+    (dotimes (i (car template))
+      (let ((attribute (attr-aptr vector i)))
+        (when (null-pointer-p (attr-> attribute %ck:value))
+          (let ((type (attr-> attribute %ck:type)))
+            (cond
+              ((or (= type %ck:+a-wrap-template+) (= type %ck:+a-unwrap-template+))
+               (attribute-allocate-attribute-array attribute))
+              ((= type %ck:+a-allowed-mechanisms+)
+               (attribute-allocate-ulong-array attribute))
+              (t
+               (attribute-allocate-buffer attribute))))))))
+  template)
+
+(defun template-encode (template)
+  "Takes a list of (<attribute-type> . <attribute-value>) and
+allocates and fills a foreign vector of CK_ATTRIBUTE_PTR and
+returns a cons (count . foreign-vector).
+For strings, bytes and arrays, if the value is nil, then we set the pValue to NULL."
+  (check-type template list)
+  (let* ((count   (length template))
+         (result  (foreign-alloc '(:struct %ck:attribute) :count count))
+         (aborted nil))
+    (macrolet ()
+      (unwind-protect
+           (handler-bind ((error (lambda (condition)
+                                   (setf aborted t)
+                                   (error condition))))
+             (loop
+               ;;  (atype . value) here matches attribute-decode CONS.
+               :for (atype . value) :in template
+               :for i :from 0
+               :for attribute := (attr-aptr result i)
+               :do (attribute-fill attribute atype value)
+               :finally (let ((template (cons count result)))
+                          (return template))))
+        (when aborted
+          (template-free (cons count result)))))))
+
+(defun template-pack (template)
+  "Modifes the template, removing the attributes that have unavailable information values.
+RETURN: TEMPLATE
+"
+  (check-type template template)
+  (loop
+    :with vector := (cdr template)
+    :with length := (car template)
+    :with j := 0
+    :for i :below length
+    :for attribute := (attr-aptr vector i)
+    :do (let ((type (attr-> attribute %ck:type))
+              (len  (attr-> attribute %ck:value-len)))
+          (unless (or (unavailable-information-p type)
+                      (unavailable-information-p len))
+            (when (< j i)
+              (attribute-copy (attr-aptr vector j) attribute))
+            (incf j)))
+    :finally (setf (car template) j)
+             (return template)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Object
+
+(defun create-object (session template)
+  (check-type session    session-handle)
+  (check-type template   list)
+  (let ((template (template-encode template)))
+    (unwind-protect
+         (with-foreign-object (object '%ck:object-handle)
+           (check-rv (%ck:create-object session (cdr template) (car template) object) "C_CreateObject")
+           (mem-ref object '%ck:object-handle))
+      (template-free template))))
+
+(defun copy-object (session old-object template)
+  (check-type session    session-handle)
+  (check-type old-object object-handle)
+  (check-type template   list)
+  (let ((template (template-encode template)))
+    (unwind-protect
+         (with-foreign-object (object '%ck:object-handle)
+           (check-rv (%ck:copy-object session old-object (cdr template) (car template) object) "C_CopyObject")
+           (mem-ref object '%ck:object-handle))
+      (template-free template))))
+
+(defun destroy-object (session old-object)
+  (check-type session    session-handle)
+  (check-type old-object object-handle)
+  (check-rv (%ck:destroy-object session old-object) "C_DestroyObject"))
+
+(defun get-object-size (session object)
+  (check-type session    session-handle)
+  (check-type object     object-handle)
+  (with-foreign-object (size :ulong)
+    (check-rv (%ck:get-object-size session object size) "C_GetObjectSize")
+    (mem-ref size :ulong)))
+
+;; HERE
+(defun get-attribute-value (session object template)
+  (check-type session    session-handle)
+  (check-type object     object-handle)
+  (check-type template   list)
+  (let ((template (template-encode template)))
+    (unwind-protect
+         (let ((status
+                 (handler-case
+                     (progn
+                       #+debug (ignore-errors (write-line "Before 1st C_GetAttributeValue") (template-dump template))
+                       (check-rv (%ck:get-attribute-value session object (cdr template) (car template)) "C_GetAttributeValue")
+                       #+debug (ignore-errors (write-line "After 1st C_GetAttributeValue") (template-dump template))
+                       (values))
+                   (:no-error ()  #-(and)(pause () "Ok") :ok)
+                   (pkcs11-error (err)
+                     (case (pkcs11-error-label err)
+                       ((:attribute-sensitive :attribute-type-invalid :buffer-too-small)
+                        #-(and)(pause (list (list '*template* template)
+                                            (list '*error*    err)) "pkcs11-error ~A" err)
+                        (setf template (template-allocate-buffers (template-pack template)))
+                        ;; try again:
+                        (handler-case
+                            (progn
+                              #+debug (ignore-errors (write-line "Before 2nd C_GetAttributeValue") (template-dump template))
+                              (check-rv (%ck:get-attribute-value session object (cdr template) (car template)) "C_GetAttributeValue")
+                              #+debug (ignore-errors (write-line "After 2nd C_GetAttributeValue") (template-dump template))
+                              (values))
+                          (:no-error ()  #-(and)(pause () "Ok") :ok)
+                          (pkcs11-error (err)
+                            (case (pkcs11-error-label err)
+                              ((:attribute-sensitive :attribute-type-invalid  :buffer-too-small)
+                               #-(and)(pause (list (list '*template* template)
+                                                   (list '*error* err)) "pkcs11-error ~A" err)
+                               (pkcs11-error-label err))
+                              (otherwise (error err))))))
+                       (otherwise (error err)))))))
+           #-(and) (pause (list (list '*template* template)
+                                (list '*template* template)) "cleanup")
+           #-(and) (template-dump template)
+           (values (template-decode template) status))
+      #-(and)(pause (list (list '*template* template)) "cleanup")
+      (template-free template))))
+
+(defun set-attribute-value (session object template)
+  (check-type session    session-handle)
+  (check-type object     object-handle)
+  (check-type template   list)
+  (let ((template (template-encode template)))
+    (unwind-protect
+         (check-rv (%ck:set-attribute-value session object (cdr template) (car template))
+                   "C_SetAttributeValue")
+      (template-free template))))
+
+(defun find-objects-init (session template)
+  (check-type session    session-handle)
+  (check-type template   list)
+  (let ((template (template-encode template)))
+    (unwind-protect
+         (check-rv (%ck:find-objects-init session (cdr template) (car template)) "C_FindObjectsInit")
+      (template-free template))))
+
+(defun find-objects (session)
+  (check-type session    session-handle)
+  (let ((buffer-size 128)
+        (result '()))
+    (with-foreign-objects ((objects '%ck:object-handle buffer-size)
+                           (count :ulong))
+      (check-rv (%ck:find-objects session objects buffer-size count) "C_FindObjects")
+      (dotimes (i (mem-ref count :ulong))
+        (push (mem-aref objects :ulong i) result)))
+    (nreverse result)))
+
+(defun find-objects-final (session)
+  (check-type session    session-handle)
+  (check-rv (%ck:find-objects-final session) "C_FindObjectsFinal"))
+
+(defun find-all-objects (session template)
+  (check-type session    session-handle)
+  (check-type template   list)
+  (find-objects-init session template)
+  (unwind-protect
+       (loop
+         :for objects := (find-objects session)
+         :while objects
+         :append objects)
+    (find-objects-final session)))
+
+(defun object-get-all-attributes (session object)
+  (check-type session    session-handle)
+  (check-type object     object-handle)
+  (get-attribute-value session object
+                       (mapcar (lambda (entry)
+                                 ;; This CONS here matches attribute-decode CONS.
+                                 (cons (first entry)
+                                       (let ((type (second entry)))
+                                         (if (atom type)
+                                             (ecase type
+                                               ((:ulong)       0)
+                                               ((:bool)        nil)
+                                               ((:string)      nil)
+                                               ((:bytes :bytes-noint :big-integer)  nil)
+                                               ((:date)        "0000000000000000"))
+                                             (ecase (first type)
+                                               ((:ulong)       0)
+                                               ((:big-integer) nil)
+                                               ((:array)       nil))))))
+                               *attribute-type-map*)))
+
+;;; Encryption
+
+;; Single block:
+;;
+;; (progn (encrypt-init session mechanims key)
+;;        (encrypt bytes [encrypted-length])) -> encrypted-vector
+
+;; Multiple blocks:
+;;
+;; (loop
+;;   :with encrypted-blocks := '()
+;;   :for block :in blocks
+;;     :initially (encrypt-init session mechanims key)
+;;   :do        (push (encrypt-update session block) encrypted-blocks)
+;;   :finally   (push (encrypt-final  session)       encrypted-blocks)
+;;              (return (apply (function concatenate) 'vector (nreverse encrypted-blocks))))n
+
+
+;;; Decryption
+
+;; Single block:
+;;
+;; (progn (decrypt-init session mechanims key)
+;;        (decrypt bytes [decrypted-length])) -> decrypted-vector
+
+;; Multiple blocks:
+;;
+;; (loop
+;;   :with decrypted-blocks := '()
+;;   :for block :in blocks
+;;     :initially (decrypt-init session mechanims key)
+;;   :do        (push (decrypt-update session block) decrypted-blocks)
+;;   :finally   (push (decrypt-final  session)       decrypted-blocks)
+;;              (return (apply (function concatenate) 'vector (nreverse decrypted-blocks))))n
+
+(deftype mechanism () `(or integer keyword list))
+
+(defun set-mechanism (fmechanism mechanism)
+  ;; mechanism is either a mechanism-type integer or keyword, or a list (mechanism-type parameter parameter-length)
+  (check-type mechanism mechanism)
+  (setf (foreign-slot-value fmechanism '(:struct %ck:mechanism) '%ck:mechanism)     (mechanism-type :encode (if (listp mechanism) (first mechanism) mechanism))
+        (foreign-slot-value fmechanism '(:struct %ck:mechanism) '%ck:parameter)     (or (when (listp mechanism) (second parameter))  (null-pointer))
+        (foreign-slot-value fmechanism '(:struct %ck:mechanism) '%ck:parameter-len) (or (when (listp mechanism) (third  parameter))  0)))
+
+(defmacro define-pkcs11-initializing-function (name low-name c-name &key (keyp t))
+  `(defun ,name (session mechanism ,@(when keyp `(key)))
+     (check-type session   session-handle)
+     (check-type mechanism mechanism)
+     ,@(when keyp `((check-type key object-handle)))
+     (with-foreign-object (fmechanism '(:struct %ck:mechanism))
+       (set-mechanism fmechanism mechanism)
+       (check-rv (,low-name session fmechanism ,@(when keyp `(key))) ,c-name))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun scat (&rest args)
+    (intern (reduce (lambda (a b) (concatenate 'string a b)) args :key (function string)))))
+
+(defmacro define-pkcs11-processing-function (name low-name c-name &key (input '()) (outputp t))
+  "Defines a function to process buffers.
+
+NAME:       the symbol naming the defined function.
+LOW-NAME:   the symbol naming the underlying FFI function.
+C-NAME:     the string naming the C function (for error reporting).
+INPUT:      a list of base parameters; additionnal &key parameters will be provided.
+OUTPUTP:    whether the function returns some output buffer.
+
+NOTE        When OUTPUTP, an additionnal &key OUTPUT parameter allow
+            to pass a pre-allocated buffer.  For all the INPUT and
+            OUTPUT parameters <p>, the additionnal &key <p>-START and
+            <p>-END parameters are provided to specify the range of
+            the buffers to use.  Those buffers are byte vectors.
+
+RETURN:     the OUTPUT byte vector; the position beyond the last byte written.
+"
+  (let ((all-params  (append input (when outputp (list 'output)))))
+    `(defun ,name (session ,@input &key
+                                     ,@(when outputp `(output))
+                                     ,@(mapcan (lambda (parameter)
+                                                 (list `(,(scat parameter '-start) 0)
+                                                       `(,(scat parameter '-end) (length ,parameter))))
+                                               all-params))
+       (check-type session    session-handle)
+       ,@(mapcar (lambda (parameter) `(check-type ,parameter vector)) input)
+       ,@(when outputp `((check-type output (or null vector))))
+       ,@(mapcan (lambda (parameter)
+                   (list `(check-type ,(scat parameter '-start) (integer 0))
+                         `(check-type ,(scat parameter '-end)   (integer 0))))
+                 all-params)
+       (let (,@(mapcar (lambda (parameter)
+                         `(,(scat parameter '-size)  (- ,(scat parameter '-end) ,(scat parameter '-start))))
+                       all-params))
+         (with-foreign-objects (,@(mapcan (lambda (parameter)
+                                            (list `(,(scat 'f parameter) :uchar ,(scat parameter '-size))
+                                                  `(,(scat 'f parameter '-length) :ulong)))
+                                          all-params))
+           ,@(mapcan (lambda (parameter)
+                       (list `(foreign-vector-copy-from ,(scat 'f parameter)
+                                                        :uchar
+                                                        ,(scat parameter '-size)
+                                                        ,parameter
+                                                        :startl ,(scat parameter '-start)
+                                                        :endl ,(scat parameter '-end))))
+                     input)
+           ,@(mapcan (lambda (parameter)
+                       (list `(setf (mem-ref ,(scat 'f parameter '-length) :ulong)
+                                    ,(scat parameter '-size))))
+                     all-params)
+           (check-rv (,low-name session
+                                ,@(mapcan (lambda (parameter) (list (scat 'f parameter) (scat parameter '-size)))
+                                          input)
+                                ,@(mapcan (lambda (parameter) (list (scat 'f parameter) (scat 'f parameter '-length)))
+                                          (when outputp '(output))))
+                     ,c-name)
+           ,@(when outputp
+               `((let ((output (or output (make-array output-end :element-type 'octet)))
+                       (folen  (mem-ref foutput-length :ulong)))
+                   (foreign-vector-copy-to foutput :uchar folen
+                                           output :startl output-start :endl output-end)
+                   (values output (+ output-start folen))))))))))
+
+(define-pkcs11-initializing-function encrypt-init          %ck:encrypt-init          "C_EncryptInit")
+(define-pkcs11-processing-function   encrypt               %ck:encrypt               "C_Encrypt"             :input (clear)          :outputp t)
+(define-pkcs11-processing-function   encrypt-update        %ck:encrypt-update        "C_EncryptUpdate"       :input (clear)          :outputp t)
+(define-pkcs11-processing-function   encrypt-final         %ck:encrypt-final         "C_EncryptFinal"        :input ()               :outputp t)
+
+(define-pkcs11-initializing-function decrypt-init          %ck:decrypt-init          "C_DecryptInit")
+(define-pkcs11-processing-function   decrypt               %ck:decrypt               "C_Decrypt"             :input (crypted)        :outputp t)
+(define-pkcs11-processing-function   decrypt-update        %ck:decrypt-update        "C_DecryptUpdate"       :input (crypted)        :outputp t)
+(define-pkcs11-processing-function   decrypt-final         %ck:decrypt-final         "C_DecryptFinal"        :input ()               :outputp t)
+
+(define-pkcs11-initializing-function sign-init             %ck:sign-init             "C_SignInit")
+(define-pkcs11-processing-function   sign                  %ck:sign                  "C_Sign"                :input (text)           :outputp t)
+(define-pkcs11-processing-function   sign-update           %ck:sign-update           "C_SignUpdate"          :input (text)           :outputp nil)
+(define-pkcs11-processing-function   sign-final            %ck:sign-final            "C_SignFinal"           :input ()               :outputp t)
+(define-pkcs11-initializing-function sign-recover-init     %ck:sign-recover-init     "C_SignRecoverInit")
+(define-pkcs11-processing-function   sign-recover          %ck:sign-recover          "C_SignRecover"         :input (text)           :outputp t)
+
+
+(define-pkcs11-initializing-function verify-init           %ck:verify-init           "C_VerifyInit")
+(define-pkcs11-processing-function   verify                %ck:verify                "C_Verify"              :input (text signature) :outputp nil)
+(define-pkcs11-processing-function   verify-update         %ck:verify-update         "C_VerifyUpdate"        :input (text)           :outputp nil)
+(define-pkcs11-processing-function   verify-final          %ck:verify-final          "C_VerifyFinal"         :input (signature)      :outputp nil)
+(define-pkcs11-initializing-function verify-recover-init   %ck:verify-recover-init   "C_VerifyRecoverInit")
+(define-pkcs11-processing-function   verify-recover        %ck:verify-recover        "C_VerifyRecover"       :input (signature)      :outputp t)
+
+(define-pkcs11-initializing-function digest-init           %ck:digest-init           "C_DigestInit"          :keyp  nil)
+(define-pkcs11-processing-function   digest                %ck:digest                "C_Digest"              :input (data)           :outputp t)
+(define-pkcs11-processing-function   digest-update         %ck:digest-update         "C_DigestUpdate"        :input (data)           :outputp nil)
+(define-pkcs11-processing-function   digest-final          %ck:digest-final          "C_DigestFinal"         :input ()               :outputp t)
+
+(define-pkcs11-processing-function   digest-encrypt-update %ck:digest-encrypt-update "C_DigestEncryptUpdate" :input (clear)          :outputp t)
+(define-pkcs11-processing-function   decrypt-digest-update %ck:decrypt-digest-update "C_DecryptDigestUpdate" :input (crypted)        :outputp t)
+(define-pkcs11-processing-function   sign-encrypt-update   %ck:sign-encrypt-update   "C_SignEncryptUpdate"   :input (clear)          :outputp t)
+(define-pkcs11-processing-function   decrypt-verify-update %ck:decrypt-verify-update "C_DecryptVerifyUpdate" :input (crypted)        :outputp t)
+
+(defun digest-key (session key)
+  (check-type session session-handle)
+  (check-type key     object-handle)
+  (check-rv (%ck:digest-key session key) "C_DigestKey"))
+
+(defun generate-key (session mechanism template)
+  "Generates a new KEY following the TEMPLATE for the given encrytion MECHANISM.
+RETURN: the new key object-handle."
+  (check-type session    session-handle)
+  (check-type mechanism  mechanism)
+  (check-type template   list)
+  (let ((template (template-encode template)))
+    (unwind-protect
+         (with-foreign-objects ((fmechanism '(:struct %ck:mechanism))
+                                (fkey       '%ck:object-handle))
+           (set-mechanism fmechanism mechanism)
+           (check-rv (%ck:generate-key session fmechanism (cdr template) (car template) fkey) "C_GenerateKey")
+           (mem-ref fkey '%ck:object-handle))
+      (template-free template))))
+
+(defun generate-key-pair (session mechanism public-key-template private-key-template)
+    "Generates a new key pair (public and private keys) following the PUBLIC-KEY-TEMPLATE and PRIVATE-KEY-TEMPLATE for the given encrytion MECHANISM.
+RETURN: a list containing the public and private key object-handles."
+  (check-type session               session-handle)
+  (check-type mechanism             mechanism)
+  (check-type public-key-template   list)
+  (check-type private-key-template  list)
+  (let ((public-key-template (template-encode public-key-template)))
+    (unwind-protect
+         (let ((private-key-template (template-encode private-key-template)))
+           (unwind-protect
+                (with-foreign-objects ((fmechanism    '(:struct %ck:mechanism))
+                                       (fpublic-key   '%ck:object-handle)
+                                       (fprivate-key  '%ck:object-handle))
+                  (set-mechanism fmechanism mechanism)
+                  (check-rv (%ck:generate-key-pair session fmechanism
+                                                   (cdr public-key-template)  (car public-key-template)
+                                                   (cdr private-key-template) (car private-key-template)
+                                                   fpublic-key
+                                                   fprivate-key)
+                            "C_GenerateKeyPair")
+                  (list (mem-ref fpublic-key  '%ck:object-handle)
+                        (mem-ref fprivate-key '%ck:object-handle)))
+             (template-free private-key-template)))
+      (template-free public-key-template))))
+
+
+#-(and)
+(progn
+
+(defun wrap-key (session mechanism wrapping-key key)
+  (check-type session      session-handle)
+  (check-type mechanism    mechanism)
+  (check-type wrapping-key object-handle)
+  (check-type key          object-handle)
+  (with-foreign-objects ((fmechanism    '(:struct %ck:mechanism))
+                         )
+    (set-mechanism fmechanism mechanism)
+    (check-rv (%ck:wrap-key session fmechanism
+                            wrapping-key key
+
+                            )
+              "C_WrapKey"))
+
+  (defcfun (wrap-key)    rv
+   (session         session-handle)
+   (mechanism       (:pointer (:struct mechanism)))
+   (wrapping-key    object-handle)
+   (key             object-handle)
+   (wrapped-key     (:pointer :uchar))
+   (wrapped-key-len (:pointer :ulong))))
+
+
+  (defcfun (unwrap-key "C_UnwrapKey")    rv
+    (session         session-handle)
+    (mechanism       (:pointer (:struct mechanism)))
+    (unwrapping-key  object-handle)
+    (wrapped-key     (:pointer :uchar))
+    (wrapped-key-len :ulong)
+    (templ           (:pointer (:struct attribute)))
+    (attribute-count :ulong)
+    (key             (:pointer object-handle)))
+
+  (defcfun (derive-key "C_DeriveKey")    rv
+    (session         session-handle)
+    (mechanism       (:pointer (:struct mechanism)))
+    (base-key        object-handle)
+    (templ           (:pointer (:struct attribute)))
+    (attribute-count :ulong)
+    (key             (:pointer object-handle))))
+
+
+#||
+
+(with-pkcs11
+  (let ((slotid 0))
+    (with-open-session (session slotid)
+      (call-logged-in session slotid (lambda () (encrypt-init session :rsa-pkcs 140415298986736))))))
+;; function not supported
+
+(with-pkcs11
+  (let ((slotid 0))
+    (with-open-session (session slotid)
+      (call-logged-in session slotid (lambda () (encrypt-init session :rsa-pkcs 140415299275584))))))
+;; function not supported
+
+(with-pkcs11
+  (let ((slotid 0))
+    (with-open-session (session slotid)
+      (call-logged-in session slotid (lambda () (encrypt-init session :rsa-pkcs 140415299275584))))))
+
+
+(with-pkcs11
+  (let ((slotid 1))
+    (with-open-session (session slotid)
+      (call-logged-in session slotid (lambda () (encrypt-init session :rsa-pkcs 140588238480352))))))
+
+;; function not implemented (with those keys?)
+
+
+
+
+
+
+(with-pkcs11
+  (let ((slotid 1))
+   (with-open-session (session slotid)
+     (call-logged-in session slotid (lambda () (get-mechanism-list 0))))))
+(with-pkcs11
+  (get-mechanism-list 1))
+(:sha-1 :sha256 :sha384 :sha512 :md5 :ripemd160 4624 :rsa-pkcs :sha1-rsa-pkcs :sha256-rsa-pkcs :rsa-pkcs-key-pair-gen)
+
+||#
+
+
+(defun seed-random (session seed)
+  (with-foreign-object (fseed :uchar (length seed))
+    (dotimes (i (length seed)) (setf (mem-aref fseed :uchar i) (aref seed i)))
+    (check-rv (%ck:seed-random session fseed (length seed)) "C_SeedRandom")))
+
+(defun generate-random (session length)
+  (with-foreign-object (frandom :uchar length)
+    (check-rv (%ck:generate-random session frandom length) "C_GenerateRandom")
+    (foreign-vector frandom :uchar 'octet length)))
+
+
+(defun decode-oid (bytes)
+  ;; It looks like the oid stored in iac/ecc are missing the first two numbers…
+  (list* 2 5 ; iso.ITU-T / X.500
+   (flexi-streams:with-input-from-sequence (stream bytes)
+     (asinine:decode-oid stream))))
+
+(defun encode-oid (oid)
+    (flexi-streams:with-output-to-sequence (stream)
+    (asinine:encode-oid stream (if (and (= 2 (first oid))
+                                        (= 5 (second oid)))
+                                   (cddr oid)
+                                   oid))))
+
+
+;; (decode-oid #(232 40 189 8 15 210 80 0 0 16 77 73 79 67 0 1 1 1))
+;; --> (2 5 4 29 8 15 10576 0 0 16 77 73 79 67 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+
+;;;; THE END ;;;;
+
diff --git a/clext/pkcs11/test-find-objects.c b/clext/pkcs11/test-find-objects.c
new file mode 100644
index 0000000..457a18f
--- /dev/null
+++ b/clext/pkcs11/test-find-objects.c
@@ -0,0 +1,1414 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <stdbool.h>
+#include <dlfcn.h>
+#include <sysexits.h>
+#include <pkcs11.h>
+
+
+
+const char * TAG = "test-find-objects";
+CK_FUNCTION_LIST_PTR p11;
+
+/* ==================== */
+
+void error(const char * format, ...)
+{
+    va_list args;
+    fprintf(stderr, "[%s] ", TAG);
+    va_start(args, format);
+    vfprintf(stderr, format, args);
+    va_end(args);
+    exit(EX_SOFTWARE);
+}
+
+void *  check_memory(void * memory)
+{
+    if (memory)
+    {
+        return memory;
+    }
+    fprintf(stderr, "[%s] out of memory\n", TAG);
+    exit(EX_OSERR);
+}
+
+typedef enum
+{
+    tag_null,
+    tag_unsigned_long,
+    tag_signed_long,
+    tag_string,
+    tag_cons,
+}typetag;
+
+struct string
+{
+    unsigned long size;
+    char *  value;
+};
+
+struct cons
+{
+    struct object *  car;
+    struct object *  cdr;
+};
+
+typedef struct object
+{
+    union
+    {
+        unsigned long u;
+        long l;
+        struct string s;
+        struct cons k;
+    } value;
+    typetag tag;
+} * object;
+
+typetag type_of(object k)
+{
+    return k?k->tag:tag_null;
+}
+
+const char *  label_type_of(object k)
+{
+    switch(type_of(k))
+    {
+      case tag_null:          return "null";
+      case tag_unsigned_long: return "unsigned";
+      case tag_signed_long:   return "long";
+      case tag_string:        return "string";
+      case tag_cons:          return "cons";
+      default:                return "unknown";
+    }
+}
+
+object ul(unsigned long v)
+{
+    object result = check_memory(malloc(sizeof(*result)));
+    result->tag = tag_unsigned_long;
+    result->value.u = v;
+    return result;
+}
+
+unsigned long ulvalue(object ul)
+{
+    if (!ul)
+    {
+        error("type error: expected a unsigned long, got a NIL");
+    }
+    if (ul->tag != tag_unsigned_long)
+    {
+        error("type error: expected a unsigned long, got a %s", label_type_of(ul));
+    }
+    return ul->value.u;
+}
+
+object sl(signed long v)
+{
+    object result = check_memory(malloc(sizeof(*result)));
+    result->tag = tag_signed_long;
+    result->value.l = v;
+    return result;
+}
+
+object string(const char * string)
+{
+    object result = check_memory(malloc(sizeof(*result)));
+    result->tag = tag_string;
+    result->value.s.value = check_memory(strdup(string));
+    result->value.s.size  = strlen(string);
+    return result;
+}
+
+object cons(object car, object cdr)
+{
+    object result = check_memory(malloc(sizeof(*result)));
+    result->tag = tag_cons;
+    result->value.k.car = car;
+    result->value.k.cdr = cdr;
+    return result;
+}
+
+object car(object k)
+{
+    if (!k) return k;
+    if (k->tag != tag_cons)
+    {
+        error("in car type error: expected a cons, got a %s", label_type_of(k));
+    }
+    return k->value.k.car;
+}
+
+object cdr(object k)
+{
+    if (!k) return k;
+    if (k->tag != tag_cons)
+    {
+        error("in cdr type error: expected a cons, got a %s", label_type_of(k));
+    }
+    return k->value.k.cdr;
+}
+
+bool null(object r)
+{
+    return r?false:true;
+}
+
+/* ==================== */
+
+typedef const char * (*label_pr)(CK_ULONG);
+
+const char * certificate_type_label(CK_ULONG value)
+{
+    switch (value)
+    {
+
+      case CKC_X_509:            return "X_509";
+      case CKC_X_509_ATTR_CERT:  return "X_509_ATTR_CERT";
+      case CKC_WTLS:             return "WTLS";
+      case CKC_VENDOR_DEFINED:   return "VENDOR_DEFINED";
+
+      default:
+          {
+              static char buffer[80];
+              snprintf(buffer, sizeof (buffer), "Unknown_Certificate_Type_%lu", value);
+              return buffer;
+          }
+    }
+}
+
+const char * hardware_feature_label(CK_ULONG value)
+{
+    switch (value)
+    {
+
+      case CKH_MONOTONIC_COUNTER: return "MONOTONIC_COUNTER";
+      case CKH_CLOCK:             return "CLOCK";
+      case CKH_USER_INTERFACE:    return "USER_INTERFACE";
+      case CKH_VENDOR_DEFINED:    return "VENDOR_DEFINED";
+
+      case CKA_PIXEL_X:          return "PIXEL_X";
+      case CKA_PIXEL_Y:          return "PIXEL_Y";
+      case CKA_RESOLUTION:       return "RESOLUTION";
+      case CKA_CHAR_ROWS:        return "CHAR_ROWS";
+      case CKA_CHAR_COLUMNS:     return "CHAR_COLUMNS";
+      case CKA_COLOR:            return "COLOR";
+      case CKA_BITS_PER_PIXEL:   return "BITS_PER_PIXEL";
+      case CKA_CHAR_SETS:        return "CHAR_SETS";
+      case CKA_ENCODING_METHODS: return "ENCODING_METHODS";
+      case CKA_MIME_TYPES:       return "MIME_TYPES";
+
+      default:
+          {
+              static char buffer[80];
+              snprintf(buffer, sizeof (buffer), "Unknown_Hardware_Feature_%lu", value);
+              return buffer;
+          }
+    }
+}
+
+const char * key_type_label(CK_ULONG value)
+{
+    switch (value)
+    {
+
+      case CKK_RSA:            return "RSA";
+      case CKK_DSA:            return "DSA";
+      case CKK_DH:             return "DH";
+      case CKK_ECDSA:          return "ECDSA";
+      case CKK_X9_42_DH:       return "X9_42_DH";
+      case CKK_KEA:            return "KEA";
+      case CKK_GENERIC_SECRET: return "GENERIC_SECRET";
+      case CKK_RC2:            return "RC2";
+      case CKK_RC4:            return "RC4";
+      case CKK_DES:            return "DES";
+      case CKK_DES2:           return "DES2";
+      case CKK_DES3:           return "DES3";
+      case CKK_CAST:           return "CAST";
+      case CKK_CAST3:          return "CAST3";
+      case CKK_CAST128:        return "CAST128";
+      case CKK_RC5:            return "RC5";
+      case CKK_IDEA:           return "IDEA";
+      case CKK_SKIPJACK:       return "SKIPJACK";
+      case CKK_BATON:          return "BATON";
+      case CKK_JUNIPER:        return "JUNIPER";
+      case CKK_CDMF:           return "CDMF";
+      case CKK_AES:            return "AES";
+      case CKK_BLOWFISH:       return "BLOWFISH";
+      case CKK_TWOFISH:        return "TWOFISH";
+      case CKK_VENDOR_DEFINED: return "VENDOR_DEFINED";
+
+      default:
+          {
+              static char buffer[80];
+              snprintf(buffer, sizeof (buffer), "Unknown_Key_Type_%lu", value);
+              return buffer;
+          }
+    }
+}
+
+const char * mechanism_type_label(CK_ULONG value)
+{
+    switch (value)
+    {
+
+      case CKM_RSA_PKCS_KEY_PAIR_GEN:     return "RSA_PKCS_KEY_PAIR_GEN";
+      case CKM_RSA_PKCS:                  return "RSA_PKCS";
+      case CKM_RSA_9796:                  return "RSA_9796";
+      case CKM_RSA_X_509:                 return "RSA_X_509";
+      case CKM_MD2_RSA_PKCS:              return "MD2_RSA_PKCS";
+      case CKM_MD5_RSA_PKCS:              return "MD5_RSA_PKCS";
+      case CKM_SHA1_RSA_PKCS:             return "SHA1_RSA_PKCS";
+      case CKM_RIPEMD128_RSA_PKCS:        return "RIPEMD128_RSA_PKCS";
+      case CKM_RIPEMD160_RSA_PKCS:        return "RIPEMD160_RSA_PKCS";
+      case CKM_RSA_PKCS_OAEP:             return "RSA_PKCS_OAEP";
+      case CKM_RSA_X9_31_KEY_PAIR_GEN:    return "RSA_X9_31_KEY_PAIR_GEN";
+      case CKM_RSA_X9_31:                 return "RSA_X9_31";
+      case CKM_SHA1_RSA_X9_31:            return "SHA1_RSA_X9_31";
+      case CKM_RSA_PKCS_PSS:              return "RSA_PKCS_PSS";
+      case CKM_SHA1_RSA_PKCS_PSS:         return "SHA1_RSA_PKCS_PSS";
+      case CKM_DSA_KEY_PAIR_GEN:          return "DSA_KEY_PAIR_GEN";
+      case CKM_DSA:                       return "DSA";
+      case CKM_DSA_SHA1:                  return "DSA_SHA1";
+      case CKM_DH_PKCS_KEY_PAIR_GEN:      return "DH_PKCS_KEY_PAIR_GEN";
+      case CKM_DH_PKCS_DERIVE:            return "DH_PKCS_DERIVE";
+      case CKM_X9_42_DH_KEY_PAIR_GEN:     return "X9_42_DH_KEY_PAIR_GEN";
+      case CKM_X9_42_DH_DERIVE:           return "X9_42_DH_DERIVE";
+      case CKM_X9_42_DH_HYBRID_DERIVE:    return "X9_42_DH_HYBRID_DERIVE";
+      case CKM_X9_42_MQV_DERIVE:          return "X9_42_MQV_DERIVE";
+      case CKM_SHA256_RSA_PKCS:           return "SHA256_RSA_PKCS";
+      case CKM_SHA384_RSA_PKCS:           return "SHA384_RSA_PKCS";
+      case CKM_SHA512_RSA_PKCS:           return "SHA512_RSA_PKCS";
+      case CKM_SHA256_RSA_PKCS_PSS:       return "SHA256_RSA_PKCS_PSS";
+      case CKM_SHA384_RSA_PKCS_PSS:       return "SHA384_RSA_PKCS_PSS";
+      case CKM_SHA512_RSA_PKCS_PSS:       return "SHA512_RSA_PKCS_PSS";
+      case CKM_RC2_KEY_GEN:               return "RC2_KEY_GEN";
+      case CKM_RC2_ECB:                   return "RC2_ECB";
+      case CKM_RC2_CBC:                   return "RC2_CBC";
+      case CKM_RC2_MAC:                   return "RC2_MAC";
+      case CKM_RC2_MAC_GENERAL:           return "RC2_MAC_GENERAL";
+      case CKM_RC2_CBC_PAD:               return "RC2_CBC_PAD";
+      case CKM_RC4_KEY_GEN:               return "RC4_KEY_GEN";
+      case CKM_RC4:                       return "RC4";
+      case CKM_DES_KEY_GEN:               return "DES_KEY_GEN";
+      case CKM_DES_ECB:                   return "DES_ECB";
+      case CKM_DES_CBC:                   return "DES_CBC";
+      case CKM_DES_MAC:                   return "DES_MAC";
+      case CKM_DES_MAC_GENERAL:           return "DES_MAC_GENERAL";
+      case CKM_DES_CBC_PAD:               return "DES_CBC_PAD";
+      case CKM_DES2_KEY_GEN:              return "DES2_KEY_GEN";
+      case CKM_DES3_KEY_GEN:              return "DES3_KEY_GEN";
+      case CKM_DES3_ECB:                  return "DES3_ECB";
+      case CKM_DES3_CBC:                  return "DES3_CBC";
+      case CKM_DES3_MAC:                  return "DES3_MAC";
+      case CKM_DES3_MAC_GENERAL:          return "DES3_MAC_GENERAL";
+      case CKM_DES3_CBC_PAD:              return "DES3_CBC_PAD";
+      case CKM_CDMF_KEY_GEN:              return "CDMF_KEY_GEN";
+      case CKM_CDMF_ECB:                  return "CDMF_ECB";
+      case CKM_CDMF_CBC:                  return "CDMF_CBC";
+      case CKM_CDMF_MAC:                  return "CDMF_MAC";
+      case CKM_CDMF_MAC_GENERAL:          return "CDMF_MAC_GENERAL";
+      case CKM_CDMF_CBC_PAD:              return "CDMF_CBC_PAD";
+      case CKM_MD2:                       return "MD2";
+      case CKM_MD2_HMAC:                  return "MD2_HMAC";
+      case CKM_MD2_HMAC_GENERAL:          return "MD2_HMAC_GENERAL";
+      case CKM_MD5:                       return "MD5";
+      case CKM_MD5_HMAC:                  return "MD5_HMAC";
+      case CKM_MD5_HMAC_GENERAL:          return "MD5_HMAC_GENERAL";
+      case CKM_SHA_1:                     return "SHA_1";
+      case CKM_SHA_1_HMAC:                return "SHA_1_HMAC";
+      case CKM_SHA_1_HMAC_GENERAL:        return "SHA_1_HMAC_GENERAL";
+      case CKM_RIPEMD128:                 return "RIPEMD128";
+      case CKM_RIPEMD128_HMAC:            return "RIPEMD128_HMAC";
+      case CKM_RIPEMD128_HMAC_GENERAL:    return "RIPEMD128_HMAC_GENERAL";
+      case CKM_RIPEMD160:                 return "RIPEMD160";
+      case CKM_RIPEMD160_HMAC:            return "RIPEMD160_HMAC";
+      case CKM_RIPEMD160_HMAC_GENERAL:    return "RIPEMD160_HMAC_GENERAL";
+      case CKM_SHA256:                    return "SHA256";
+      case CKM_SHA256_HMAC:               return "SHA256_HMAC";
+      case CKM_SHA256_HMAC_GENERAL:       return "SHA256_HMAC_GENERAL";
+      case CKM_SHA384:                    return "SHA384";
+      case CKM_SHA384_HMAC:               return "SHA384_HMAC";
+      case CKM_SHA384_HMAC_GENERAL:       return "SHA384_HMAC_GENERAL";
+      case CKM_SHA512:                    return "SHA512";
+      case CKM_SHA512_HMAC:               return "SHA512_HMAC";
+      case CKM_SHA512_HMAC_GENERAL:       return "SHA512_HMAC_GENERAL";
+      case CKM_CAST_KEY_GEN:              return "CAST_KEY_GEN";
+      case CKM_CAST_ECB:                  return "CAST_ECB";
+      case CKM_CAST_CBC:                  return "CAST_CBC";
+      case CKM_CAST_MAC:                  return "CAST_MAC";
+      case CKM_CAST_MAC_GENERAL:          return "CAST_MAC_GENERAL";
+      case CKM_CAST_CBC_PAD:              return "CAST_CBC_PAD";
+      case CKM_CAST3_KEY_GEN:             return "CAST3_KEY_GEN";
+      case CKM_CAST3_ECB:                 return "CAST3_ECB";
+      case CKM_CAST3_CBC:                 return "CAST3_CBC";
+      case CKM_CAST3_MAC:                 return "CAST3_MAC";
+      case CKM_CAST3_MAC_GENERAL:         return "CAST3_MAC_GENERAL";
+      case CKM_CAST3_CBC_PAD:             return "CAST3_CBC_PAD";
+      case CKM_CAST5_KEY_GEN:             return "CAST5_KEY_GEN";
+      case CKM_CAST5_ECB:                 return "CAST5_ECB";
+      case CKM_CAST5_CBC:                 return "CAST5_CBC";
+      case CKM_CAST5_MAC:                 return "CAST5_MAC";
+      case CKM_CAST5_MAC_GENERAL:         return "CAST5_MAC_GENERAL";
+      case CKM_CAST5_CBC_PAD:             return "CAST5_CBC_PAD";
+      case CKM_RC5_KEY_GEN:               return "RC5_KEY_GEN";
+      case CKM_RC5_ECB:                   return "RC5_ECB";
+      case CKM_RC5_CBC:                   return "RC5_CBC";
+      case CKM_RC5_MAC:                   return "RC5_MAC";
+      case CKM_RC5_MAC_GENERAL:           return "RC5_MAC_GENERAL";
+      case CKM_RC5_CBC_PAD:               return "RC5_CBC_PAD";
+      case CKM_IDEA_KEY_GEN:              return "IDEA_KEY_GEN";
+      case CKM_IDEA_ECB:                  return "IDEA_ECB";
+      case CKM_IDEA_CBC:                  return "IDEA_CBC";
+      case CKM_IDEA_MAC:                  return "IDEA_MAC";
+      case CKM_IDEA_MAC_GENERAL:          return "IDEA_MAC_GENERAL";
+      case CKM_IDEA_CBC_PAD:              return "IDEA_CBC_PAD";
+      case CKM_GENERIC_SECRET_KEY_GEN:    return "GENERIC_SECRET_KEY_GEN";
+      case CKM_CONCATENATE_BASE_AND_KEY:  return "CONCATENATE_BASE_AND_KEY";
+      case CKM_CONCATENATE_BASE_AND_DATA: return "CONCATENATE_BASE_AND_DATA";
+      case CKM_CONCATENATE_DATA_AND_BASE: return "CONCATENATE_DATA_AND_BASE";
+      case CKM_XOR_BASE_AND_DATA:         return "XOR_BASE_AND_DATA";
+      case CKM_EXTRACT_KEY_FROM_KEY:      return "EXTRACT_KEY_FROM_KEY";
+      case CKM_SSL3_PRE_MASTER_KEY_GEN:   return "SSL3_PRE_MASTER_KEY_GEN";
+      case CKM_SSL3_MASTER_KEY_DERIVE:    return "SSL3_MASTER_KEY_DERIVE";
+      case CKM_SSL3_KEY_AND_MAC_DERIVE:   return "SSL3_KEY_AND_MAC_DERIVE";
+      case CKM_SSL3_MASTER_KEY_DERIVE_DH: return "SSL3_MASTER_KEY_DERIVE_DH";
+      case CKM_TLS_PRE_MASTER_KEY_GEN:    return "TLS_PRE_MASTER_KEY_GEN";
+      case CKM_TLS_MASTER_KEY_DERIVE:     return "TLS_MASTER_KEY_DERIVE";
+      case CKM_TLS_KEY_AND_MAC_DERIVE:    return "TLS_KEY_AND_MAC_DERIVE";
+      case CKM_TLS_MASTER_KEY_DERIVE_DH:  return "TLS_MASTER_KEY_DERIVE_DH";
+      case CKM_SSL3_MD5_MAC:              return "SSL3_MD5_MAC";
+      case CKM_SSL3_SHA1_MAC:             return "SSL3_SHA1_MAC";
+      case CKM_MD5_KEY_DERIVATION:        return "MD5_KEY_DERIVATION";
+      case CKM_MD2_KEY_DERIVATION:        return "MD2_KEY_DERIVATION";
+      case CKM_SHA1_KEY_DERIVATION:       return "SHA1_KEY_DERIVATION";
+      case CKM_PBE_MD2_DES_CBC:           return "PBE_MD2_DES_CBC";
+      case CKM_PBE_MD5_DES_CBC:           return "PBE_MD5_DES_CBC";
+      case CKM_PBE_MD5_CAST_CBC:          return "PBE_MD5_CAST_CBC";
+      case CKM_PBE_MD5_CAST3_CBC:         return "PBE_MD5_CAST3_CBC";
+      case CKM_PBE_MD5_CAST5_CBC:         return "PBE_MD5_CAST5_CBC";
+      case CKM_PBE_SHA1_CAST5_CBC:        return "PBE_SHA1_CAST5_CBC";
+      case CKM_PBE_SHA1_RC4_128:          return "PBE_SHA1_RC4_128";
+      case CKM_PBE_SHA1_RC4_40:           return "PBE_SHA1_RC4_40";
+      case CKM_PBE_SHA1_DES3_EDE_CBC:     return "PBE_SHA1_DES3_EDE_CBC";
+      case CKM_PBE_SHA1_DES2_EDE_CBC:     return "PBE_SHA1_DES2_EDE_CBC";
+      case CKM_PBE_SHA1_RC2_128_CBC:      return "PBE_SHA1_RC2_128_CBC";
+      case CKM_PBE_SHA1_RC2_40_CBC:       return "PBE_SHA1_RC2_40_CBC";
+      case CKM_PKCS5_PBKD2:               return "PKCS5_PBKD2";
+      case CKM_PBA_SHA1_WITH_SHA1_HMAC:   return "PBA_SHA1_WITH_SHA1_HMAC";
+      case CKM_KEY_WRAP_LYNKS:            return "KEY_WRAP_LYNKS";
+      case CKM_KEY_WRAP_SET_OAEP:         return "KEY_WRAP_SET_OAEP";
+      case CKM_SKIPJACK_KEY_GEN:          return "SKIPJACK_KEY_GEN";
+      case CKM_SKIPJACK_ECB64:            return "SKIPJACK_ECB64";
+      case CKM_SKIPJACK_CBC64:            return "SKIPJACK_CBC64";
+      case CKM_SKIPJACK_OFB64:            return "SKIPJACK_OFB64";
+      case CKM_SKIPJACK_CFB64:            return "SKIPJACK_CFB64";
+      case CKM_SKIPJACK_CFB32:            return "SKIPJACK_CFB32";
+      case CKM_SKIPJACK_CFB16:            return "SKIPJACK_CFB16";
+      case CKM_SKIPJACK_CFB8:             return "SKIPJACK_CFB8";
+      case CKM_SKIPJACK_WRAP:             return "SKIPJACK_WRAP";
+      case CKM_SKIPJACK_PRIVATE_WRAP:     return "SKIPJACK_PRIVATE_WRAP";
+      case CKM_SKIPJACK_RELAYX:           return "SKIPJACK_RELAYX";
+      case CKM_KEA_KEY_PAIR_GEN:          return "KEA_KEY_PAIR_GEN";
+      case CKM_KEA_KEY_DERIVE:            return "KEA_KEY_DERIVE";
+      case CKM_FORTEZZA_TIMESTAMP:        return "FORTEZZA_TIMESTAMP";
+      case CKM_BATON_KEY_GEN:             return "BATON_KEY_GEN";
+      case CKM_BATON_ECB128:              return "BATON_ECB128";
+      case CKM_BATON_ECB96:               return "BATON_ECB96";
+      case CKM_BATON_CBC128:              return "BATON_CBC128";
+      case CKM_BATON_COUNTER:             return "BATON_COUNTER";
+      case CKM_BATON_SHUFFLE:             return "BATON_SHUFFLE";
+      case CKM_BATON_WRAP:                return "BATON_WRAP";
+      case CKM_ECDSA_KEY_PAIR_GEN:        return "ECDSA_KEY_PAIR_GEN";
+      case CKM_ECDSA:                     return "ECDSA";
+      case CKM_ECDSA_SHA1:                return "ECDSA_SHA1";
+      case CKM_ECDH1_DERIVE:              return "ECDH1_DERIVE";
+      case CKM_ECDH1_COFACTOR_DERIVE:     return "ECDH1_COFACTOR_DERIVE";
+      case CKM_ECMQV_DERIVE:              return "ECMQV_DERIVE";
+      case CKM_JUNIPER_KEY_GEN:           return "JUNIPER_KEY_GEN";
+      case CKM_JUNIPER_ECB128:            return "JUNIPER_ECB128";
+      case CKM_JUNIPER_CBC128:            return "JUNIPER_CBC128";
+      case CKM_JUNIPER_COUNTER:           return "JUNIPER_COUNTER";
+      case CKM_JUNIPER_SHUFFLE:           return "JUNIPER_SHUFFLE";
+      case CKM_JUNIPER_WRAP:              return "JUNIPER_WRAP";
+      case CKM_FASTHASH:                  return "FASTHASH";
+      case CKM_AES_KEY_GEN:               return "AES_KEY_GEN";
+      case CKM_AES_ECB:                   return "AES_ECB";
+      case CKM_AES_CBC:                   return "AES_CBC";
+      case CKM_AES_MAC:                   return "AES_MAC";
+      case CKM_AES_MAC_GENERAL:           return "AES_MAC_GENERAL";
+      case CKM_AES_CBC_PAD:               return "AES_CBC_PAD";
+      case CKM_DSA_PARAMETER_GEN:         return "DSA_PARAMETER_GEN";
+      case CKM_DH_PKCS_PARAMETER_GEN:     return "DH_PKCS_PARAMETER_GEN";
+      case CKM_X9_42_DH_PARAMETER_GEN:    return "X9_42_DH_PARAMETER_GEN";
+      case CKM_VENDOR_DEFINED:            return "VENDOR_DEFINED";
+
+      default:
+          {
+              static char buffer[80];
+              snprintf(buffer, sizeof (buffer), "Unknown_Mechanism_Type_%lu", value);
+              return buffer;
+          }
+    }
+}
+
+const char * object_class_label(CK_ULONG value)
+{
+    switch (value)
+    {
+
+      case CKO_DATA:              return "DATA";
+      case CKO_CERTIFICATE:       return "CERTIFICATE";
+      case CKO_PUBLIC_KEY:        return "PUBLIC_KEY";
+      case CKO_PRIVATE_KEY:       return "PRIVATE_KEY";
+      case CKO_SECRET_KEY:        return "SECRET_KEY";
+      case CKO_HW_FEATURE:        return "HW_FEATURE";
+      case CKO_DOMAIN_PARAMETERS: return "DOMAIN_PARAMETERS";
+      case CKO_MECHANISM:         return "MECHANISM";
+      case CKO_VENDOR_DEFINED:    return "VENDOR_DEFINED";
+
+      default:
+          {
+              static char buffer[80];
+              snprintf(buffer, sizeof (buffer), "Unknown_Object_Class_%lu", value);
+              return buffer;
+          }
+    }
+}
+
+
+const char * rv_label(CK_RV rv)
+{
+    switch (rv)
+    {
+      case CKR_OK                               : return "OK";
+      case CKR_CANCEL                           : return "CANCEL";
+      case CKR_HOST_MEMORY                      : return "HOST_MEMORY";
+      case CKR_SLOT_ID_INVALID                  : return "SLOT_ID_INVALID";
+      case CKR_GENERAL_ERROR                    : return "GENERAL_ERROR";
+      case CKR_FUNCTION_FAILED                  : return "FUNCTION_FAILED";
+      case CKR_ARGUMENTS_BAD                    : return "ARGUMENTS_BAD";
+      case CKR_NO_EVENT                         : return "NO_EVENT";
+      case CKR_NEED_TO_CREATE_THREADS           : return "NEED_TO_CREATE_THREADS";
+      case CKR_CANT_LOCK                        : return "CANT_LOCK";
+      case CKR_ATTRIBUTE_READ_ONLY              : return "ATTRIBUTE_READ_ONLY";
+      case CKR_ATTRIBUTE_SENSITIVE              : return "ATTRIBUTE_SENSITIVE";
+      case CKR_ATTRIBUTE_TYPE_INVALID           : return "ATTRIBUTE_TYPE_INVALID";
+      case CKR_ATTRIBUTE_VALUE_INVALID          : return "ATTRIBUTE_VALUE_INVALID";
+      case CKR_DATA_INVALID                     : return "DATA_INVALID";
+      case CKR_DATA_LEN_RANGE                   : return "DATA_LEN_RANGE";
+      case CKR_DEVICE_ERROR                     : return "DEVICE_ERROR";
+      case CKR_DEVICE_MEMORY                    : return "DEVICE_MEMORY";
+      case CKR_DEVICE_REMOVED                   : return "DEVICE_REMOVED";
+      case CKR_ENCRYPTED_DATA_INVALID           : return "ENCRYPTED_DATA_INVALID";
+      case CKR_ENCRYPTED_DATA_LEN_RANGE         : return "ENCRYPTED_DATA_LEN_RANGE";
+      case CKR_FUNCTION_CANCELED                : return "FUNCTION_CANCELED";
+      case CKR_FUNCTION_NOT_PARALLEL            : return "FUNCTION_NOT_PARALLEL";
+      case CKR_FUNCTION_NOT_SUPPORTED           : return "FUNCTION_NOT_SUPPORTED";
+      case CKR_KEY_HANDLE_INVALID               : return "KEY_HANDLE_INVALID";
+      case CKR_KEY_SIZE_RANGE                   : return "KEY_SIZE_RANGE";
+      case CKR_KEY_TYPE_INCONSISTENT            : return "KEY_TYPE_INCONSISTENT";
+      case CKR_KEY_NOT_NEEDED                   : return "KEY_NOT_NEEDED";
+      case CKR_KEY_CHANGED                      : return "KEY_CHANGED";
+      case CKR_KEY_NEEDED                       : return "KEY_NEEDED";
+      case CKR_KEY_INDIGESTIBLE                 : return "KEY_INDIGESTIBLE";
+      case CKR_KEY_FUNCTION_NOT_PERMITTED       : return "KEY_FUNCTION_NOT_PERMITTED";
+      case CKR_KEY_NOT_WRAPPABLE                : return "KEY_NOT_WRAPPABLE";
+      case CKR_KEY_UNEXTRACTABLE                : return "KEY_UNEXTRACTABLE";
+      case CKR_MECHANISM_INVALID                : return "MECHANISM_INVALID";
+      case CKR_MECHANISM_PARAM_INVALID          : return "MECHANISM_PARAM_INVALID";
+      case CKR_OBJECT_HANDLE_INVALID            : return "OBJECT_HANDLE_INVALID";
+      case CKR_OPERATION_ACTIVE                 : return "OPERATION_ACTIVE";
+      case CKR_OPERATION_NOT_INITIALIZED        : return "OPERATION_NOT_INITIALIZED";
+      case CKR_PIN_INCORRECT                    : return "PIN_INCORRECT";
+      case CKR_PIN_INVALID                      : return "PIN_INVALID";
+      case CKR_PIN_LEN_RANGE                    : return "PIN_LEN_RANGE";
+      case CKR_PIN_EXPIRED                      : return "PIN_EXPIRED";
+      case CKR_PIN_LOCKED                       : return "PIN_LOCKED";
+      case CKR_SESSION_CLOSED                   : return "SESSION_CLOSED";
+      case CKR_SESSION_COUNT                    : return "SESSION_COUNT";
+      case CKR_SESSION_HANDLE_INVALID           : return "SESSION_HANDLE_INVALID";
+      case CKR_SESSION_PARALLEL_NOT_SUPPORTED   : return "SESSION_PARALLEL_NOT_SUPPORTED";
+      case CKR_SESSION_READ_ONLY                : return "SESSION_READ_ONLY";
+      case CKR_SESSION_EXISTS                   : return "SESSION_EXISTS";
+      case CKR_SESSION_READ_ONLY_EXISTS         : return "SESSION_READ_ONLY_EXISTS";
+      case CKR_SESSION_READ_WRITE_SO_EXISTS     : return "SESSION_READ_WRITE_SO_EXISTS";
+      case CKR_SIGNATURE_INVALID                : return "SIGNATURE_INVALID";
+      case CKR_SIGNATURE_LEN_RANGE              : return "SIGNATURE_LEN_RANGE";
+      case CKR_TEMPLATE_INCOMPLETE              : return "TEMPLATE_INCOMPLETE";
+      case CKR_TEMPLATE_INCONSISTENT            : return "TEMPLATE_INCONSISTENT";
+      case CKR_TOKEN_NOT_PRESENT                : return "TOKEN_NOT_PRESENT";
+      case CKR_TOKEN_NOT_RECOGNIZED             : return "TOKEN_NOT_RECOGNIZED";
+      case CKR_TOKEN_WRITE_PROTECTED            : return "TOKEN_WRITE_PROTECTED";
+      case CKR_UNWRAPPING_KEY_HANDLE_INVALID    : return "UNWRAPPING_KEY_HANDLE_INVALID";
+      case CKR_UNWRAPPING_KEY_SIZE_RANGE        : return "UNWRAPPING_KEY_SIZE_RANGE";
+      case CKR_UNWRAPPING_KEY_TYPE_INCONSISTENT : return "UNWRAPPING_KEY_TYPE_INCONSISTENT";
+      case CKR_USER_ALREADY_LOGGED_IN           : return "USER_ALREADY_LOGGED_IN";
+      case CKR_USER_NOT_LOGGED_IN               : return "USER_NOT_LOGGED_IN";
+      case CKR_USER_PIN_NOT_INITIALIZED         : return "USER_PIN_NOT_INITIALIZED";
+      case CKR_USER_TYPE_INVALID                : return "USER_TYPE_INVALID";
+      case CKR_USER_ANOTHER_ALREADY_LOGGED_IN   : return "USER_ANOTHER_ALREADY_LOGGED_IN";
+      case CKR_USER_TOO_MANY_TYPES              : return "USER_TOO_MANY_TYPES";
+      case CKR_WRAPPED_KEY_INVALID              : return "WRAPPED_KEY_INVALID";
+      case CKR_WRAPPED_KEY_LEN_RANGE            : return "WRAPPED_KEY_LEN_RANGE";
+      case CKR_WRAPPING_KEY_HANDLE_INVALID      : return "WRAPPING_KEY_HANDLE_INVALID";
+      case CKR_WRAPPING_KEY_SIZE_RANGE          : return "WRAPPING_KEY_SIZE_RANGE";
+      case CKR_WRAPPING_KEY_TYPE_INCONSISTENT   : return "WRAPPING_KEY_TYPE_INCONSISTENT";
+      case CKR_RANDOM_SEED_NOT_SUPPORTED        : return "RANDOM_SEED_NOT_SUPPORTED";
+      case CKR_RANDOM_NO_RNG                    : return "RANDOM_NO_RNG";
+      case CKR_DOMAIN_PARAMS_INVALID            : return "DOMAIN_PARAMS_INVALID";
+      case CKR_BUFFER_TOO_SMALL                 : return "BUFFER_TOO_SMALL";
+      case CKR_SAVED_STATE_INVALID              : return "SAVED_STATE_INVALID";
+      case CKR_INFORMATION_SENSITIVE            : return "INFORMATION_SENSITIVE";
+      case CKR_STATE_UNSAVEABLE                 : return "STATE_UNSAVEABLE";
+      case CKR_CRYPTOKI_NOT_INITIALIZED         : return "CRYPTOKI_NOT_INITIALIZED";
+      case CKR_CRYPTOKI_ALREADY_INITIALIZED     : return "CRYPTOKI_ALREADY_INITIALIZED";
+      case CKR_MUTEX_BAD                        : return "MUTEX_BAD";
+      case CKR_MUTEX_NOT_LOCKED                 : return "MUTEX_NOT_LOCKED";
+      case CKR_FUNCTION_REJECTED                : return "FUNCTION_REJECTED";
+      case CKR_VENDOR_DEFINED                   : return "VENDOR_DEFINED";
+      default:
+
+          {
+              static char buffer[80];
+              snprintf(buffer, sizeof(buffer) - 1, "Unknown return value code: %d (0x%x)", (int)rv, (int)rv);
+              return buffer;
+          }
+    }
+}
+
+void check_rv(CK_RV rv, const char *function)
+{
+    if (rv != CKR_OK)
+    {
+        fprintf(stderr, "%s returned %s\n", function, rv_label(rv));
+        exit(EX_OSERR);
+    }
+}
+
+void WLog_ERR(const char * tag, const char * format,  ...)
+{
+    va_list args;
+    va_start(args, format);
+    fprintf(stderr, "[%s] ", tag);
+    vfprintf(stderr,format, args);
+    va_end(args);
+}
+
+
+const unsigned int PKCS11_MAGIC = 0xd00bed00;
+
+typedef struct pkcs11_module
+{
+	unsigned int magic;
+	void* handle;
+}  pkcs11_module_t;
+
+
+
+CK_RV C_UnloadModule(void* module)
+{
+	pkcs11_module_t* mod = (pkcs11_module_t*) module;
+	if (!mod || mod->magic != PKCS11_MAGIC)
+    {
+        return CKR_ARGUMENTS_BAD;
+    }
+	if (mod->handle != NULL && dlclose(mod->handle) < 0)
+    {
+        return CKR_FUNCTION_FAILED;
+    }
+	memset(mod, 0, sizeof(*mod));
+	free(mod);
+	return CKR_OK;
+}
+
+void* C_LoadModule(const char* mspec, CK_FUNCTION_LIST_PTR_PTR funcs)
+{
+	CK_RV rv;
+    CK_RV (*c_get_function_list)(CK_FUNCTION_LIST_PTR_PTR);
+	pkcs11_module_t* mod = calloc(1, sizeof(*mod));
+	if (mspec == NULL)
+	{
+		free(mod);
+		return NULL;
+	}
+	mod->magic = PKCS11_MAGIC;
+	mod->handle = dlopen(mspec, RTLD_LAZY);
+	if (mod->handle == NULL)
+	{
+		WLog_ERR(TAG, "dlopen failed: %s\n", dlerror());
+		goto failed;
+	}
+
+	/* Get the list of function pointers */
+	c_get_function_list = (CK_RV(*)(CK_FUNCTION_LIST_PTR_PTR))
+            dlsym(mod->handle, "C_GetFunctionList");
+
+	if (!c_get_function_list)
+		goto failed;
+
+	rv = c_get_function_list(funcs);
+
+	if (rv == CKR_OK)
+		return (void*) mod;
+	else
+		WLog_ERR(TAG, "C_GetFunctionList failed %lx", rv);
+
+failed:
+	C_UnloadModule((void*) mod);
+	return NULL;
+}
+
+typedef struct ulvector
+{
+    CK_ULONG count;
+    CK_ULONG_PTR elements;
+} *  ulvectorp;
+
+ulvectorp make_ulvector(CK_ULONG count)
+{
+    ulvectorp result = check_memory(malloc(sizeof(*result)));
+    result->count = count;
+    result->elements = check_memory(calloc(result->count, sizeof(result->elements[0])));
+    memset(result->elements, 0, result->count * sizeof(result->elements[0]));
+    return result;
+}
+
+ulvectorp ulvector_concatenate(ulvectorp a, ulvectorp b)
+{
+    ulvectorp result = make_ulvector(a->count + b->count);
+    memcpy(result->elements,            a->elements, sizeof(a->elements[0])*a->count);
+    memcpy(result->elements + a->count, b->elements, sizeof(b->elements[0])*b->count);
+    return result;
+}
+
+void ulvector_free(ulvectorp * v)
+{
+    free((*v)->elements);
+    free(*v);
+    v = NULL;
+}
+
+void ulvector_print(FILE* out,ulvectorp v)
+{
+    unsigned long i;
+    for (i = 0; i < v->count; i++ )
+    {
+        fprintf(out," %lu",v->elements[i]);
+    }
+    fprintf(out,"\n");
+}
+
+ulvectorp get_slot_list(bool token_present)
+{
+    CK_ULONG count = 0;
+    check_rv(p11->C_GetSlotList(token_present, NULL, &count), "C_GetSlotList");
+    ulvectorp result = make_ulvector(count);
+    check_rv(p11->C_GetSlotList(token_present, result->elements, &(result->count)), "C_GetSlotList");
+    return result;
+}
+
+/* ==================== attributes ==================== */
+
+void attribute_initialize(CK_ATTRIBUTE_PTR attribute, CK_ULONG length, unsigned char filler)
+{
+    attribute->ulValueLen = length;
+    attribute->pValue = check_memory(malloc(attribute->ulValueLen));
+    if (length > 0)
+    {
+        memset(attribute->pValue, filler, length);
+    }
+}
+
+void attribute_free(CK_ATTRIBUTE_PTR attribute)
+{
+    attribute->ulValueLen = CK_UNAVAILABLE_INFORMATION;
+    free(attribute->pValue);
+    attribute->pValue = 0;
+}
+
+typedef enum
+{
+    t_bool             =   1,
+    t_string           =   2,
+    t_date             =   3,
+    t_bytes            =   4,
+    t_ulong            =   (1 << 10),
+    t_array            =   (1 << 11),
+    t_pkcs_types_mask  = ~((1 << 12) - 1),
+    t_key_type         =   (1 << 12),
+    t_attribute        =   (2 << 12),
+    t_attribute_type   =   (3 << 12),
+    t_certificate_type =   (4 << 12),
+    t_hardware_feature =   (5 << 12),
+    t_mechanism_type   =   (6 << 12),
+    t_object_class     =   (7 << 12),
+} type_t;
+
+const char * descriptor_type_label(type_t type)
+{
+    switch (type)
+    {
+      case t_bool:             return "bool";
+      case t_string:           return "string";
+      case t_date:             return "date";
+      case t_bytes:            return "bytes";
+      case t_ulong:            return "ulong";
+      case t_array:            return "array";
+      default:
+          if (type & t_ulong)
+          {
+              switch (type & t_pkcs_types_mask)
+              {
+                case t_key_type:         return "key_type";
+                case t_attribute:        return "attribute";
+                case t_attribute_type:   return "attribute_type";
+                case t_certificate_type: return "certificate_type";
+                case t_hardware_feature: return "hardware_feature";
+                case t_mechanism_type:   return "mechanism_type";
+                case t_object_class:     return "object_class";
+                default:                 return "UNKNOWN_TYPE";
+              }
+          }
+          else if (type & t_array)
+          {
+              switch (type & t_pkcs_types_mask)
+              {
+                case t_attribute:           return "(array attribute)";
+                case t_mechanism_type:      return "(array mechanism_type)";
+                default:                    return "(array UNKNOWN_TYPE)";
+              }
+          }
+          else
+          {
+              return "UNKNOWN_TYPE";
+          }
+    }
+}
+
+typedef struct {
+    CK_ATTRIBUTE_TYPE attribute;
+    type_t            type;
+    const char*       name;
+} attribute_type_map_t;
+
+// OBJECT_ID = DER encoding of the OID indicating the data object type {empty by default},
+
+attribute_type_map_t attribute_type_map[] = {
+    {CKA_CLASS,                       t_ulong|t_object_class,        "CLASS"},
+    {CKA_TOKEN,                       t_bool,                        "TOKEN"},
+    {CKA_PRIVATE,                     t_bool,                        "PRIVATE"},
+    {CKA_LABEL,                       t_string,                      "LABEL"},
+    {CKA_APPLICATION,                 t_string,                      "APPLICATION"},
+    {CKA_VALUE,                       t_bytes,                       "VALUE"},
+    {CKA_OBJECT_ID,                   t_bytes,                       "OBJECT_ID"},  // DER
+    {CKA_CERTIFICATE_TYPE,            t_ulong|t_certificate_type,    "CERTIFICATE_TYPE"},
+    {CKA_ISSUER,                      t_bytes,                      "ISSUER"}, // DER
+    {CKA_SERIAL_NUMBER,               t_bytes,                      "SERIAL_NUMBER"},
+    {CKA_AC_ISSUER,                   t_string,                      "AC_ISSUER"},
+    {CKA_OWNER,                       t_string,                      "OWNER"},
+    {CKA_ATTR_TYPES,                  t_ulong|t_attribute_type,      "ATTR_TYPES"},
+    {CKA_TRUSTED,                     t_bool,                        "TRUSTED"},
+    {CKA_CERTIFICATE_CATEGORY,        t_ulong,                       "CERTIFICATE_CATEGORY"},
+    {CKA_JAVA_MIDP_SECURITY_DOMAIN,   t_bytes,                       "JAVA_MIDP_SECURITY_DOMAIN"},
+    {CKA_URL,                         t_string,                      "URL"},
+    {CKA_HASH_OF_SUBJECT_PUBLIC_KEY,  t_bytes,                       "HASH_OF_SUBJECT_PUBLIC_KEY"},
+    {CKA_HASH_OF_ISSUER_PUBLIC_KEY,   t_bytes,                       "HASH_OF_ISSUER_PUBLIC_KEY"},
+    {CKA_CHECK_VALUE,                 t_bytes,                       "CHECK_VALUE"},
+    {CKA_KEY_TYPE,                    t_ulong|t_key_type,            "KEY_TYPE"},
+    {CKA_SUBJECT,                     t_bytes,                       "SUBJECT"},
+    {CKA_ID,                          t_bytes,                       "ID"},
+    {CKA_SENSITIVE,                   t_bool,                        "SENSITIVE"},
+    {CKA_ENCRYPT,                     t_bool,                        "ENCRYPT"},
+    {CKA_DECRYPT,                     t_bool,                        "DECRYPT"},
+    {CKA_WRAP,                        t_bool,                        "WRAP"},
+    {CKA_UNWRAP,                      t_bool,                        "UNWRAP"},
+    {CKA_SIGN,                        t_bool,                        "SIGN"},
+    {CKA_SIGN_RECOVER,                t_bool,                        "SIGN_RECOVER"},
+    {CKA_VERIFY,                      t_bool,                        "VERIFY"},
+    {CKA_VERIFY_RECOVER,              t_bool,                        "VERIFY_RECOVER"},
+    {CKA_DERIVE,                      t_bool,                        "DERIVE"},
+    {CKA_START_DATE,                  t_date,                        "START_DATE"},
+    {CKA_END_DATE,                    t_date,                        "END_DATE"},
+    {CKA_MODULUS,                     t_bytes,                       "MODULUS"},
+    {CKA_MODULUS_BITS,                t_ulong,                       "MODULUS_BITS"}, // CKA_MODULUS},
+    {CKA_PUBLIC_EXPONENT,             t_bytes,                       "PUBLIC_EXPONENT"},
+    {CKA_PRIVATE_EXPONENT,            t_bytes,                       "PRIVATE_EXPONENT"},
+    {CKA_PRIME_1,                     t_bytes,                       "PRIME_1"},
+    {CKA_PRIME_2,                     t_bytes,                       "PRIME_2"},
+    {CKA_EXPONENT_1,                  t_bytes,                       "EXPONENT_1"},
+    {CKA_EXPONENT_2,                  t_bytes,                       "EXPONENT_2"},
+    {CKA_COEFFICIENT,                 t_bytes,                       "COEFFICIENT"},
+    {CKA_PRIME,                       t_bytes,                       "PRIME"},
+    {CKA_SUBPRIME,                    t_bytes,                       "SUBPRIME"}, // CKA_SUB_PRIME_BITS},
+    {CKA_BASE,                        t_ulong,                       "BASE"},
+    {CKA_PRIME_BITS,                  t_ulong,                       "PRIME_BITS"}, // CKA_PRIME},
+    {CKA_SUB_PRIME_BITS,              t_ulong,                       "SUB_PRIME_BITS"},
+    {CKA_VALUE_BITS,                  t_ulong,                       "VALUE_BITS"},
+    {CKA_VALUE_LEN,                   t_ulong,                       "VALUE_LEN"},
+    {CKA_EXTRACTABLE,                 t_bool,                        "EXTRACTABLE"},
+    {CKA_LOCAL,                       t_bool,                        "LOCAL"},
+    {CKA_NEVER_EXTRACTABLE,           t_bool,                        "NEVER_EXTRACTABLE"},
+    {CKA_ALWAYS_SENSITIVE,            t_bool,                        "ALWAYS_SENSITIVE"},
+    {CKA_KEY_GEN_MECHANISM,           t_ulong|t_mechanism_type,      "KEY_GEN_MECHANISM"},
+    {CKA_MODIFIABLE,                  t_bool,                        "MODIFIABLE"},
+    {CKA_ECDSA_PARAMS,                t_bytes,                       "ECDSA_PARAMS"},
+    {CKA_EC_PARAMS,                   t_bytes,                       "EC_PARAMS"},
+    {CKA_EC_POINT,                    t_bytes,                       "EC_POINT"},
+    {CKA_SECONDARY_AUTH,              t_bytes,                       "SECONDARY_AUTH"},
+    {CKA_AUTH_PIN_FLAGS,              t_bytes,                       "AUTH_PIN_FLAGS"},
+    {CKA_ALWAYS_AUTHENTICATE,         t_bool,                        "ALWAYS_AUTHENTICATE"},
+    {CKA_WRAP_WITH_TRUSTED,           t_bool,                        "WRAP_WITH_TRUSTED"},
+    {CKA_HW_FEATURE_TYPE,             t_ulong|t_hardware_feature,    "HW_FEATURE_TYPE"},
+    {CKA_RESET_ON_INIT,               t_bool,                        "RESET_ON_INIT"},
+    {CKA_HAS_RESET,                   t_bool,                        "HAS_RESET"},
+    {CKA_PIXEL_X,                     t_ulong,                       "PIXEL_X"},
+    {CKA_PIXEL_Y,                     t_ulong,                       "PIXEL_Y"},
+    {CKA_RESOLUTION,                  t_ulong,                       "RESOLUTION"},
+    {CKA_CHAR_ROWS,                   t_ulong,                       "CHAR_ROWS"},
+    {CKA_CHAR_COLUMNS,                t_ulong,                       "CHAR_COLUMNS"},
+    {CKA_COLOR,                       t_bool,                        "COLOR"},
+    {CKA_BITS_PER_PIXEL,              t_ulong,                       "BITS_PER_PIXEL"},
+    {CKA_CHAR_SETS,                   t_string,                      "CHAR_SETS"},
+    {CKA_ENCODING_METHODS,            t_string,                      "ENCODING_METHODS"},
+    {CKA_MIME_TYPES,                  t_string,                      "MIME_TYPES"},
+    {CKA_MECHANISM_TYPE,              t_ulong|t_mechanism_type,      "MECHANISM_TYPE"},
+    {CKA_REQUIRED_CMS_ATTRIBUTES,     t_bytes,                       "REQUIRED_CMS_ATTRIBUTES"},
+    {CKA_DEFAULT_CMS_ATTRIBUTES,      t_bytes,                       "DEFAULT_CMS_ATTRIBUTES"},
+    {CKA_SUPPORTED_CMS_ATTRIBUTES,    t_bytes,                       "SUPPORTED_CMS_ATTRIBUTES"},
+    {CKA_WRAP_TEMPLATE,               t_array|t_attribute,           "WRAP_TEMPLATE"},
+    {CKA_UNWRAP_TEMPLATE,             t_array|t_attribute,           "UNWRAP_TEMPLATE"},
+    {CKA_ALLOWED_MECHANISMS,          t_array|t_mechanism_type,      "ALLOWED_MECHANISMS"},
+    {CKA_VENDOR_DEFINED,              t_bytes,                       "VENDOR_DEFINED"},
+};
+
+
+#define countof(a) (sizeof(a) / sizeof(a[0]))
+
+attribute_type_map_t * find_attribute_descriptor(CK_ATTRIBUTE_TYPE atype)
+{
+    int i = 0;
+    while ((i < countof(attribute_type_map))
+           && (attribute_type_map[i].attribute != atype))
+    {
+        i++;
+    }
+    return (i < countof(attribute_type_map))
+            ?  &(attribute_type_map[i])
+            : NULL;
+}
+
+
+const char * attribute_type_label(CK_ULONG value)
+{
+    attribute_type_map_t * descriptor = find_attribute_descriptor(value);
+    if (descriptor)
+    {
+        return descriptor->name;
+    }
+    else
+    {
+        static char buffer[80];
+        snprintf(buffer, sizeof (buffer), "Unknown_Attribute_Type_%lu", value);
+        return buffer;
+    }
+}
+
+
+/* struct ck_attribute */
+/* { */
+/*   ck_attribute_type_t type; */
+/*   void *value; */
+/*   unsigned long value_len; */
+/* }; */
+/*  */
+/*  */
+/* struct ck_date */
+/* { */
+/*   unsigned char year[4]; */
+/*   unsigned char month[2]; */
+/*   unsigned char day[2]; */
+/* }; */
+
+void warnIfTooLong(FILE * out, CK_ULONG length, CK_ULONG maximum)
+{
+    if (length > maximum)
+    {
+        fprintf(out, " ; warning: length = %lu greater than expected %lu",
+                length, maximum);
+    }
+}
+
+void raw_string_print(FILE * out, const char * string, unsigned long length)
+{
+    while (0 < length)
+    {
+        if ((*string == '"') || (*string ==  '\\'))
+        {
+            fprintf(out, "\\%c", *string);
+        }else
+        {
+            fprintf(out, "%c", *string);
+        }
+        string++;
+        length--;
+    }
+}
+
+void raw_ulong_print(FILE * out, CK_ULONG value, label_pr label_of, const char * title)
+{
+    if (title)
+    {
+        fprintf(out, "%s", title);
+    }
+    if (CK_UNAVAILABLE_INFORMATION ==  value)
+    {
+        fprintf(out, ":UNAVAILABLE_INFORMATION");
+    }
+    else if (label_of)
+    {
+        fprintf(out, "%s", label_of(value));
+    }
+    else
+    {
+        fprintf(out, "%lu", value);
+    }
+}
+
+
+bool attribute_present_p(CK_ATTRIBUTE_PTR attribute)
+{
+    return (attribute->ulValueLen != CK_UNAVAILABLE_INFORMATION);
+}
+
+void attribute_print(FILE* out, CK_ATTRIBUTE_PTR attribute)
+{
+    attribute_type_map_t * descriptor = find_attribute_descriptor(attribute->type);
+    CK_ULONG maximum = 0;
+    fprintf(out,"(:%-30s ", attribute_type_label(attribute->type));
+    if (attribute->ulValueLen == CK_UNAVAILABLE_INFORMATION)
+    {
+        fprintf(out,":UNAVAILABLE_INFORMATION");
+    }
+    else if (descriptor)
+    {
+        fprintf(out, "(:length %4lu) ",  attribute->ulValueLen);
+        switch (descriptor->type)
+        {
+          case t_bool:
+              maximum = sizeof(CK_BBOOL);
+              if (attribute->ulValueLen >= sizeof(CK_BBOOL))
+              {
+                  fprintf(out, "%s",(*(CK_BBOOL*)(attribute->pValue)
+                                     ? "true"
+                                     :"false"));
+              }
+              else
+              {
+                  fprintf(out, "unknown");
+              }
+              break;
+
+          case t_ulong:
+              if (attribute->ulValueLen >= sizeof(CK_ULONG))
+              {
+                  raw_ulong_print(out, *(CK_ULONG*)(attribute->pValue), NULL, NULL);
+              }
+              else
+              {
+                  fprintf(out, "unknown");
+              }
+              break;
+
+          case t_string:
+
+              fprintf(out, "\"");
+              raw_string_print(out, (const char *)(attribute->pValue), attribute->ulValueLen);
+              fprintf(out, "\"");
+              break;
+
+          case t_bytes:
+              {
+                  CK_ULONG length = attribute->ulValueLen;
+                  const CK_CHAR * bytes = (const CK_CHAR *)(attribute->pValue);
+                  const char *  sep = "";
+                  fprintf(out, "#(");
+                  while (0 < length)
+                  {
+                      fprintf(out, "%s#x%02x", sep, *bytes);
+                      bytes++;
+                      length--;
+                      sep = " ";
+                  }
+                  fprintf(out, ")");
+              }
+              break;
+
+          case t_date:
+              maximum = 8 + 8;
+              if (attribute->ulValueLen == 8)
+              {
+                  raw_string_print(out, (const char *)(attribute->pValue), attribute->ulValueLen);
+              }
+              else if (attribute->ulValueLen ==  8 + 8)
+              {
+                  raw_string_print(out, (const char *)(attribute->pValue), attribute->ulValueLen);
+              }
+              else
+              {
+                  fprintf(out, "unknown");
+              }
+              break;
+
+          default:
+              if (descriptor->type & t_ulong)
+              {
+                  label_pr label_of = 0;
+                  const char * title = 0;
+                  maximum = sizeof(CK_ULONG);
+                  switch (descriptor->type & t_pkcs_types_mask)
+                  {
+                    case t_attribute_type:       label_of = attribute_type_label;     break;
+                    case t_certificate_type:     label_of = certificate_type_label;   break;
+                    case t_hardware_feature:     label_of = hardware_feature_label;   break;
+                    case t_key_type:             label_of = key_type_label;           break;
+                    case t_mechanism_type:       label_of = mechanism_type_label;     break;
+                    case t_object_class:         label_of = object_class_label;       break;
+                    default:                     title = "# | unknown type |# ";      break;
+                  }
+                  raw_ulong_print(out, *(CK_ULONG*)(attribute->pValue), label_of, title);
+              }
+              else if (descriptor->type & t_array)
+              {
+                  switch (descriptor->type & t_pkcs_types_mask)
+                  {
+                    case t_attribute: /* fall thru */
+                    case t_mechanism_type:
+                        /* attribute_initialize( &(template->attributes[i]), 0,  0); */
+                        break;
+                    default:
+                        /* error("Invalid type in attribute_type_map[%lu]: 0x%08x", */
+                        /*       i, attribute_type_map[i].type); */
+                        break;
+                  }
+              }
+              else
+              {
+                  /* error("Invalid type in attribute_type_map[%lu]: 0x%08x", */
+                  /*       i, attribute_type_map[i].type); */
+              }
+        }
+    }
+
+    fprintf(out, ")");
+    if (maximum > 0)
+    {
+        warnIfTooLong(out, attribute->ulValueLen, maximum);
+    }
+}
+
+/* ==================== templates ==================== */
+
+typedef struct template
+{
+    CK_ULONG count;
+    CK_ATTRIBUTE_PTR  attributes;
+} * templatep;
+
+templatep make_template(CK_ULONG count)
+{
+    templatep result = check_memory(malloc(sizeof(*result)));
+    result->count = count;
+    result->attributes = check_memory(calloc(result->count, sizeof(result->attributes[0])));
+    memset(result->attributes, 0, result->count * sizeof(result->attributes[0]));
+    return result;
+}
+
+void template_free(templatep * template)
+{
+    CK_ULONG i;
+    for(i = 0; i < (*template)->count; i++)
+    {
+        CK_ATTRIBUTE_PTR attribute = & ((*template)->attributes[i]);
+        attribute_free(attribute);
+    }
+    free((*template)->attributes);
+    free(*template);
+    (*template) = NULL;
+}
+
+CK_ATTRIBUTE_PTR template_find_attribute(templatep template, CK_ATTRIBUTE_TYPE atype)
+{
+    CK_ULONG i = 0;
+    while ((i < template->count) && (template->attributes[i].type != atype))
+    {
+        i++;
+    }
+    return (i < template->count)
+            ? &(template->attributes[i])
+            : NULL;
+}
+
+void check_descriptor_type(CK_ATTRIBUTE_TYPE atype, type_t type)
+{
+    attribute_type_map_t * descriptor = find_attribute_descriptor(atype);
+    if (descriptor->type != type)
+    {
+        error("Attribute %s: type error, trying to get %s, is %s",
+              attribute_type_label(atype),
+              descriptor_type_label(type),
+              descriptor_type_label(descriptor->type));
+    }
+}
+
+CK_ULONG template_get_ulong_attribute(templatep template, CK_ATTRIBUTE_TYPE atype)
+{
+    check_descriptor_type(atype, t_ulong);
+    CK_ATTRIBUTE_PTR attribute = template_find_attribute(template,atype);
+    if (attribute && (attribute->ulValueLen == sizeof (CK_ULONG)))
+    {
+        return *(CK_ULONG *)attribute->pValue;
+    }
+    else
+    {
+        return CK_UNAVAILABLE_INFORMATION;
+    }
+}
+
+char * template_get_string_attribute(templatep template, CK_ATTRIBUTE_TYPE atype)
+{
+    check_descriptor_type(atype, t_string);
+    CK_ATTRIBUTE_PTR attribute = template_find_attribute(template,atype);
+    if (attribute)
+    {
+        char * string = check_memory(malloc(1 + attribute->ulValueLen));
+        strncpy(string, attribute->pValue, attribute->ulValueLen);
+        string[attribute->ulValueLen] = '\0';
+        return string;
+    }
+    else
+    {
+        return NULL;
+    }
+}
+
+const unsigned char * template_get_buffer_attribute(templatep template, CK_ATTRIBUTE_TYPE atype, CK_ULONG * length)
+{
+    check_descriptor_type(atype, t_bytes);
+    CK_ATTRIBUTE_PTR attribute = template_find_attribute(template,atype);
+    if (attribute)
+    {
+        (*length) = attribute->ulValueLen;
+        return attribute->pValue;
+    }
+    else
+    {
+        (*length) = CK_UNAVAILABLE_INFORMATION;
+        return NULL;
+    }
+}
+
+void template_print(FILE * out, templatep template)
+{
+    const char * sep = "";
+    CK_ULONG i;
+    fprintf(out, "(");
+    for (i = 0; i < template->count; i++)
+    {
+        if (attribute_present_p(&(template->attributes[i])))
+        {
+            fprintf(out, "%s", sep);
+            attribute_print(out, &(template->attributes[i]));
+            sep = "\n ";
+        }
+    }
+    fprintf(out, ")");
+}
+
+templatep make_full_template(bool allocate_buffers)
+{
+    templatep template = make_template(countof(attribute_type_map));
+    CK_ULONG i;
+    for (i = 0; i < template->count; i++)
+    {
+        template->attributes[i].type = attribute_type_map[i].attribute;
+        switch (attribute_type_map[i].type)
+        {
+          case t_bool:
+              attribute_initialize( &(template->attributes[i]), sizeof(CK_BBOOL),  0);
+              break;
+
+          case t_ulong:
+              attribute_initialize( &(template->attributes[i]), sizeof(CK_ULONG),  0);
+              break;
+
+          case t_string: /* fall thru */
+          case t_bytes:
+              attribute_initialize( &(template->attributes[i]), allocate_buffers?128:0,  0);
+              break;
+
+          case t_date:
+              attribute_initialize( &(template->attributes[i]), 16,  '0');
+              break;
+
+          default:
+              if (attribute_type_map[i].type & t_ulong)
+              {
+                  attribute_initialize( &(template->attributes[i]), sizeof(CK_ULONG),  0);
+                  /*
+                  switch (attribute_type_map[i].type & t_pkcs_types_mask)
+                  {
+                  case t_attribute_type:
+                  case t_certificate_type:
+                  case t_hardware_feature:
+                  case t_key_type:
+                  case t_mechanism_type:
+                  case t_object_class:
+                  default:
+                  }
+                  */
+              }
+              else if (attribute_type_map[i].type & t_array)
+              {
+                  switch (attribute_type_map[i].type & t_pkcs_types_mask)
+                  {
+                    case t_attribute: /* fall thru */
+                    case t_mechanism_type:
+                        attribute_initialize( &(template->attributes[i]), 0,  0);
+                        break;
+                    default:
+                        error("Invalid type in attribute_type_map[%lu]: 0x%08x",
+                              i, attribute_type_map[i].type);
+                  }
+              }
+              else
+              {
+                  error("Invalid type in attribute_type_map[%lu]: 0x%08x",
+                        i, attribute_type_map[i].type);
+              }
+        }
+    }
+    return template;
+}
+
+/* ==================== objects ==================== */
+
+
+templatep object_get_all_attributes(CK_SESSION_HANDLE session, CK_OBJECT_HANDLE object)
+{
+    templatep template = make_full_template(true);
+    CK_RV rv = p11->C_GetAttributeValue(session, object, template->attributes, template->count);
+    switch (rv)
+    {
+      case CKR_ATTRIBUTE_SENSITIVE: /* fall thru */
+      case CKR_ATTRIBUTE_TYPE_INVALID: /* fall thru */
+          /* that's ok */
+          break;
+      case CKR_BUFFER_TOO_SMALL:
+          {
+              CK_ULONG valuelen = template_get_ulong_attribute(template, CKA_VALUE_LEN);
+              CK_ATTRIBUTE_PTR value_attribute = template_find_attribute(template, CKA_VALUE);
+              if (value_attribute && valuelen)
+              {
+                  /*  Let's try again with a bigger buffer */
+                  value_attribute->pValue = realloc(value_attribute->pValue, valuelen);
+                  value_attribute->ulValueLen = valuelen;
+                  rv = p11->C_GetAttributeValue(session, object, template->attributes, template->count);
+                  /* TODO: check the other buffers! */
+                  switch (rv)
+                  {
+                    case CKR_ATTRIBUTE_SENSITIVE: /* fall thru */
+                    case CKR_ATTRIBUTE_TYPE_INVALID: /* fall thru */
+                        /* that's ok */
+                        break;
+                    case CKR_BUFFER_TOO_SMALL:
+                        break;
+                    default:
+                        check_rv(rv,"C_GetAttributeValue");
+                        break;
+                  }
+              }
+          }
+          break;
+
+      default:
+          check_rv(rv,"C_GetAttributeValue");
+          break;
+    }
+    return template;
+}
+
+
+
+ulvectorp find_all_objects(CK_SESSION_HANDLE session, templatep template)
+{
+    CK_ULONG total = 0;
+    CK_ULONG count = 0;
+    ulvectorp objects = make_ulvector(0);
+    ulvectorp new_objects = make_ulvector(128);
+    fprintf(stderr,"p11->C_FindObjectsInit = %p\n",(void*)(p11->C_FindObjectsInit));
+    check_rv(p11->C_FindObjectsInit(session,
+                                    template?template->attributes:0,
+                                    template?template->count:0), "C_FindObjectsInit");
+    check_rv(p11->C_FindObjects(session, new_objects->elements, new_objects->count, &count), "C_FindObjects");
+    while (count > 0)
+    {
+        ulvectorp old_objects = objects;
+        new_objects->count = count;
+        objects = ulvector_concatenate(old_objects, new_objects);
+        ulvector_free( & old_objects);
+        ulvector_free( & new_objects);
+        new_objects = make_ulvector(128);
+        check_rv(p11->C_FindObjects(session, new_objects->elements, new_objects->count, &count), "C_FindObjects");
+    }
+    check_rv(p11->C_FindObjectsFinal(session), "C_FindObjectsFinal");
+    ulvector_free( & new_objects);
+    return objects;
+}
+
+
+
+
+//  #define PKCS11_LIBRARY_PATH "/usr/local/lib/libiaspkcs11.so"
+#define PKCS11_LIBRARY_PATH "/usr/local/lib/opensc-pkcs11.so"
+
+int main()
+{
+    pkcs11_module_t* pkcs11_module = C_LoadModule(PKCS11_LIBRARY_PATH, &p11);
+    check_rv(p11->C_Initialize(NULL_PTR), "C_Initialize");
+    ulvectorp slots = get_slot_list(true);
+    if (slots->count >= 1)
+    {
+        CK_ULONG slot = slots->elements[0];
+        CK_SESSION_HANDLE session;
+        printf("(:slots "); ulvector_print(stdout,slots); printf(")\n");
+        ulvector_free(&slots);
+        check_rv(p11->C_OpenSession(slot, CKF_SERIAL_SESSION,  NULL, NULL, & session), "C_OpenSession");
+
+        templatep template = make_full_template(false);
+        ulvectorp objects = find_all_objects(session, NULL);
+        CK_ULONG i;
+        printf("(:objects "); ulvector_print(stdout,objects); printf(")\n");
+        printf("(");
+        for (i = 0;i < objects->count; i++ )
+        {
+            CK_ULONG oid = objects->elements[i];
+            printf("(:object %lu\n", oid);
+            templatep attributes = object_get_all_attributes(session, oid);
+            template_print(stdout,attributes);
+            printf(")\n");
+        }
+        printf(")\n");
+        check_rv(p11->C_CloseSession(session), "C_CloseSession");
+    }else
+    {
+        printf("No smartcard!\n");
+    }
+    fflush(stdout);
+    check_rv(p11->C_Finalize(NULL_PTR), "C_Finalize");
+    C_UnloadModule(pkcs11_module);
+    return 0;
+}
diff --git a/clext/pkcs11/tests.lisp b/clext/pkcs11/tests.lisp
new file mode 100644
index 0000000..f0ebd70
--- /dev/null
+++ b/clext/pkcs11/tests.lisp
@@ -0,0 +1,381 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               tests.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Some tests of the pkcs11 package.
+;;;;
+;;;;    Note they're not (YET) actual unit tests (automatic tests,
+;;;;    resulting in success / failure status), but more debugging
+;;;;    tools and exercises of the pkcs11 functions that need manual
+;;;;    validation. (And definitely manual intervention: insert the
+;;;;    Smartcard in the Smartcard reader, key-in PIN codes, etc).
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2018-04-25 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2018 - 2018
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(in-package "COM.INFORMATIMAGO.CLEXT.PKCS11")
+
+
+(defcfun (mtrace   "mtrace")   :void)
+(defcfun (muntrace "muntrace") :void)
+
+(defun call-with-mtrace (log-pathname thunk)
+  #+darwin (declare (ignore log-pathname))
+  ;; TODO: darwin: use libgmalloc.
+  #+linux
+  (let* ((mtrace-envvar "MALLOC_TRACE")
+         (old-mtrace  (ccl:getenv mtrace-envvar)))
+    (ccl:setenv mtrace-envvar (namestring log-pathname))
+    (mtrace)
+    (unwind-protect
+         (funcall thunk)
+      (muntrace)
+      (if old-mtrace
+          (ccl:setenv mtrace-envvar old-mtrace)
+          (ccl:unsetenv mtrace-envvar))))
+  #+darwin
+  (funcall thunk))
+
+(defmacro with-mtrace ((log-pathname) &body body)
+  `(call-with-mtrace ,log-pathname (lambda () ,@body)))
+
+
+
+(defun print-error (condition)
+  (format t "~&~A~%" condition)
+  (force-output))
+
+(defun safe-get-list-of-slots-with-token ()
+  (or (get-slot-list t)
+      (progn
+        (format t "No smartcart~%")
+        (finish-output)
+        '())))
+
+(defun test/string-to-utf-8 ()
+  (assert (equalp (string-to-utf-8 "Ça roule en été!" :size 18 :padchar #\space)
+                  #(195 135 97 32 114 111 117 108 101 32 101 110 32 195 169 116 195 169)))
+  (assert (nth-value 1 (ignore-errors (progn (string-to-utf-8 "Ça roule en été!" :size 17 :padchar #\space) t))))
+  (assert (equalp (string-to-utf-8 "Ça roule en été!" :size 16 :padchar #\space)
+                  #(195 135 97 32 114 111 117 108 101 32 101 110 32 195 169 116)))
+  (assert (equalp (string-to-utf-8 "Ça roule en été!" :size 24 :padchar #\space)
+                  #(195 135 97 32 114 111 117 108 101 32 101 110 32 195 169 116 195 169 33 32 32 32 32 32)))
+  (assert (nth-value 1 (ignore-errors (progn (string-to-utf-8 "Ça roule en été!" :size 24 :padchar (character "∞")) t))))
+  (assert (equalp (string-to-utf-8 "Ça roule en été!" :size 25 :padchar (character "∞"))
+                  #(195 135 97 32 114 111 117 108 101 32 101 110 32 195 169 116 195 169 33 226 136 158 226 136 158)))
+  :success)
+
+(defun test/session ()
+  (with-pkcs11
+    (dolist (slot-id (safe-get-list-of-slots-with-token))
+      (with-open-session (session slot-id :if-open-session-fails nil)
+        (print (when session (get-session-info session))))))
+  :success)
+
+(defun test/operation-state ()
+  (with-pkcs11
+    (dolist (slot-id (safe-get-list-of-slots-with-token))
+      (handler-case
+          (with-open-session (session slot-id :if-open-session-fails nil)
+            (let ((state (get-operation-state session)))
+              (print state)
+              (set-operation-state session state)))
+        (pkcs11-error (err) (print-error err)))))
+  :success)
+
+(defun test/login ()
+  (with-pkcs11
+    (dolist (slot-id (safe-get-list-of-slots-with-token))
+      (with-open-session (session slot-id)
+            (let ((*verbose* t))
+              (do-logged-in (session slot-id)
+                (write-line "Inside logged session.")
+                (finish-output))))))
+  (finish-output)
+  :success)
+
+
+(defun test/slots-and-mechanisms ()
+  (test/string-to-utf-8)
+  (with-pkcs11
+    (format t "Info: ~S~%" (get-info))
+    (format t "All Slot IDs: ~S~%" (get-slot-list nil))
+    (format t "~:{- Slot ID: ~A~%  Slot Info: ~S~%~%~}"
+            (mapcar (lambda (slot-id)
+                      (list slot-id
+                            (handler-case (get-slot-info slot-id)
+                              (error (err) (princ-to-string err)))))
+                    (get-slot-list nil)))
+    (format t "Slot IDs with a token: ~S~%" (get-slot-list t))
+    (format t "~:{- Slot ID: ~A~%  Slot Info: ~S~%  Token Info: ~S~
+               ~%  Mechanism list: ~{~A~^~%                  ~}~%~}"
+            (mapcar (lambda (slot-id)
+                      (list slot-id
+                            (handler-case (get-slot-info slot-id)
+                              (error (err) (princ-to-string err)))
+                            (handler-case (get-token-info slot-id)
+                              (error (err) (princ-to-string err)))
+                            (handler-case (mapcar (lambda (mechanism-type)
+                                                    (list mechanism-type
+                                                          (get-mechanism-info slot-id mechanism-type)))
+                                                  (get-mechanism-list slot-id))
+                              (error (err) (list (princ-to-string err))))))
+                    (get-slot-list t))))
+  :success)
+
+(defun test/template-encode ()
+ (let ((template (template-encode
+                  '((:class . :data)
+                    (:application . "My Test Application")
+                    (:token . t)
+                    (:label . "Test Data")
+                    (:value . "Some data object containing some test data. This is it!")))))
+   (template-dump template)
+   (template-free template))
+  :success)
+
+
+(defun test/create-object ()
+  (with-pkcs11
+    (dolist (slot-id (safe-get-list-of-slots-with-token))
+      (with-open-session (session slot-id)
+        (handler-case
+            (print (create-object session '((:class . :data)
+                                            (:application . "My Test Application")
+                                            (:token . t)
+                                            (:label . "Test Data")
+                                            (:value . "Some data object containing some test data. This is it!"))))
+          (pkcs11-error (err) (print-error err))))))
+  :success)
+
+;; (test/create-object) -> attribute value invalid. would that be the application?
+
+
+(defun test/random ()
+  (write-line ";; seed-random is not supported by ECC-MI.")
+  (write-line ";; generate-random works only on length=0 on ECC-MI (useless).")
+  (with-pkcs11
+    (dolist (slot-id (safe-get-list-of-slots-with-token))
+      (with-open-session (session slot-id)
+        (handler-case
+            (seed-random session (vector (random 256)
+                                         (random 256)
+                                         (random 256)
+                                         (random 256)))
+          (pkcs11-error (err)
+            (print-error err)
+            (unless (eql :function-not-supported (pkcs11-error-label err))
+              (signal err))))
+        (handler-case
+            (generate-random session 4)
+          (pkcs11-error (err)
+            (print-error err)
+            (unless (eql :data-len-range (pkcs11-error-label err))
+              (signal err)))))))
+  :success)
+
+
+;; ; seed-random not supported
+;; (untrace foreign-vector)
+;; (test/random)
+
+;; get-function-status and cancel-function are useless legacy functions. Not implemented.
+
+
+;; (test/session)
+;; (test)
+
+;; (load-library)
+;; (with-pkcs11 (wait-for-slot-event nil)) ;; not supported by   "/usr/local/lib/libiaspkcs11.so"
+
+
+
+(defmacro possibly-logged-in ((session slot-id log-in) &body body)
+  (let ((vsession (gensym "session"))
+        (vslot-id (gensym "slot-id"))
+        (vlog-in  (gensym "log-in"))
+        (fbody    (gensym "body")))
+    `(let ((,vsession ,session)
+           (,vslot-id ,slot-id)
+           (,vlog-in  ,log-in))
+       (flet ((,fbody () ,@body))
+         (if ,vlog-in
+             (call-logged-in ,vsession ,vslot-id (function ,fbody))
+             (,fbody))))))
+
+
+(defun test/find-objects (&optional log-in)
+  (with-pkcs11
+      (dolist (slot-id (safe-get-list-of-slots-with-token))
+        (format t "~2%Slot ~3D~%--------~2%" slot-id)
+      (with-open-session (session slot-id)
+        (possibly-logged-in (session slot-id log-in)
+          (let ((all-objects (find-all-objects session nil)))
+            (pprint all-objects)
+            (dolist (object all-objects)
+              (format t "~&Object Handle: ~A~%~{    ~S~%~}~%" object  (object-get-all-attributes session object))))))))
+  :success)
+
+;; (test/find-objects t)
+
+
+(defun select/encrypt-key ())
+
+(defun test/encrypt ()
+  (with-pkcs11
+    (format t "Info: ~S~%" (get-info))
+    (format t "All Slot IDs: ~S~%" (get-slot-list nil))
+    (format t "~:{- Slot ID: ~A~%  Slot Info: ~S~%~%~}"
+            (mapcar (lambda (slot-id)
+                      (list slot-id
+                            (handler-case (get-slot-info slot-id)
+                              (error (err) (princ-to-string err)))))
+                    (get-slot-list nil)))
+    (format t "Slot IDs with a token: ~S~%" (get-slot-list t))
+    (format t "~:{- Slot ID: ~A~%  Slot Info: ~S~%  Token Info: ~S~
+               ~%  Mechanism list: ~{~A~^~%                  ~}~%~}"
+            (mapcar (lambda (slot-id)
+                      (list slot-id
+                            (handler-case (get-slot-info slot-id)
+                              (error (err) (princ-to-string err)))
+                            (handler-case (get-token-info slot-id)
+                              (error (err) (princ-to-string err)))
+                            (handler-case (mapcar (lambda (mechanism-type)
+                                                    (list mechanism-type
+                                                          (get-mechanism-info slot-id mechanism-type)))
+                                                  (get-mechanism-list slot-id))
+                              (error (err) (list (princ-to-string err))))))
+                    (get-slot-list t)))))
+
+(defun aget (k a) (cdr (assoc k a)))
+
+(defun object-handle (session &key class id token key-type label)
+  (first (find-all-objects session (append (when class    (list (cons :class    class)))
+                                           (when id       (list (cons :id       id)))
+                                           (when token    (list (cons :token    token)))
+                                           (when key-type (list (cons :key-type key-type)))
+                                           (when label    (list (cons :label    label)))))))
+
+(defgeneric key-id (object)
+  (:documentation "KEY-ID specifiers are integers or octet vectors.")
+  (:method ((object vector)) object)
+  (:method ((object list))   (coerce object '(vector octet)))
+  (:method ((object integer))
+    (loop :with id := (make-array 18 :element-type 'octet)
+          :for j :from 0
+          :for p :from (* 8 (1- (length id))) :downto 0 :by 8
+          :do (setf (aref id j) (ldb (byte 8 p) object))
+          :finally (return id))))
+
+
+(defparameter *authentication-key-path* '(:slot-id 0 :token "ECC MI" :id #xe828bd080fd2500000104d494f4300010101))
+(defparameter *signature-key-path*      '(:slot-id 1 :token "ECC MI" :id #xe828bd080fd2500000104d494f4300010103))
+
+;; pub-key value <- authentication  (no login)
+;; priv-key signature -> sign       (login)
+
+(defun get-public-key-value (path)
+  (with-open-session (session (getf path :slot-id))
+    (let* ((pub-key (object-handle session :class :public-key :token (getf path :token) :id (key-id (getf path :id))))
+           (pub-key-value     (let ((attributes (object-get-all-attributes session pub-key)))
+                                (aget :value attributes))))
+      pub-key-value)))
+
+(defun /sign (data signature-key-path)
+  (let ((slot-id (getf signature-key-path :slot-id)))
+    (with-open-session (session slot-id)
+      (do-logged-in (session slot-id "signing the authentication public-key")
+        (let ((sign-private-key  (object-handle session :class :private-key
+                                                        :token (getf signature-key-path :token)
+                                                        :id (key-id (getf signature-key-path :id)))))
+          (sign-init session :sha1-rsa-pkcs sign-private-key)
+          (sign session data :output-end 256))))))
+
+(defun /verify (data signature signature-key-path)
+  (let ((slot-id (getf signature-key-path :slot-id)))
+    (with-open-session (session slot-id)
+      (let ((sign-public-key  (object-handle session :class :public-key
+                                                     :token (getf signature-key-path :token)
+                                                     :id (key-id (getf signature-key-path :id)))))
+        (verify-init session :sha1-rsa-pkcs sign-public-key)
+        (verify session data signature)))))
+
+(defun test/sign&verify (&key
+                           (authentication-key-path *authentication-key-path*)
+                           (signature-key-path      *signature-key-path*))
+    (with-pkcs11
+      (handler-case
+          (let* ((pub-key-value (get-public-key-value authentication-key-path))
+                 (signature     (/sign pub-key-value signature-key-path)))
+            (format t "~&Authentication public-key: ~S~%" pub-key-value)
+            (format t "~&Signature: ~S~%" signature)
+            (format t "~&Verifying signature.~%")
+            (/verify pub-key-value signature signature-key-path)
+            (format t "~&Verifying bad signature.~%")
+            (setf (aref pub-key-value 0) (mod (1+ (aref pub-key-value 0)) 256))
+            (unwind-protect
+                 (princ (nth-value 1 (ignore-errors (/verify pub-key-value signature signature-key-path))))
+              (setf (aref pub-key-value 0) (mod (1- (aref pub-key-value 0)) 256))))
+        (pkcs11-error (err)
+          (if (eql :token-not-present (pkcs11-error-label err))
+              (progn
+                (format t "No smartcart~%")
+                (finish-output))
+              (signal err)))))
+  :success)
+
+(defvar *session* nil)
+(defvar *slot-id* nil)
+
+(defparameter *pjb-auth-key-id* #xe828bd080fd2500000104d494f4300010101)
+(defparameter *pjb-sign-key-id* #xe828bd080fd2500000104d494f4300010103)
+
+(defun done ()
+  (com.informatimago.common-lisp.interactive.interactive:repl-exit))
+
+(defun test/repl (&key ((:slot-id *slot-id*) 0))
+  (with-pkcs11
+    (with-open-session (*session* *slot-id*)
+      (do-logged-in (*session* *slot-id*)
+        (format t "~&Evaluate (done) to log out from the smartcard.~%")
+        (com.informatimago.common-lisp.interactive.interactive:repl :reset-history nil)))))
+
+(defun test/all ()
+  (test/string-to-utf-8)
+  (test/session)
+  (test/operation-state)
+  (test/template-encode)
+  (test/slots-and-mechanisms)
+  (test/create-object)
+  (test/random)
+  (test/find-objects)
+  (test/login)
+  (test/sign&verify))
+
+
+;;;; THE END ;;;;
diff --git a/clext/pkcs11/ulong.c b/clext/pkcs11/ulong.c
new file mode 100644
index 0000000..17da9e8
--- /dev/null
+++ b/clext/pkcs11/ulong.c
@@ -0,0 +1,13 @@
+#include <stdio.h>
+#include <limits.h>
+int main()
+{
+    unsigned long x = ~0;
+    unsigned long y = (unsigned long) -1;
+    printf("%lu\n", x);
+    printf("%lu\n", y);
+    printf("%lu\n", ULONG_MAX);
+    printf("%lu bytes\n", sizeof(x));
+    printf("%lu bits\n", sizeof(x) *  CHAR_BIT);
+    return 0;
+}
ViewGit