среда, 1 апреля 2009 г.

Сделал на ЛИСПе прототип кода, который надо написать на C

Прототип вместе с юнит тестами потянул на 1100 строчек, интересно сколько эквивалентного C-шного кода получится в итоге?

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, но мне такой нравится и для меня сработало хорошо.