Common Lisp CFFI 入门

2021-07-23 约 13636 字预计阅读 28 分钟

CFFI简介

CFFI是Common Foreign Function Interface的缩写，用于和其他语言进行交互，即：调用其他语言编写的接口，以及让其他语言调用本语言编写的代码（比如回调代码）。

由于目前只有C语言有广泛的支持+良好定义的FFI，故实际上CFFI仅对和C语言的互通有良好的支持，所以实际上CFFI可以看成C Foreign Function Interface的缩写。

那如果要调用C++的接口呢？几个选择，比如用支持C++ FFI的Common Lisp实现，比如clasp，或者给C++接口创建对应的C语言wrapper，然后创建wrapper的CFFI 绑定。

给一个C语言库创建对应的Common Lisp绑定的好处

Common Lisp语言设计本身以及社区都非常注重交互式编程（Interactive Programming），很多时候又被称为REPL Based Development，但后者的意义太狭隘了，交互式编程的好处在于快速反馈，你写一个函数（或者其他抽象单元），你可以立马在REPL中evaluate它，然后立马进行各种输入的测试，看结果是否符合预期，如果写错了，能立马调试看看错误在哪，然后即使修正并再次进行测试。整个反馈是即刻的，你可以对比下在C/C++中的工作流，一般你得经历写代码+编译+运行的过程，如果写错了，你得改代码+编译+运行，如此循环，而且一般你还得改代码才能单独测试某个函数，突然想到要换个输入，你又得改代码+编译+ 运行，大部分时间都浪费在编译以及运行时流程每次都得重头走到你要测试的点，你不好得到快速反馈。注意，我这里说的是一般情况，你当然有手段可以建立快速反馈的环境，但是可能需要付出很大的工作量，整个社区又没有注重交互式编程的传统，没有成熟的工具链，各个库也一般都不会特别关注这块。相比之下， Common Lisp的工具链可以非常轻松地单独调用某个普通函数、通用函数， inspect各种value等等，交互可以具体到点，非常方便。回到交互式编程的话题，你可以看出，交互式编程的核心优势在于快速得到反馈，故所有能快速得到反馈的手段都是交互式编程的重要工具，不一定得是REPL（虽然REPL在大部分开发场景中占了很大的比例），比如：你开发一个图片操作库，那能让你预览图片操作过程、结果的整套工具链，你开发一个视频编辑库，能让你预览视频操作过程、结果的整套工具链，等等，反正重点在于快速反馈，这也是我为什么说REPL Based Development这个词狭隘的原因，不一定得是REPL。

废话了那么多，重点是：Common Lisp对交互式编程有良好的支持，给一个C语言库创建对应的Common Lisp绑定，然后在该库的基础上开发Common Lisp库，整个开发过程中的反馈都是快速的，开发过程也是非常愉悦的（因为反馈很快，能快速定位问题，也有成就感，等等）。实际上，连创建绑定的过程都是快速反馈的。

本入门教程的前言

下面，我会把CFFI的官方入门教程过一遍，也就是用libcurl作为例子，不同于官方教程，本文会特别注重动机，我会特别说明，为什么我要做这个事情，其他可选项，等等，其次，本文部分会写的会更细（更啰嗦），所以可能会比较好懂。

注意下：本文的行文思路参考了官方教程，代码是几乎完全从官方教程中拷贝过来的，所以本文并不是原创的，官方教程链接：官方教程。

另外，我还写了一篇更系统地讲解CFFI的文章，它以自底向上的方式讲解CFFI，先学底层抽象，再用底层抽象去构建上层抽象，同时讲解了更多的CFFI特性，读者在读完本篇后可以读那篇文章：Common Lisp CFFI 详解。

libcurl库的获取

首先你得看下你Lisp实现的可执行文件是多少位的，libcurl得和它匹配，比如64位的SBCL就得用64位的libcurl，不能用32位的。

获取的话，UNIX系统就通过包管理器来，Windows下网上搜一下就有了（记得位数匹配）。

创建一个项目

先创建一个项目来写代码，用ASDF来定义整个项目/系统，由于本文的重点不是 ASDF，故关于ASDF的部分不会详细说明。

首先在ASDF能搜索到的路径下创建项目文件夹learn-cffi，比如我是： ~/.roswell/local-projects ，完整项目路径就是 ~/.roswell/local-projects/learn-cffi 。在项目文件夹下创建 learn-cffi.asd，内容如下：

1
2
3
4
5


(defsystem "learn-cffi"
  :description "Learn CFFI."
  :version "0.0.1"
  :depends-on ("cffi")
  :components ((:file "learn-cffi")))

然后创建 ~/.roswell/local-projects/learn-cffi/learn-cffi.lisp ，之后代码都在这个文件里面写，初始内容：

1
2
3
4
5
6


(in-package :cl-user)

(defpackage :learn-cffi
  (:use :cl :cffi))

(in-package :learn-cffi)

这里直接把通过:use把CFFI的所有外部符号都导入进来，不然在创建绑定过程中，会用到CFFI的一堆符号，会稍微麻烦点（不过也可以接受，你也可以选择这种方式）。

加载libcurl到内存中

为了调用libcurl的接口，我们首先需要把libcurl加载到内存中。

在加载之前，我们需要定义libcurl库并告诉CFFI等下加载的时候该去哪里找 libcurl库文件（UNIX系统就是.so文件，Windows就是.dll文件，等等），定义代码如下：

1
2
3
4


(define-foreign-library libcurl
  (:darwin (:or "libcurl.3.dylib" "libcurl.dylib"))
  (:unix (:or "libcurl.so.3" "libcurl.so"))
  (t (:default "libcurl")))

这个定义一看就大概知道是什么意思了：定义一个名为libcurl的库，后面给出不同操作系统下该库的搜索位置。Mac下优先找"libcurl.3.dylib"，找不到再找 “libcurl.dylib”，也就是优先找版本号为3的，找不到再找不带版本号的（祈祷它刚好是我们要的版本）， (:unix (:or "libcurl.so.3" "libcurl.so")) 同理，最后 (t (:default "libcurl")) 表示在其他操作系统下，按libcurl 去搜索。

上面给的搜索位置都是纯名字的形式，搜索位置除了可以是纯名字之外，还可以是绝对路径或者相对路径。如果是纯名字的形式，就按操作系统的动态链接库搜索机制去搜索，比如：

UNIX系统下会涉及二进制位文件的DT_RPATH动态节区属性、LD_LIBRARY_PATH 环境变量、/lib、/usr/lib等等，具体可以参考： ld.so(8) 。
Windows操作系统会设计当前工作目录、程序所在目录、多个系统目录等等，具体可以参考： Dynamic-Link Library Search Order 。

除了按系统搜索机制来搜索，CFFI还会在 *foreign-library-directories* 存储的多个目录中搜索目标DLL，比如我当前用的机器是Windows系统，我可以在 learn-cffi.asd文件的目录下放libcurl.dll，然后添加以下代码：

1

(pushnew (asdf:system-source-directory :learn-cffi) cffi:*foreign-library-directories*)

定义完库，接下来就可以加载它了，调用 use-foreign-library ，

1

(use-foreign-library libcurl)

如果加载失败的话，会signal错误condition，比如说找不到库文件，如果加载成功，返回值会是实现特定的库打印形式，比如我的返回值是： #<FOREIGN-LIBRARY LIBCURL "libcurl.dll"> ）。在Windows下你可以通过 Process Explorer看下我们的Lisp进程中是否有加载libcurl的dll：

下面就是准备定义并调用接口了。

第一个接口，初始化libcurl库

libcurl需要调用一个全局初始化函数后，才能使用其他接口，初始化libcurl的 C语言原型如下：

1

CURLcode curl_global_init(long flags);

flags指定需要libcurl初始化的特性，多个特性flag用 | 运算符合并起来，不熟悉的情况推荐使用 CURL_GLOBAL_ALL ，代表开启除 CURL_GLOBAL_ACK_EINTR 之外的全部特性。

返回值CURLcode是枚举类型 enum CURLcode 的别名，是个通用的返回值类型，大部分需要返回多种错误代码的函数都会以这个类型作为返回值，其中CURLE_OK 代表成功，值为0。

long类型是CFFI直接支持的，不用我们定义，我们需要定义下CURLcode，这里采用最直接的办法，定义成int的别名：

1

(defctype curl-code :int)

注意到，CFFI的内置类型大部分是用关键字符号表示的。

接着，我们用 defcfun 去定义C语言函数 curl_global_init ：

1
2


(defcfun "curl_global_init" curl-code
  (flags :long))

第二个参数指定了C语言函数的名字，第三个参数指定了返回值类型，之后的参数用于指定参数名及对应的类型，形式为：(参数名类型)。

执行完后，会定义一个名为curl-global-init的Lisp函数，接收一个参数flags，调用它便会调用对应的C语言函数。

这里Lisp函数名字"curl-global-init"是在"curl_global_init"基础上转换过来的，符合Lisp命名约定的名字，你如果不满意，可以自己指定，把第一个参数从 "curl_global_init" 替换成 ("curl_global_init" 自定义名字) 即可。

类似的，用于指定参数的 (参数名类型) ，这里参数名不过是用于生成Lisp 函数对应的参数的名字，从而补全时显示的参数名有更好的可读性，实际上你可以指定任意的名字，重要的是参数的位置和类型，而不是名字。

现在，我们可以调用 curl-global-init 了，我们要传递参数 CURL_GLOBAL_ALL ，查看头文件，可以看到 CURL_GLOBAL_ALL 等价于 (CURL_GLOBAL_SSL | CURL_GLOBAL_WIN32) ，而 CURL_GLOBAL_SSL = (1<<0) ， CURL_GLOBAL_WIN32 = (1<<1) ，故 CURL_GLOBAL_ALL = (1 << 0) | (1 << 1) = 11b = 3 ，故我们可以直接执行如下代码进行初始化：

1
2


LEARN-CFFI> (curl-global-init 3)
=> 0

结果为0，代表 CURLE_OK ，即成功。

下面，我们转向创建、销毁CURL句柄的接口。

创建、销毁CURL句柄

创建和销毁CURL句柄的接口原型如下：

1
2


CURL *curl_easy_init( );
void curl_easy_cleanup(CURL *handle);

curl_easy_init 会创建并返回一个CURL句柄，之后我们便可以用这个句柄去做下载指定网页等操作。 curl_easy_cleanup 则用于销毁句柄，从而释放该句柄对应的资源。

这里CURL句柄是个 CURL * 类型的指针，这里为了方便，先直接把它定义成通用类型指针 :pointer ，相当于C语言的 void * ，下面是完整的定义代码：

1
2
3
4
5
6


(defctype easy-handle :pointer)

(defcfun "curl_easy_init" easy-handle)

(defcfun "curl_easy_cleanup" :void
  (easy-handle easy-handle))

这里都是前面已经讲过的东西，没什么特别的，除了返回值类型 :void ，这代表没有返回值。

现在，我们可以创建一个句柄了：

1
2
3
4
5


LEARN-CFFI> (defvar *easy-handle* (curl-easy-init))
*EASY-HANDLE*
LEARN-CFFI> *easy-handle*
#.(SB-SYS:INT-SAP #X000A8CC0)
LEARN-CFFI>

设置下载选项

设置下载选项的函数原型如下：

1

CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...);

所谓的下载选项涵盖面很广，比如下载的目标URL算下载选项，存储下载过程中发生错误时的错误字符串缓冲区也算下载选项。

举个例子，如果我们要设置下载URL，C语言代码如下：

1

curl_easy_setopt(handle, CURLOPT_URL, "http://www.baidu.com");

如果我们要设置不要计算进度且跳过signal处理，代码如下：

1
2


curl_easy_setopt(handle, CURLOPT_NOPROGRESS, 1);
curl_easy_setopt(handle, CURLOPT_NOSIGNAL, 1);

可以看到，选项（第二个参数，为枚举类型）决定了之后传递的参数的个数和类型。

针对这种接口，我们怎么创建对应的绑定呢？示例代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14


(defcfun ("curl_easy_setopt" set-curl-option-url) curl-code
  (easy-handle easy-handle)
  (option :int)
  (url :pointer))

(defcfun ("curl_easy_setopt" set-curl-option-noprogress) curl-code
  (easy-handle easy-handle)
  (option :int)
  (on-off :long))

(defcfun ("curl_easy_setopt" set-curl-option-nosignal) curl-code
  (easy-handle easy-handle)
  (option :int)
  (on-off :long))

这里利用了 defcfun 可以自定义Lisp函数名的特性，这里三个参数类型不同的Lisp函数均调用的是同一个C语言函数。

现在，我们可以在Lisp中设置NOSIGNAL选项了：

1

(set-curl-option-nosignal *easy-handle* 99 1)

注意到两个问题：

99是CURLOPT_NOSIGNAL的枚举值，但是可读性很差。
这个函数名字中已经带nosignal的字眼了，参数为什么还得传递 CURLOPT_NOSIGNAL的枚举值99？理想情况下应该是这么调用的： (set-curl-option-nosignal *easy-handle* 1) 。

我们先解决第一个问题，通过 defcenum 为 CURLoption 创建对应的枚举类型，这样我们可以直接用符号名代替数值，可读性较高。

defcenum 的基础用法如下：

1
2
3
4
5
6


(defcenum boolean
  :no
  :yes)

(foreign-enum-value 'boolean :no) ; => 0
(foreign-enum-value 'boolean :yes) ; => 1

默认第一个枚举常量的值是0，然后一个个往后递增，也可以自己指定枚举常量对应的数值，如下：

1
2
3
4
5
6


(defcenum numbers
  (:one 1)
  :two
  (:four 4))

(foreign-enum-value 'numbers :four) ; => 4

现在，我们可以为 CURLoption 定义对应的枚举类型了，初步我们要定义的C语言枚举值如下：

1
2
3
4
5


#define CURLOPT_NOPROGRESS 43
#define CURLOPT_NOSIGNAL 99

#define CURLOPT_ERRORBUFFER 10010
#define CURLOPT_URL 10002

定义代码如下：

1
2
3
4
5


(defcenum curl-option
  (:noprogress 43)
  (:nosignal 99)
  (:errorbuffer 10010)
  (:url 10002))

注意到，libcurl的枚举值是有规律的，相同值类型的选型枚举值是相邻的，比如值类型为long的选项对应的枚举值都是从0开始的，而值类型为对象指针的选项对应的枚举值都是从10000开始的，具体如下：

1
2
3
4


long类型 枚举值从0开始
对象指针类型 枚举值从10000开始
函数指针类型 枚举值从20000开始
off_t类型 枚举值从30000开始

我们称这个基础值为类型偏移，比如long类型的类型偏移为0，off_t类型的类型偏移为30000。

利用libcurl的这个组织规律，我们可以定义一个 define-curl-options 宏来进一步提高定义CURLoption枚举值的可读性：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18


(defmacro define-curl-options (name type-offsets &rest enum-args)
  "类似CFFI:DEFCENUM，不同于它的是，每个ENUM-ARGS的形式如下：

  (NAME TYPE NUMBER)

这里NAME是要定义的选项对应的Lisp枚举常量，为关键字，如:noprogress，
TYPE代表该选项的值对应的类型；如：long、objectpoint等，
NUMER是枚举常量对应的枚举数值，如：43，

TYPE-OFFSETS是一个plist，该plist的key为选项值的类型，value为该类型对应
的偏移。"
  (flet ((enumerated-value (type offset)
           (+ (getf type-offsets type) offset)))
    `(progn
       (defcenum ,name
         ,@(loop for (name type number) in enum-args
                 collect (list name (enumerated-value type number))))
       ',name)))

光看这个宏的docstring可能还是不明白这个宏怎么用（当然，你看代码是可以看懂该怎么用的），正常情况下，docstring应该包含例子来辅助理解，由于这里我们文章中会给例子，故不把例子写在docstring中。

define-curl-options 的使用例子如下：

1
2
3
4
5
6


(define-curl-options curl-option
    (long 0 objectpoint 10000 functionpoint 20000 off-t 30000)
  (:noprogress long 43)
  (:nosignal long 99)
  (:url objectpoint 2)
  (:errorbuffer objectpoint 10))

这里第一个参数curl-option同 defcenum 一样，是枚举类型的名称，第二个参数type-offsets指定不同选项类型对应的类型偏移，举几个例子： (:noprogress long 43) 对应选项的值类型为long，查找type-offsets可以知道long的类型偏移为0，故:noprogress最终的枚举值为43+0=43，同理， (:errorbuffer objectpoint 10) 对应选项的值类型为objectpoint，查找 type-offsets可以知道objectpoint的类型偏移为10000，故:errorbuffer最终的枚举值为10000+10=10010。

如果还是不明白，可以展开上面的 define-curl-options 宏调用，结果如下：

1
2
3
4
5
6
7


(PROGN
 (DEFCENUM CURL-OPTION
   (:NOPROGRESS 43)
   (:NOSIGNAL 99)
   (:URL 10002)
   (:ERRORBUFFER 10010))
 'CURL-OPTION)

相比于直接用 defcenum ，使用该宏在代码量上会稍微长点，但有一个好处：意义更加明确，你可以一眼看出某个枚举常量对应选项的值的类型是什么，当然，你如果觉得这个没必要，收益也不大，你可以直接用 defcenum 。

回到之前的代码：

1

(set-curl-option-nosignal *easy-handle* 99 1)

我们可以解决第一个问题了，即选项枚举值用数字写可读性差这点：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14


(defcfun ("curl_easy_setopt" set-curl-option-url) curl-code
  (easy-handle easy-handle)
  (option curl-option)
  (url :pointer))

(defcfun ("curl_easy_setopt" set-curl-option-noprogress) curl-code
  (easy-handle easy-handle)
  (option curl-option)
  (on-off :long))

(defcfun ("curl_easy_setopt" set-curl-option-nosignal) curl-code
  (easy-handle easy-handle)
  (option curl-option)
  (on-off :long))

调用可以改成：

1

(set-curl-option-nosignal *easy-handle* :nosignal 1)

现在我们解决第二点：函数名字中已经带nosignal的字眼了，参数为什么还得传递CURLOPT_NOSIGNAL的枚举值99？理想情况下应该是这么调用的： (set-curl-option-nosignal *easy-handle* 1) 。

首先得明确下，各个 set-curl-option-xx 函数，虽然名字不同，但是底层调用的都是 curl_easy_setopt ，该函数第二个参数必须传递CURLoption枚举常量，不能省略，我们想不写第二个参数，可以包装下 set-curl-option-xx 函数，固定住第二个参数，以 set-curl-option-nosignal 为例：

1
2
3
4


(defun set-curl-option-nosignal* (easy-handle on-off)
  (set-curl-option-nosignal easy-handle :nosignal on-off))

(set-curl-option-nosignal* *easy-handle* 1)

更进一步，我们干脆不创建一个额外的函数，直接覆盖 set-curl-option-nosignal 的定义，如下：

1
2
3
4
5
6


(setf (symbol-function 'set-curl-option-nosignal)
      (let ((orig-fun (symbol-function 'set-curl-option-nosignal)))
        (lambda (easy-handle on-off)
          (funcall orig-fun easy-handle :nosignal on-off))))

(set-curl-option-nosignal *easy-handle* 1)

即通过闭包去curry化原函数，固定住第二个参数。

针对各个 set-curl-option-xx 都做这样的操作太麻烦了，我们封装一个函数来做这件事情：

1
2
3
4
5
6
7
8
9


(defun curry-curl-option-setter (function-name option-keyword)
  (setf (symbol-function function-name)
        (let ((orig-fun (symbol-function function-name)))
          (lambda (easy-handle value)
            (funcall orig-fun easy-handle option-keyword value)))))

(curry-curl-option-setter 'set-curl-option-url :url)
(curry-curl-option-setter 'set-curl-option-noprogress :noprogress)
(curry-curl-option-setter 'set-curl-option-nosignal :nosignal)

这边由于我们只定义:url、:noprogress、:nosignal三个选项的setter函数，故这里只能curry化它们的函数，针对:errorbuffer选项，我们目前只通过 define-curl-options 定义了它的枚举常量，还没有定义对应的setter函数。于是我们会想到，干嘛不 define-curl-options 定义枚举类型的时候，一块把所有枚举常量对应的setter函数一起定义，并一起curry化了，直接一步到位不是挺好的，代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52


(defun curry-curl-option-setter (function-name option-keyword)
  (setf (symbol-function function-name)
        (let ((c-function (symbol-function function-name)))
          (lambda (easy-handle new-value)
            (funcall c-function easy-handle option-keyword
                     new-value)))))

(defmacro define-curl-option-setter (name option-type
                                     option-value foreign-type)
  `(progn
     (defcfun ("curl_easy_setopt" ,name) curl-code
       (easy-handle easy-handle)
       (option ,option-type)
       (new-value ,foreign-type))
     (curry-curl-option-setter ',name ',option-value)))

(defmacro define-curl-options (type-name type-offsets &rest enum-args)
  "类似CFFI:DEFCENUM，不同于它的是，每个ENUM-ARGS的形式如下：

  (NAME TYPE NUMBER)

这里NAME是要定义的选项对应的Lisp枚举类型，为关键字，如:noprogress，
TYPE代表该选项的值对应的类型；如：long、objectpoint等，
NUMER是枚举类型对应的枚举数值，如：43，

TYPE-OFFSETS是一个plist，该plist的key为选项值的类型，value为该类型对应
的偏移。

除此之外，为每个选项定义对应的setter函数，名为：set-`类型名称'-`选项名称'。"
  (flet ((enumerated-value (type offset)
           (+ (getf type-offsets type) offset))
         (map-enum-args (procedure)
           (mapcar (lambda (arg) (apply procedure arg)) enum-args))
         (make-setter-name (option-name)
           (intern (concatenate
                    'string (symbol-name 'set-) (symbol-name type-name)
                    "-" (symbol-name option-name)))))
    `(progn
       (defcenum ,type-name
         ,@(map-enum-args
            (lambda (name type number)
              (list name (enumerated-value type number)))))
       ,@(map-enum-args
          (lambda (name type number)
            (declare (ignore number))
            `(define-curl-option-setter ,(make-setter-name name)
               ,type-name ,name ,(ecase type
                                   (long :long)
                                   (objectpoint :pointer)
                                   (functionpoint :pointer)
                                   (off-t :long)))))
       ',type-name)))

现在重新eval下面的 define-curl-options 以补上没定义的setter函数：

1
2
3
4
5
6


(define-curl-options curl-option
    (long 0 objectpoint 10000 functionpoint 20000 off-t 30000)
  (:noprogress long 43)
  (:nosignal long 99)
  (:url objectpoint 2)
  (:errorbuffer objectpoint 10))

展开上面的宏调用，可以帮助理解发生了什么，如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14


(PROGN
 (DEFCENUM CURL-OPTION
   (:NOPROGRESS 43)
   (:NOSIGNAL 99)
   (:ERRORBUFFER 10010)
   (:URL 10002))
 (DEFINE-CURL-OPTION-SETTER SET-CURL-OPTION-NOPROGRESS CURL-OPTION :NOPROGRESS
                            :LONG)
 (DEFINE-CURL-OPTION-SETTER SET-CURL-OPTION-NOSIGNAL CURL-OPTION :NOSIGNAL
                            :LONG)
 (DEFINE-CURL-OPTION-SETTER SET-CURL-OPTION-URL CURL-OPTION :URL :POINTER)
 (DEFINE-CURL-OPTION-SETTER SET-CURL-OPTION-ERRORBUFFER CURL-OPTION
                            :ERRORBUFFER :POINTER)
 'CURL-OPTION)

到此，选项设置函数封装完了，之后如果要添加新的选项，直接在 define-curl-options 调用的地方加就行了，还得记得如果添加了新的类型偏移，需要在 define-curl-options 代码里面的ecase加上对应的类型转换（忘了也不要怕，因为ecase在没有匹配的情况下是会报错的）。

内存管理

考虑下 set-curl-option-url 的使用，我们可能会想这么用：

1

(set-curl-option-url *easy-handle* "http://www.baidu.com")

但是这样是不行的，因为我们前面声明了第二个参数的类型是 :pointer ，所以要使用，我们得先把Lisp的字符串转换成C语言的字符串（实际上就是指针），然后才能传递，转换用 with-foreign-string ，代码如下：

1
2


(with-foreign-string (url "http://www.baidu.com")
  (set-curl-option-url *easy-handle* url))

或者等价的，我们可以直接把url的类型从 :pointer 改成 :string ，那么 (set-curl-option-url "http://www.baidu.com") 会生成和上面等价的代码。

这样在调用上是不会出错了，但是有一个问题， with-foreign-string 创建出来的C语言字符串的生命周期仅限于 with-foreign-string 的body内，一旦 body运行结束，该C语言字符串也会被销毁，而libcurl一是不会自己拷贝传入的字符串，二是它在之后还会继续使用传入的字符串，如果我们销毁了字符串，而它去使用该块被销毁的内存，会产生未定义行为：比如读到垃圾字符、读到不可读内存直接崩溃，等等。

既然生命周期是个问题，我们可以采取多种解决办法：

直接在body内把要做的操作直接全部做完，这样body结束后就不用字符串了。
直接不用 with-foreign-string 啊，直接自己分配内存存放转换的字符串，不要销毁就好。

第一种方法的示例代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10


(let (easy-handle)
  (unwind-protect
       (with-foreign-string (url "http://www.baidu.com")
         (setf easy-handle (curl-easy-init))
         (set-curl-option-url easy-handle url)
         ;; 在这里做下载等需要做的操作。
         ;; ...
         )
    (when easy-handle
      (curl-easy-cleanup easy-handle))))

这样的问题在于，我们所有代码都会挤在一起，代码会很乱，当然，你可以创建一些函数来降低一下代码的复杂度，但是这些函数还是得固定在body内调用，如果不小心在非body内调用，会出错，也就是它们对上下文有依赖。除了代码乱的问题，还有句柄被反复创建销毁，初始化代码反复运行的性能问题，总之，这不是一个好的解决办法。

再看第二种方法，这里分配内存在存放转换字符串的函数是： foreign-string-alloc ，代码如下：

1
2


(let ((c-string (foreign-string-alloc "http://www.baidu.com")))
  (set-curl-option-url *easy-handle* c-string))

这个方法解决了生命周期的问题，c-string会一直存在，所以不用担心引用到已销毁的内存，但是出现另外一个问题，什么时候去销毁该字符串呢？不然就内存泄漏了啊。有多种策略可以解决这个问题，比如最简单的就是，用哈希表把分配的C语言字符串和使用该字符串的句柄（该字符串的拥有者）绑定，然后在后面销毁句柄的时候，一次性释放掉，代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22


(defvar *easy-handle-cstrings* (make-hash-table)
  "用于存放句柄所拥有的C语言字符串的哈希表，
键是句柄，对应的值是该句柄所拥有的C语言字符串所组成的列表。")

(defun make-easy-handle ()
  "创建一个easy-handle，该easy-handle具有附着/拥有C语言字符串的能力。
如何附着字符串到easy-handle，见 `add-curl-handle-cstring' 。
注：请使用该函数来创建easy-handle，不要用 `curl-easy-init' 直接创建easy-handle。"
  (let ((easy-handle (curl-easy-init)))
    (setf (gethash easy-handle *easy-handle-cstrings*) '())
    easy-handle))

(defun add-curl-handle-cstring (handle cstring)
  "添加C语言字符串CSTRING到HANLDE，返回CSTRING。
注：添加完后，HANDLE会拥有CSTRING的所有权，请不要再次把该CSTRING添加到其他句柄中去。"
  (car (push cstring (gethash handle *easy-handle-cstrings*))))

(defun free-easy-handle (handle)
  "释放句柄并销毁该句柄拥有的C语言字符串"
  (curl-easy-cleanup handle)
  (mapc #'foreign-string-free (gethash handle *easy-handle-cstrings*))
  (remhash handle *easy-handle-cstrings*))

采用这种方法，之后我们对句柄的创建和释放不能再用 curl-easy-init 和 curl-easy-cleanup 了，得转而使用 make-easy-handle 和 free-easy-handle 。除此之外，我们在 set-curl-option-url 等需要C语言字符持久存在的情况下，都得调用 add-curl-handle-cstring 来确保字符串得到释放。

现在，我们先重定义下 *easy-handle* ，使用新的构造函数来创建句柄：

1
2


(setf *easy-handle* (make-easy-handle))
(set-curl-option-nosignal *easy-handle* 1)

接着，修改代码，使得在 set-curl-option-url 被调用时，会调用 add-curl-handle-cstring 来添加C语言字符串，需要修改 curry-curl-option-setter ，代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10


(defun curry-curl-option-setter (function-name option-keyword)
  (setf (symbol-function function-name)
        (let ((c-function (symbol-function function-name)))
          (lambda (easy-handle new-value)
            (funcall c-function easy-handle option-keyword
                     (if (stringp new-value)
                         (add-curl-handle-cstring
                          easy-handle
                          (foreign-string-alloc new-value))
                         new-value))))))

这里我们更进了一步，只要设置的选项值的类型是字符串，我们就把它转换成C 语言字符串并添加到句柄中去。

修改完 curry-curl-option-setter ，我们需要重新执行 define-curl-options 以重定义选项设置函数。

好了，现在 set-curl-option-url 可以正常使用了，如下：

1

(set-curl-option-url *easy-handle* "http://www.baidu.com")

为了确认C语言字符串是否添加到哈希表中了，我们可以执行如下代码去确认：

1
2
3
4
5


LEARN-CFFI> (foreign-string-to-lisp
             (car (gethash *easy-handle* *easy-handle-cstrings*)))
"http://www.baidu.com"
21
LEARN-CFFI>

这里关键是调用了 foreign-string-to-lisp 把C语言字符串转换成Lisp字符串，从而REPL可以正常打印。

处理:errorbuffer选项

:errorbuffer选项的值是一个存储C语言字符串的缓冲区，当libcurl发生错误时，错误的描述字符串会存在该缓冲区中，我们需要为该选项分配对应的缓冲区，模仿对:url选项的处理，我们也可以在 make-easy-handle 中为该缓冲区创建内存，在 free-easy-handle 中释放内存，代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32


(defvar *easy-handle-errorbuffers* (make-hash-table)
  "用于存放句柄所拥有的错误缓冲区的哈希表，
键是句柄，对应的值是错误缓冲区。")

(defvar *curl-error-size* 257
  "错误缓冲区的大小。")

(defun make-easy-handle ()
  "创建一个easy-handle，该easy-handle具有附着/拥有C语言字符串的能力以及错误缓冲区。
如何附着字符串到easy-handle，见 `add-curl-handle-cstring' 。
注：请使用该函数来创建easy-handle，不要用 `curl-easy-init' 直接创建easy-handle。"
  (let ((easy-handle (curl-easy-init)))
    (setf (gethash easy-handle *easy-handle-cstrings*) '())
    (let ((errorbuffer (foreign-alloc :char :count *curl-error-size*
                                            :initial-element 0)))
      (setf (gethash easy-handle *easy-handle-errorbuffers*)
            errorbuffer)
      (set-curl-option-errorbuffer easy-handle errorbuffer))
    easy-handle))

(defun free-easy-handle (handle)
  "释放句柄并销毁该句柄拥有的资源"
  (curl-easy-cleanup handle)
  (foreign-free (gethash handle *easy-handle-errorbuffers*))
  (remhash handle *easy-handle-errorbuffers*)
  (mapc #'foreign-string-free (gethash handle *easy-handle-cstrings*))
  (remhash handle *easy-handle-cstrings*))

(defun get-easy-handle-error (handle)
  "获取HANLDE当前的错误描述。"
  (foreign-string-to-lisp
   (gethash handle *easy-handle-errorbuffers*)))

注意两点，一是我们在 make-easy-handle 中调用 set-curl-option-errorbuffer 设置了错误缓冲区，二是我们添加了 get-easy-handle-error 方便我们获取句柄当前的错误描述。

接着，我们再次重新定义下 *easy-handle* ，如下：

1
2


(setf *easy-handle* (make-easy-handle))
(set-curl-option-nosignal *easy-handle* 1)

该内存管理策略的优缺点

我们采用内存/资源管理策略是：把资源关联到句柄上，最终在句柄释放的时候统一释放。优点是简单、易于实现和维护，缺点也比较明显，资源会在该句柄存在期间一直被占用，即使有些资源你不用了，如果分配量比较少还好，分配量比较大，这种简单的策略就行不通了，需要进一步改善。

C调用Lisp（回调函数）

到目前为止，我们都是Lisp调用C，还没有遇到反过来的情况，但是现在我们就得处理这种情况了：libcurl下载过程中接收到的数据都是通过回调传递给用户的，这个回调是通过 :writefunction 选项设置的。

针对这种情况，很多语言的FFI会要求你用C语言代码写回调，在回调中接收数据，然后自己再把该数据转换成本语言的对象，然后再传递给本语言的代码。不同于这些语言，Common Lisp众多实现比较强力的一点是：我们可以直接在Lisp中定义回调函数，我们主要特别注意，这不是一个简单的东西，这意味着我们用的 Lisp实现根据我们的Lisp代码，动态生成编译后的C语言代码，生成的代码得在 ABI级别兼容，所以并不是所有Lisp实现支持定义回调（但是大部分知名的都支持）。

定义回调使用 defcallback ，代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14


(defctype size :unsigned-int)

(defvar *easy-write-procedure* (lambda (string)
                                 (declare (ignore string))))

(defcallback easy-write size ((ptr :pointer) (size size)
                              (nmemb size) (stream :pointer))
  (declare (ignore stream))
  (let ((data-size (* size nmemb)))
    (handler-case
        (progn (funcall *easy-write-procedure*
                        (foreign-string-to-lisp ptr :count data-size))
               data-size)
      (error () (if (zerop data-size) 1 0)))))

defcallback 第一个参数是回调的名字，第二个参数是返回值类型，然后是参数列表，每个参数都是名字+类型的形式，最后是回调函数体了。

注意到：我们把数据转化成Lisp字符串，调用动态绑定的 *easy-write-procedure* 变量里面存储的函数，把字符串传递给它，这样，各个 easy-write 的用户可以自己定义数据处理函数，且由于 *easy-write-procedure* 里面存储的函数是普通Lisp函数，所以基本上可以随意使用Common Lisp的特性，比如闭包等。

需要注意到的第二点是：我们对错误的处理很粗糙，所有错误都返回1或者0，没有好好利用condition/restart系统，这是由于该回调会编译成C语言函数（当然，是二进制形式，而不是源码形式），且该回调是被libcurl调用的，所以可能出现各种奇怪的错误，这属于一种折中的方案。

现在，我们可以补上 :writefunction 选项的定义了：

1
2
3
4
5
6
7


(define-curl-options curl-option
    (long 0 objectpoint 10000 functionpoint 20000 off-t 30000)
  (:noprogress long 43)
  (:nosignal long 99)
  (:errorbuffer objectpoint 10)
  (:url objectpoint 2)
  (:writefunction functionpoint 11))

我们还可以选择在 make-easy-handle 构造函数中，设置 :writefunction 选项为 easy-write ，但是目前 easy-write 把数据都转换成Lisp字符串了，这不适合于所有情况，所以还是让用户手动设置好了，如下：

1

(set-curl-option-writefunction *easy-handle* (callback easy-write))

这里 callback 类似于 function （即 #' ），用于把回调函数转换成指针。

下载测试

现在，我们就差一个函数就能测试下载了，那就是 curl_easy_perform ：

1
2


(defcfun "curl_easy_perform" curl-code
  (handle easy-handle))

现在，可以测试下载了：

1
2
3
4
5
6
7
8


LEARN-CFFI> (with-output-to-string (contents)
              (let ((*easy-write-procedure*
                      (lambda (string)
                        (write-string string contents))))
                (curl-easy-perform *easy-handle*)))
"<!DOCTYPE html><!--STATUS OK-->
太长了，内容省略。。。
"

我们还可以测试是否能拿到错误描述，这里把url设置成一个不存在的域名，测试结果如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12


LEARN-CFFI> (set-curl-option-url *easy-handle* "http://www.invalidhostnameabc.com")
0
LEARN-CFFI> (with-output-to-string (contents)
              (let ((*easy-write-procedure*
                      (lambda (string)
                        (write-string string contents))))
                (curl-easy-perform *easy-handle*)))
""
LEARN-CFFI> (get-easy-handle-error *easy-handle*)
"Empty reply from server"
23
LEARN-CFFI>

可以看到可以拿到错误描述。

定义新的类型

我们前面用到了 defctype 以及 defcenum ，还有包括未涉及的 defcstruct ，它们实际上底层都是用类型转换器（type translators）来实现的，仅仅是语法糖而已。

举个例子， (defctype curl-code :int) 相当于如下代码：

1
2
3
4


(define-foreign-type curl-code-type ()
  ()
  (:actual-type :int)
  (:simple-parser curl-code))

这里用到了 define-foreign-type 来定义新的类型，类型转换器只作用于 define-foreign-type 定义的类型。

注：下面这段不是重点，看不懂的部分可以略过

define-foreign-type 只是对 defclass 的一个简单的包装，上面的代码最终会定义一个类 curl-code-type 。上面代码的意思：定义一个叫 curl-code-type 的类型，该类型的实际类型是 :int 类型，后面的 (:simple-parser curl-code) 需要解释下：CFFI在遇到一个类型的时候，比如abc，它会通过 (find-type-parser abc) 去找该类型的类型解析器，类型解析器的任务就是返回一个由 define-foreign-type 定义的类的实例，类型解析器可以在这时候做各种复杂的动作，只要最终返回一个由 define-foreign-type 定义的类的实例即可，而 (:simple-parser curl-code) 的作用就是定义一个最简单的类型解析器，并把该类型解析器的名字设置为 curl-code ，从而确保 (find-type-parser curl-code) 可以拿到该类型解析器，这个类型解析器的动作也十分简单，直接 (make-instance 'curl-code-type ...) 而已。

下面看一段代码，看完再解释作用：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14


(define-condition curl-code-error (error)
  (($code :initarg :curl-code :reader curl-error-code))
  (:report (lambda (c stream)
             (format stream "libcurl function returned error ~A"
                     (curl-error-code c))))
  (:documentation "当libcurl的返回值类型是curl-code时且返回值非CURLE_OK的时候，
signal本condition。"))

(defmethod translate-from-foreign (value (type curl-code-type))
  "如果VALUE（一个curl-code）非0（CURLE_OK），singal类型为curl-code-error的condition，
如果VALUE是0，返回:curle-ok。"
  (if (zerop value)
      :curle-ok
      (error 'curl-code-error :curl-code value)))

读完上面代码的文档，读者基本上就知道其作用了：我们特化了 translate-from-foreign 通用函数，该函数用于把外部类型（C语言类型）的值转换成Lisp类型的值（注意，是“的值”），我们这里做的就是当外部类型是 curl-code-type 的时候，判断是否值非0，signal condition，如果是0，返回关键字 :curle-ok 。

测试效果之前，记得执行上面的代码，包括 (define-foreign-type curl-code-type ...) ，还得重新执行下： (define-curl-options curl-option ...) ，不然我们定义的类型转换不会被用上（原因是类型转换代码是在定义时的宏展开期间生成并嵌入的，具体可以参考：Common Lisp CFFI 详解）。

测试下效果：

1
2


LEARN-CFFI> (set-curl-option-nosignal *easy-handle* 1)
:CURLE-OK

为了测试signal condition的情况，我们设置一个不存在的域名，然后开始下载，不过在下载前，我们还得重新定义下 curl-easy-perform ，否则类型转换不会生效：

1
2
3
4


LEARN-CFFI> (set-curl-option-url *easy-handle* "http://www.invalidhostnameabc.com")
:CURLE-OK
LEARN-CFFI> (curl-easy-perform *easy-handle*)
; Evaluation aborted on #<LEARN-CFFI::CURL-CODE-ERROR {100596C013}>.

避免使用哈希表

我们前面用哈希表来记录一个句柄所拥有的资源，但实际上不一定要用哈希表，只要是能记录的都行，下面我们利用类型转换器的特性，用CLOS类来表示句柄，并用该类的slot（准确来说，应该是该类的实例的slot）来记录该句柄所拥有的资源，代码如下：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43


(defclass easy-handle ()
  ((pointer :initform (curl-easy-init)
            :documentation "curl_easy_init创建的外部/C语言指针")
   (error-buffer
    :initform (foreign-alloc :char :count *curl-error-size*
                                   :initial-element 0)
    :documentation "当前的错误描述")
   (c-strings :initform '()
              :documentation "该句柄所拥有的C语言字符串")))

(defmethod initialize-instance :after ((self easy-handle) &key)
  (set-curl-option-errorbuffer self (slot-value self 'error-buffer)))

(define-foreign-type easy-handle-type ()
  ()
  (:actual-type :pointer)
  (:simple-parser easy-handle))

(defmethod translate-to-foreign (handle (type easy-handle-type))
  "把easy-handle类的实例转化成真正的句柄，即提取它的pointer slot。"
  (slot-value handle 'pointer))

(defun make-easy-handle ()
  "创建一个easy-handle。
注：请使用该函数来创建easy-handle，不要用 `curl-easy-init' 直接创建easy-handle。"
  (make-instance 'easy-handle))

(defun free-easy-handle (handle)
  "释放句柄并销毁该句柄拥有的资源"
  (with-slots (pointer error-buffer c-strings) handle
    (curl-easy-cleanup pointer)
    (foreign-free error-buffer)
    (mapc #'foreign-string-free c-strings)))

(defun add-curl-handle-cstring (handle cstring)
  "添加C语言字符串CSTRING到HANLDE，返回CSTRING。
注：添加完后，HANDLE会拥有CSTRING的所有权，请不要再次把该CSTRING添加到其他句柄中去。"
  (car (push cstring (slot-value handle 'c-strings))))

(defun get-easy-handle-error (handle)
  "获取HANLDE当前的错误描述。"
  (foreign-string-to-lisp
   (slot-value handle 'error-buffer)))

上面easy-handle替换成一个CLOS实例，在slot中记录对应的资源， make-easy-handle 改成直接创建该类的实例。但是 defcun 定义的函数肯定是不认识CLOS实例的，故上面代码自定义了一个外部类型 easy-handle-type ，类型解析器名字和CLOS类同名（注意，这是重点，如果不同名，我们就得改前面 defcfun 的代码了），特化了 translate-to-foreign 通用函数，特化在类型 easy-handle-type 上，使得在 easy-handle CLOS实例传递给C语言函数前，把它转化成真正句柄。

注意：单看上面的描述有些读者可能还是不明白是怎么奏效的，建议自己脑中自己跟一跟整个流程，哪里easy-handle是CLOS实例，哪里又进行了转换，是怎么进行转换的，哪里内部用了 (find-type-parser easy-handle) 。

本文没涉及的东西

本文没涉及的东西还挺多的，比如 defcstruct ，还有指定调用约定，默认是 cdecl，你可以指定为stdcall，等等，读者可以接着阅读我的另一篇关于CFFI的文章，该文章更系统地讲解了CFFI，覆盖面也更广：Common Lisp CFFI 详解。

建议

CFFI很强大，创建绑定的过程中大部分事情都可以直接在Lisp中做，而不用写C 语言代码（对比下，有些语言的FFI不能在本语言写回调函数），但是我们还是可能遇到有些绑定用Lisp很难写，或者根本写不了的情况，我的建议是，这时候，可以考虑下写些C语言接口去封装那些不好创建绑定的部分，然后转而创建我们封装的C语言接口的绑定，而不是纯Lisp代码去创建绑定。

完整代码

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190


(in-package :cl-user)

(defpackage :learn-cffi
  (:use :cl :cffi))

(in-package :learn-cffi)

(define-foreign-library libcurl
  (:darwin (:or "libcurl.3.dylib" "libcurl.dylib"))
  (:unix (:or "libcurl.so.3" "libcurl.so"))
  (t (:default "libcurl")))

(use-foreign-library libcurl)

(define-foreign-type curl-code-type ()
  ()
  (:actual-type :int)
  (:simple-parser curl-code))

(define-condition curl-code-error (error)
  (($code :initarg :curl-code :reader curl-error-code))
  (:report (lambda (c stream)
             (format stream "libcurl function returned error ~A"
                     (curl-error-code c))))
  (:documentation "当libcurl的返回值类型是curl-code时且返回值非CURLE_OK的时候，
signal本condition。"))

(defmethod translate-from-foreign (value (type curl-code-type))
  "如果VALUE（一个curl-code）非0（CURLE_OK），singal类型为curl-code-error的condition，
如果VALUE是0，返回:curle-ok。"
  (if (zerop value)
      :curle-ok
      (error 'curl-code-error :curl-code value)))

(defvar *curl-error-size* 257
  "错误缓冲区的大小。")

(defclass easy-handle ()
  ((pointer :initform (curl-easy-init)
            :documentation "curl_easy_init创建的外部/C语言指针")
   (error-buffer
    :initform (foreign-alloc :char :count *curl-error-size*
                                   :initial-element 0)
    :documentation "当前的错误描述")
   (c-strings :initform '()
              :documentation "该句柄所拥有的C语言字符串")))

(defmethod initialize-instance :after ((self easy-handle) &key)
  (set-curl-option-errorbuffer self (slot-value self 'error-buffer)))

(define-foreign-type easy-handle-type ()
  ()
  (:actual-type :pointer)
  (:simple-parser easy-handle))

(defmethod translate-to-foreign (handle (type easy-handle-type))
  "把easy-handle类的实例转化成真正的句柄，即提取它的pointer slot。"
  (slot-value handle 'pointer))

(defctype size :unsigned-int)

(defcfun "curl_global_init" curl-code
  (flags :long))

(defcfun "curl_easy_init" easy-handle)

(defcfun "curl_easy_cleanup" :void
  (easy-handle easy-handle))

(defcfun "curl_easy_perform" curl-code
  (handle easy-handle))

(defun curry-curl-option-setter (function-name option-keyword)
  (setf (symbol-function function-name)
        (let ((c-function (symbol-function function-name)))
          (lambda (easy-handle new-value)
            (funcall c-function easy-handle option-keyword
                     (if (stringp new-value)
                         (add-curl-handle-cstring
                          easy-handle
                          (foreign-string-alloc new-value))
                         new-value))))))

(defmacro define-curl-option-setter (name option-type
                                     option-value foreign-type)
  `(progn
     (defcfun ("curl_easy_setopt" ,name) curl-code
       (easy-handle easy-handle)
       (option ,option-type)
       (new-value ,foreign-type))
     (curry-curl-option-setter ',name ',option-value)))

(defmacro define-curl-options (type-name type-offsets &rest enum-args)
  "类似CFFI:DEFCENUM，不同于它的是，每个ENUM-ARGS的形式如下：

  (NAME TYPE NUMBER)

这里NAME是要定义的选项对应的Lisp枚举类型，为关键字，如:noprogress，
TYPE代表该选项的值对应的类型；如：long、objectpoint等，
NUMER是枚举类型对应的枚举数值，如：43，

TYPE-OFFSETS是一个plist，该plist的key为选项值的类型，value为该类型对应
的偏移。

除此之外，为每个选项定义对应的setter函数，名为：set-`类型名称'-`选项名称'。"
  (flet ((enumerated-value (type offset)
           (+ (getf type-offsets type) offset))
         (map-enum-args (procedure)
           (mapcar (lambda (arg) (apply procedure arg)) enum-args))
         (make-setter-name (option-name)
           (intern (concatenate
                    'string (symbol-name 'set-) (symbol-name type-name)
                    "-" (symbol-name option-name)))))
    `(progn
       (defcenum ,type-name
         ,@(map-enum-args
            (lambda (name type number)
              (list name (enumerated-value type number)))))
       ,@(map-enum-args
          (lambda (name type number)
            (declare (ignore number))
            `(define-curl-option-setter ,(make-setter-name name)
               ,type-name ,name ,(ecase type
                                   (long :long)
                                   (objectpoint :pointer)
                                   (functionpoint :pointer)
                                   (off-t :long)))))
       ',type-name)))

(define-curl-options curl-option
    (long 0 objectpoint 10000 functionpoint 20000 off-t 30000)
  (:noprogress long 43)
  (:nosignal long 99)
  (:errorbuffer objectpoint 10)
  (:url objectpoint 2)
  (:writefunction functionpoint 11))

(defun make-easy-handle ()
  "创建一个easy-handle。
注：请使用该函数来创建easy-handle，不要用 `curl-easy-init' 直接创建easy-handle。"
  (make-instance 'easy-handle))

(defun free-easy-handle (handle)
  "释放句柄并销毁该句柄拥有的资源"
  (with-slots (pointer error-buffer c-strings) handle
    (curl-easy-cleanup pointer)
    (foreign-free error-buffer)
    (mapc #'foreign-string-free c-strings)))

(defun add-curl-handle-cstring (handle cstring)
  "添加C语言字符串CSTRING到HANLDE，返回CSTRING。
注：添加完后，HANDLE会拥有CSTRING的所有权，请不要再次把该CSTRING添加到其他句柄中去。"
  (car (push cstring (slot-value handle 'c-strings))))

(defun get-easy-handle-error (handle)
  "获取HANLDE当前的错误描述。"
  (foreign-string-to-lisp
   (slot-value handle 'error-buffer)))

(defvar *easy-write-procedure* (lambda (string)
                                 (declare (ignore string))))

(defcallback easy-write size ((ptr :pointer) (size size)
                              (nmemb size) (stream :pointer))
  (declare (ignore stream))
  (let ((data-size (* size nmemb)))
    (handler-case
        (progn (funcall *easy-write-procedure*
                        (foreign-string-to-lisp ptr :count data-size))
               data-size)
      (error () (if (zerop data-size) 1 0)))))

(curl-global-init 3)

(defvar *easy-handle* (make-easy-handle))

(set-curl-option-nosignal *easy-handle* 1)

(set-curl-option-url *easy-handle* "http://www.baidu.com")

(set-curl-option-writefunction *easy-handle* (callback easy-write))

;; 测试代码：
#|
(with-output-to-string (contents)
  (let ((*easy-write-procedure*
          (lambda (string)
            (write-string string contents))))
    (curl-easy-perform *easy-handle*)))
|#