CFFI и немного простых макросов

Это просто песня. Немного похож на питонячий ctypes, но ctypes отдыхает. С макросами with-foreign-object и пр, которые автоматически создают/удаляют временные объекты, да еще навернув несколько своих макросов сверху, получается круто!

Так, мне нужно использовать libgcrypt из Common LISP'а.

Небольшой набор нужных мне функций выглядит так:

gcry_error_t gcry_md_open (gcry_md_hd_t *h, int algo, unsigned int flags);

void gcry_md_close (gcry_md_hd_t hd);

void gcry_md_write (gcry_md_hd_t hd, const void *buffer, size_t length);

unsigned char *gcry_md_read (gcry_md_hd_t hd, int algo);

const char *gcry_strerror (gcry_error_t err);

const char *gcry_strsource (gcry_error_t err);

Есть и другие, но для примера достаточно.

Лисповые обертки практически изоморфны C-шным прототипам, и пишутся моментально, думаю SWIG тут будет блистать, хотя не проверял и не совсем уверен. Я тут немного хитрю и ставлю тип :pointer для всех типов, о которых я точно знаю, что это указатель. По честному надо было бы сделать typedef'ы, тоже поддерживаемые CFFI.

(defcfun ("gcry_md_open" gcry-md-open) gcry-error-t
  "open message disgest handle"
  (handle :pointer :pointer)
  (algo :int)
  (flags :unsigned-int))

(defcfun ("gcry_md_close" gcry-md-close) :void
  "close message digest handle"
  (handle :pointer))

(defcfun ("gcry_strerror" gcry-strerror) :string
  (err gcry-error-t))

(defcfun ("gcry_strsource" gcry-strsource) :string
  (err gcry-error-t))

(defcfun ("gcry_md_write" gcry-md-write) :void
  (handle :pointer)
  (buf :string)
  (len size-t))

(defcfun ("gcry_md_read" gcry-md-read) :pointer
  (handle :pointer)
  (algo :int))

Теперь мы получили интерфейс идентичный С-шному. Без него вообще можно было бы обойтись, и везде использовать макрос foreign-funcall, позволяющий вызвать любую функцию по символу в разделяемой библиотеке с аргументами любых типов. Но я решил их написать чтобы задокументировать интерфейс как он выглядит в ЛИСПе и сделать дальшейший код был более понятным. В разных вариантах FFI для Python'а постоянной проблемой были output параметры. Например, gcry_md_open возвращает результат в виде указателя, которых сохраняется в параметре handle (так что handle это фактически двойной указатель). В SWIG'е мне пришлось бы делать странные аннотации, а также читать довольно много примеров как это делается. В CFFI - красота. На помощь приходит макрос CFFI with-foreign-object:

(defun md-open (algo)
  (with-foreign-object (handle :pointer)
    (check-gcry-error (gcry-md-open handle algo 0)
                 (mem-ref handle :pointer))))

CFFI выделяет память под один объект типа :pointer, и связывает указатель на эту память с переменной handle. Память CFFI старается выделить на стеке. Дальше вызывается gcry-md-open с правильным указателем в качестве параметра. Макрос check-gcry-error проверяет код ошибки libgcrypt, если 0 то выаолняет вторую форму и возвращает ее значение, если нет, то возвращает nil, и информацию об ошибках. Вот его определение:

(defmacro check-gcry-error (call-form &optional result-form)
  `(let ((err ,call-form))
     (if (zerop err)
         ,result-form
         (values nil (cons (gcry-strerror err)
                           (gcry-strsource err))))))

Итак, уже можно более менее по лисповски открывать handle. Раз мы уже так обернули gcry-md-open, то для симметрии можно уже и gcry-md-close обернуть. Кроме того, я обернул gcry-md-read и gcry-md-write чтобы в эти функции запихивать векторы. И еще: handle нужно закрывать в любом случае, что бы ни произошло, и тут вся красота макросов в стиле with- ЛИСПа (см. with-hash-algorithm).

(defun md-close (handle)
  (gcry-md-close handle))


(defun md-write (h v)
  (let ((len (length v)))
    (with-foreign-object (data :unsigned-char len)
      (loop for i from 0 below len
           do (setf (mem-aref data :unsigned-char i) (aref v i)))
      (gcry-md-write h data len))))
       
(defun md-read (h algo)
  (let* ((c-digest (gcry-md-read h algo))
         (len 20) ; cheating - 20 bytes is only for SHA-1, I don't need
                  ; anything else, but generally it's a bug
         (v (make-array len :element-type '(unsigned-byte 8))))
    (progn
      (loop for i from 0 below len
         do (setf (aref v i) (mem-aref c-digest :unsigned-char i)))
      v)))

(defmacro with-hash-algorithm (h algo &body body)
  `(multiple-value-bind (,h err) (md-open ,algo)
     (if ,h
         (unwind-protect (progn ,@body (md-read ,h ,algo))
           (md-close ,h))
         (error "error: ~a ~a" (car err) (cdr err)))))

Теперь, если я хочу посчитать хеш нескольких кусков данных, я пишу примерно так (кусок кода, проверяющего PGP подпись):

           (with-hash-algorithm h hash-alg
             (md-write h #(#x99))
             (md-write h (num->2octet (1+ (packet-len whole-packet))))
             (md-write h #(4))
             (md-write-packet h whole-packet)
             (md-write h #(#xB4))
             (md-write h (num->4octet (packet-len user-id-packet)))
             (md-write-packet h user-id-packet)
             (md-write-packet h hashed-data)
             (md-write h (vector #x04 #xFF))
             (md-write h (num->4octet hashed-data-len)))

Уверен, что существуют гораздо более правильные и красивые варианты оборачивания такого интерфейса в CL, но мне такой нравится и для меня сработало хорошо.