curl-helper.c

   1 /***
   2  ***  curl-helper.c
   3  ***
   4  ***  Copyright (c) 2003-2008, Lars Nilsson, <lars@quantumchamaeleon.com>
   5  ***  Copyright (c) 2009, ygrek, <ygrek@autistici.org>
   6  ***/
   7
   8 #include <stdio.h>
   9 #include <string.h>
  10 #include <stdlib.h>
  11 #include <stdarg.h>
  12 #include <caml/config.h>
  13 #ifdef HAS_UNISTD
  14 #include <unistd.h>
  15 #endif
  16 /* suppress false gcc warning on seekFunction */
  17 #define CURL_DISABLE_TYPECHECK
  18 #include <curl/curl.h>
  19
  20 #ifndef CAML_NAME_SPACE
  21 #define CAML_NAME_SPACE
  22 #endif
  23 #include <caml/alloc.h>
  24 #include <caml/memory.h>
  25 #include <caml/mlvalues.h>
  26 #include <caml/callback.h>
  27 #include <caml/fail.h>
  28 #include <caml/unixsupport.h>
  29 #include <caml/custom.h>
  30 #include <caml/threads.h>
  31
  32 #ifndef CAMLdrop
  33 #define CAMLdrop caml_local_roots = caml__frame
  34 #endif
  35
  36 #ifdef HAVE_CONFIG_H
  37 #include "config.h"
  38 #else
  39 #pragma message("No config file given.")
  40 #endif
  41
  42 #ifdef __cplusplus
  43 extern "C" {
  44 #endif
  45
  46 #define Val_none Val_int(0)
  47
  48 static __inline value
  49 Val_some( value v )
  50 {
  51     CAMLparam1( v );
  52     CAMLlocal1( some );
  53     some = caml_alloc(1, 0);
  54     Store_field( some, 0, v );
  55     CAMLreturn( some );
  56 }
  57
  58 static value Val_pair(value v1, value v2)
  59 {
  60   CAMLparam2(v1,v2);
  61   CAMLlocal1(pair);
  62   pair = caml_alloc_small(2,0);
  63   Field(pair,0) = v1;
  64   Field(pair,1) = v2;
  65   CAMLreturn(pair);
  66 }
  67
  68 static value Val_cons(value list, value v) { return Val_pair(v,list); }
  69
  70 typedef struct Connection Connection;
  71 typedef struct ConnectionList ConnectionList;
  72
  73 #define Connection_val(v) (*(Connection**)Data_custom_val(v))
  74
  75 typedef enum OcamlValues
  76 {
  77     Ocaml_WRITEFUNCTION,
  78     Ocaml_READFUNCTION,
  79     Ocaml_ERRORBUFFER,
  80     Ocaml_POSTFIELDS,
  81     Ocaml_HTTPHEADER,
  82     Ocaml_HTTPPOST,
  83     Ocaml_QUOTE,
  84     Ocaml_POSTQUOTE,
  85     Ocaml_HEADERFUNCTION,
  86     Ocaml_PROGRESSFUNCTION,
  87     Ocaml_DEBUGFUNCTION,
  88     Ocaml_HTTP200ALIASES,
  89     Ocaml_IOCTLFUNCTION,
  90     Ocaml_SEEKFUNCTION,
  91     Ocaml_OPENSOCKETFUNCTION,
  92
  93     Ocaml_URL,
  94     Ocaml_PROXY,
  95     Ocaml_USERPWD,
  96     Ocaml_PROXYUSERPWD,
  97     Ocaml_RANGE,
  98     Ocaml_REFERER,
  99     Ocaml_USERAGENT,
 100     Ocaml_FTPPORT,
 101     Ocaml_COOKIE,
 102     Ocaml_HTTPPOSTSTRINGS,
 103     Ocaml_SSLCERT,
 104     Ocaml_SSLCERTTYPE,
 105     Ocaml_SSLCERTPASSWD,
 106     Ocaml_SSLKEY,
 107     Ocaml_SSLKEYTYPE,
 108     Ocaml_SSLKEYPASSWD,
 109     Ocaml_SSLENGINE,
 110     Ocaml_COOKIEFILE,
 111     Ocaml_CUSTOMREQUEST,
 112     Ocaml_INTERFACE,
 113     Ocaml_CAINFO,
 114     Ocaml_CAPATH,
 115     Ocaml_RANDOM_FILE,
 116     Ocaml_EGDSOCKET,
 117     Ocaml_COOKIEJAR,
 118     Ocaml_SSL_CIPHER_LIST,
 119     Ocaml_PRIVATE,
 120     Ocaml_NETRC_FILE,
 121     Ocaml_FTP_ACCOUNT,
 122     Ocaml_COOKIELIST,
 123     Ocaml_FTP_ALTERNATIVE_TO_USER,
 124     Ocaml_SSH_PUBLIC_KEYFILE,
 125     Ocaml_SSH_PRIVATE_KEYFILE,
 126     Ocaml_SSH_HOST_PUBLIC_KEY_MD5,
 127     Ocaml_COPYPOSTFIELDS,
 128     Ocaml_DNS_SERVERS,
 129     Ocaml_MAIL_FROM,
 130     Ocaml_MAIL_RCPT,
 131     Ocaml_RESOLVE,
 132     Ocaml_USERNAME,
 133     Ocaml_PASSWORD,
 134
 135     /* Not used, last for size */
 136     OcamlValuesSize
 137 } OcamlValue;
 138
 139 struct Connection
 140 {
 141     CURL *handle;
 142
 143     value ocamlValues;
 144
 145     size_t refcount; /* number of references to this structure */
 146
 147     char *curl_ERRORBUFFER;
 148     char *curl_POSTFIELDS;
 149     struct curl_slist *curl_HTTPHEADER;
 150     struct curl_slist *httpPostBuffers;
 151     struct curl_httppost *httpPostFirst;
 152     struct curl_httppost *httpPostLast;
 153     struct curl_slist *curl_RESOLVE;
 154     struct curl_slist *curl_QUOTE;
 155     struct curl_slist *curl_POSTQUOTE;
 156     struct curl_slist *curl_HTTP200ALIASES;
 157     struct curl_slist *curl_MAIL_RCPT;
 158 };
 159
 160 typedef struct CURLErrorMapping CURLErrorMapping;
 161
 162 struct CURLErrorMapping
 163 {
 164     char *name;
 165     CURLcode error;
 166 };
 167
 168 CURLErrorMapping errorMap[] =
 169 {
 170     {"CURLE_OK", CURLE_OK},
 171 #if HAVE_DECL_CURLE_UNSUPPORTED_PROTOCOL
 172     {"CURLE_UNSUPPORTED_PROTOCOL", CURLE_UNSUPPORTED_PROTOCOL},
 173 #else
 174     {"CURLE_UNSUPPORTED_PROTOCOL", -1},
 175 #endif
 176 #if HAVE_DECL_CURLE_FAILED_INIT
 177     {"CURLE_FAILED_INIT", CURLE_FAILED_INIT},
 178 #else
 179     {"CURLE_FAILED_INIT", -1},
 180 #endif
 181 #if HAVE_DECL_CURLE_URL_MALFORMAT
 182     {"CURLE_URL_MALFORMAT", CURLE_URL_MALFORMAT},
 183 #else
 184     {"CURLE_URL_MALFORMAT", -1},
 185 #endif
 186 #if HAVE_DECL_CURLE_URL_MALFORMAT_USER
 187     {"CURLE_URL_MALFORMAT_USER", CURLE_URL_MALFORMAT_USER},
 188 #else
 189     {"CURLE_URL_MALFORMAT_USER", -1},
 190 #endif
 191 #if HAVE_DECL_CURLE_COULDNT_RESOLVE_PROXY
 192     {"CURLE_COULDNT_RESOLVE_PROXY", CURLE_COULDNT_RESOLVE_PROXY},
 193 #else
 194     {"CURLE_COULDNT_RESOLVE_PROXY", -1},
 195 #endif
 196 #if HAVE_DECL_CURLE_COULDNT_RESOLVE_HOST
 197     {"CURLE_COULDNT_RESOLVE_HOST", CURLE_COULDNT_RESOLVE_HOST},
 198 #else
 199     {"CURLE_COULDNT_RESOLVE_HOST", -1},
 200 #endif
 201 #if HAVE_DECL_CURLE_COULDNT_CONNECT
 202     {"CURLE_COULDNT_CONNECT", CURLE_COULDNT_CONNECT},
 203 #else
 204     {"CURLE_COULDNT_CONNECT", -1},
 205 #endif
 206 #if HAVE_DECL_CURLE_FTP_WEIRD_SERVER_REPLY
 207     {"CURLE_FTP_WEIRD_SERVER_REPLY", CURLE_FTP_WEIRD_SERVER_REPLY},
 208 #else
 209     {"CURLE_FTP_WEIRD_SERVER_REPLY", -1},
 210 #endif
 211 #if HAVE_DECL_CURLE_FTP_ACCESS_DENIED
 212     {"CURLE_FTP_ACCESS_DENIED", CURLE_FTP_ACCESS_DENIED},
 213 #else
 214     {"CURLE_FTP_ACCESS_DENIED", -1},
 215 #endif
 216 #if HAVE_DECL_CURLE_FTP_USER_PASSWORD_INCORRECT
 217     {"CURLE_FTP_USER_PASSWORD_INCORRECT", CURLE_FTP_USER_PASSWORD_INCORRECT},
 218 #else
 219     {"CURLE_FTP_USER_PASSWORD_INCORRECT", -1},
 220 #endif
 221 #if HAVE_DECL_CURLE_FTP_WEIRD_PASS_REPLY
 222     {"CURLE_FTP_WEIRD_PASS_REPLY", CURLE_FTP_WEIRD_PASS_REPLY},
 223 #else
 224     {"CURLE_FTP_WEIRD_PASS_REPLY", -1},
 225 #endif
 226 #if HAVE_DECL_CURLE_FTP_WEIRD_USER_REPLY
 227     {"CURLE_FTP_WEIRD_USER_REPLY", CURLE_FTP_WEIRD_USER_REPLY},
 228 #else
 229     {"CURLE_FTP_WEIRD_USER_REPLY", -1},
 230 #endif
 231 #if HAVE_DECL_CURLE_FTP_WEIRD_PASV_REPLY
 232     {"CURLE_FTP_WEIRD_PASV_REPLY", CURLE_FTP_WEIRD_PASV_REPLY},
 233 #else
 234     {"CURLE_FTP_WEIRD_PASV_REPLY", -1},
 235 #endif
 236 #if HAVE_DECL_CURLE_FTP_WEIRD_227_FORMAT
 237     {"CURLE_FTP_WEIRD_227_FORMAT", CURLE_FTP_WEIRD_227_FORMAT},
 238 #else
 239     {"CURLE_FTP_WEIRD_227_FORMAT", -1},
 240 #endif
 241 #if HAVE_DECL_CURLE_FTP_CANT_GET_HOST
 242     {"CURLE_FTP_CANT_GET_HOST", CURLE_FTP_CANT_GET_HOST},
 243 #else
 244     {"CURLE_FTP_CANT_GET_HOST", -1},
 245 #endif
 246 #if HAVE_DECL_CURLE_FTP_CANT_RECONNECT
 247     {"CURLE_FTP_CANT_RECONNECT", CURLE_FTP_CANT_RECONNECT},
 248 #else
 249     {"CURLE_FTP_CANT_RECONNECT", -1},
 250 #endif
 251 #if HAVE_DECL_CURLE_FTP_COULDNT_SET_BINARY
 252     {"CURLE_FTP_COULDNT_SET_BINARY", CURLE_FTP_COULDNT_SET_BINARY},
 253 #else
 254     {"CURLE_FTP_COULDNT_SET_BINARY", -1},
 255 #endif
 256 #if HAVE_DECL_CURLE_PARTIAL_FILE
 257     {"CURLE_PARTIAL_FILE", CURLE_PARTIAL_FILE},
 258 #else
 259     {"CURLE_PARTIAL_FILE", -1},
 260 #endif
 261 #if HAVE_DECL_CURLE_FTP_COULDNT_RETR_FILE
 262     {"CURLE_FTP_COULDNT_RETR_FILE", CURLE_FTP_COULDNT_RETR_FILE},
 263 #else
 264     {"CURLE_FTP_COULDNT_RETR_FILE", -1},
 265 #endif
 266 #if HAVE_DECL_CURLE_FTP_WRITE_ERROR
 267     {"CURLE_FTP_WRITE_ERROR", CURLE_FTP_WRITE_ERROR},
 268 #else
 269     {"CURLE_FTP_WRITE_ERROR", -1},
 270 #endif
 271 #if HAVE_DECL_CURLE_FTP_QUOTE_ERROR
 272     {"CURLE_FTP_QUOTE_ERROR", CURLE_FTP_QUOTE_ERROR},
 273 #else
 274     {"CURLE_FTP_QUOTE_ERROR", -1},
 275 #endif
 276 #if HAVE_DECL_CURLE_HTTP_RETURNED_ERROR
 277     {"CURLE_HTTP_RETURNED_ERROR", CURLE_HTTP_RETURNED_ERROR},
 278 #else
 279     {"CURLE_HTTP_RETURNED_ERROR", -1},
 280 #endif
 281 #if HAVE_DECL_CURLE_WRITE_ERROR
 282     {"CURLE_WRITE_ERROR", CURLE_WRITE_ERROR},
 283 #else
 284     {"CURLE_WRITE_ERROR", -1},
 285 #endif
 286 #if HAVE_DECL_CURLE_MALFORMAT_USER
 287     {"CURLE_MALFORMAT_USER", CURLE_MALFORMAT_USER},
 288 #else
 289     {"CURLE_MALFORMAT_USER", -1},
 290 #endif
 291 #if HAVE_DECL_CURLE_FTP_COULDNT_STOR_FILE
 292     {"CURLE_FTP_COULDNT_STOR_FILE", CURLE_FTP_COULDNT_STOR_FILE},
 293 #else
 294     {"CURLE_FTP_COULDNT_STOR_FILE", -1},
 295 #endif
 296 #if HAVE_DECL_CURLE_READ_ERROR
 297     {"CURLE_READ_ERROR", CURLE_READ_ERROR},
 298 #else
 299     {"CURLE_READ_ERROR", -1},
 300 #endif
 301 #if HAVE_DECL_CURLE_OUT_OF_MEMORY
 302     {"CURLE_OUT_OF_MEMORY", CURLE_OUT_OF_MEMORY},
 303 #else
 304     {"CURLE_OUT_OF_MEMORY", -1},
 305 #endif
 306 #if HAVE_DECL_CURLE_OPERATION_TIMEOUTED
 307     {"CURLE_OPERATION_TIMEOUTED", CURLE_OPERATION_TIMEOUTED},
 308 #else
 309     {"CURLE_OPERATION_TIMEOUTED", -1},
 310 #endif
 311 #if HAVE_DECL_CURLE_FTP_COULDNT_SET_ASCII
 312     {"CURLE_FTP_COULDNT_SET_ASCII", CURLE_FTP_COULDNT_SET_ASCII},
 313 #else
 314     {"CURLE_FTP_COULDNT_SET_ASCII", -1},
 315 #endif
 316 #if HAVE_DECL_CURLE_FTP_PORT_FAILED
 317     {"CURLE_FTP_PORT_FAILED", CURLE_FTP_PORT_FAILED},
 318 #else
 319     {"CURLE_FTP_PORT_FAILED", -1},
 320 #endif
 321 #if HAVE_DECL_CURLE_FTP_COULDNT_USE_REST
 322     {"CURLE_FTP_COULDNT_USE_REST", CURLE_FTP_COULDNT_USE_REST},
 323 #else
 324     {"CURLE_FTP_COULDNT_USE_REST", -1},
 325 #endif
 326 #if HAVE_DECL_CURLE_FTP_COULDNT_GET_SIZE
 327     {"CURLE_FTP_COULDNT_GET_SIZE", CURLE_FTP_COULDNT_GET_SIZE},
 328 #else
 329     {"CURLE_FTP_COULDNT_GET_SIZE", -1},
 330 #endif
 331 #if HAVE_DECL_CURLE_HTTP_RANGE_ERROR
 332     {"CURLE_HTTP_RANGE_ERROR", CURLE_HTTP_RANGE_ERROR},
 333 #else
 334     {"CURLE_HTTP_RANGE_ERROR", -1},
 335 #endif
 336 #if HAVE_DECL_CURLE_HTTP_POST_ERROR
 337     {"CURLE_HTTP_POST_ERROR", CURLE_HTTP_POST_ERROR},
 338 #else
 339     {"CURLE_HTTP_POST_ERROR", -1},
 340 #endif
 341 #if HAVE_DECL_CURLE_SSL_CONNECT_ERROR
 342     {"CURLE_SSL_CONNECT_ERROR", CURLE_SSL_CONNECT_ERROR},
 343 #else
 344     {"CURLE_SSL_CONNECT_ERROR", -1},
 345 #endif
 346 #if HAVE_DECL_CURLE_BAD_DOWNLOAD_RESUME
 347     {"CURLE_BAD_DOWNLOAD_RESUME", CURLE_BAD_DOWNLOAD_RESUME},
 348 #else
 349     {"CURLE_BAD_DOWNLOAD_RESUME", -1},
 350 #endif
 351 #if HAVE_DECL_CURLE_FILE_COULDNT_READ_FILE
 352     {"CURLE_FILE_COULDNT_READ_FILE", CURLE_FILE_COULDNT_READ_FILE},
 353 #else
 354     {"CURLE_FILE_COULDNT_READ_FILE", -1},
 355 #endif
 356 #if HAVE_DECL_CURLE_LDAP_CANNOT_BIND
 357     {"CURLE_LDAP_CANNOT_BIND", CURLE_LDAP_CANNOT_BIND},
 358 #else
 359     {"CURLE_LDAP_CANNOT_BIND", -1},
 360 #endif
 361 #if HAVE_DECL_CURLE_LDAP_SEARCH_FAILED
 362     {"CURLE_LDAP_SEARCH_FAILED", CURLE_LDAP_SEARCH_FAILED},
 363 #else
 364     {"CURLE_LDAP_SEARCH_FAILED", -1},
 365 #endif
 366 #if HAVE_DECL_CURLE_LIBRARY_NOT_FOUND
 367     {"CURLE_LIBRARY_NOT_FOUND", CURLE_LIBRARY_NOT_FOUND},
 368 #else
 369     {"CURLE_LIBRARY_NOT_FOUND", -1},
 370 #endif
 371 #if HAVE_DECL_CURLE_FUNCTION_NOT_FOUND
 372     {"CURLE_FUNCTION_NOT_FOUND", CURLE_FUNCTION_NOT_FOUND},
 373 #else
 374     {"CURLE_FUNCTION_NOT_FOUND", -1},
 375 #endif
 376 #if HAVE_DECL_CURLE_ABORTED_BY_CALLBACK
 377     {"CURLE_ABORTED_BY_CALLBACK", CURLE_ABORTED_BY_CALLBACK},
 378 #else
 379     {"CURLE_ABORTED_BY_CALLBACK", -1},
 380 #endif
 381 #if HAVE_DECL_CURLE_BAD_FUNCTION_ARGUMENT
 382     {"CURLE_BAD_FUNCTION_ARGUMENT", CURLE_BAD_FUNCTION_ARGUMENT},
 383 #else
 384     {"CURLE_BAD_FUNCTION_ARGUMENT", -1},
 385 #endif
 386 #if HAVE_DECL_CURLE_BAD_CALLING_ORDER
 387     {"CURLE_BAD_CALLING_ORDER", CURLE_BAD_CALLING_ORDER},
 388 #else
 389     {"CURLE_BAD_CALLING_ORDER", -1},
 390 #endif
 391 #if HAVE_DECL_CURLE_INTERFACE_FAILED
 392     {"CURLE_INTERFACE_FAILED", CURLE_INTERFACE_FAILED},
 393 #else
 394     {"CURLE_INTERFACE_FAILED", -1},
 395 #endif
 396 #if HAVE_DECL_CURLE_BAD_PASSWORD_ENTERED
 397     {"CURLE_BAD_PASSWORD_ENTERED", CURLE_BAD_PASSWORD_ENTERED},
 398 #else
 399     {"CURLE_BAD_PASSWORD_ENTERED", -1},
 400 #endif
 401 #if HAVE_DECL_CURLE_TOO_MANY_REDIRECTS
 402     {"CURLE_TOO_MANY_REDIRECTS", CURLE_TOO_MANY_REDIRECTS},
 403 #else
 404     {"CURLE_TOO_MANY_REDIRECTS", -1},
 405 #endif
 406 #if HAVE_DECL_CURLE_UNKNOWN_TELNET_OPTION
 407     {"CURLE_UNKNOWN_TELNET_OPTION", CURLE_UNKNOWN_TELNET_OPTION},
 408 #else
 409     {"CURLE_UNKNOWN_TELNET_OPTION", -1},
 410 #endif
 411 #if HAVE_DECL_CURLE_TELNET_OPTION_SYNTAX
 412     {"CURLE_TELNET_OPTION_SYNTAX", CURLE_TELNET_OPTION_SYNTAX},
 413 #else
 414     {"CURLE_TELNET_OPTION_SYNTAX", -1},
 415 #endif
 416 #if HAVE_DECL_CURLE_SSL_PEER_CERTIFICATE
 417     {"CURLE_SSL_PEER_CERTIFICATE", CURLE_SSL_PEER_CERTIFICATE},
 418 #else
 419     {"CURLE_SSL_PEER_CERTIFICATE", -1},
 420 #endif
 421 #if HAVE_DECL_CURLE_GOT_NOTHING
 422     {"CURLE_GOT_NOTHING", CURLE_GOT_NOTHING},
 423 #else
 424     {"CURLE_GOT_NOTHING", -1},
 425 #endif
 426 #if HAVE_DECL_CURLE_SSL_ENGINE_NOTFOUND
 427     {"CURLE_SSL_ENGINE_NOTFOUND", CURLE_SSL_ENGINE_NOTFOUND},
 428 #else
 429     {"CURLE_SSL_ENGINE_NOTFOUND", -1},
 430 #endif
 431 #if HAVE_DECL_CURLE_SSL_ENGINE_SETFAILED
 432     {"CURLE_SSL_ENGINE_SETFAILED", CURLE_SSL_ENGINE_SETFAILED},
 433 #else
 434     {"CURLE_SSL_ENGINE_SETFAILED", -1},
 435 #endif
 436 #if HAVE_DECL_CURLE_SEND_ERROR
 437     {"CURLE_SEND_ERROR", CURLE_SEND_ERROR},
 438 #else
 439     {"CURLE_SEND_ERROR", -1},
 440 #endif
 441 #if HAVE_DECL_CURLE_RECV_ERROR
 442     {"CURLE_RECV_ERROR", CURLE_RECV_ERROR},
 443 #else
 444     {"CURLE_RECV_ERROR", -1},
 445 #endif
 446 #if HAVE_DECL_CURLE_SHARE_IN_USE
 447     {"CURLE_SHARE_IN_USE", CURLE_SHARE_IN_USE},
 448 #else
 449     {"CURLE_SHARE_IN_USE", -1},
 450 #endif
 451 #if HAVE_DECL_CURLE_SSL_CERTPROBLEM
 452     {"CURLE_SSL_CERTPROBLEM", CURLE_SSL_CERTPROBLEM},
 453 #else
 454     {"CURLE_SSL_CERTPROBLEM", -1},
 455 #endif
 456 #if HAVE_DECL_CURLE_SSL_CIPHER
 457     {"CURLE_SSL_CIPHER", CURLE_SSL_CIPHER},
 458 #else
 459     {"CURLE_SSL_CIPHER", -1},
 460 #endif
 461 #if HAVE_DECL_CURLE_SSL_CACERT
 462     {"CURLE_SSL_CACERT", CURLE_SSL_CACERT},
 463 #else
 464     {"CURLE_SSL_CACERT", -1},
 465 #endif
 466 #if HAVE_DECL_CURLE_BAD_CONTENT_ENCODING
 467     {"CURLE_BAD_CONTENT_ENCODING", CURLE_BAD_CONTENT_ENCODING},
 468 #else
 469     {"CURLE_BAD_CONTENT_ENCODING", -1},
 470 #endif
 471 #if HAVE_DECL_CURLE_LDAP_INVALID_URL
 472     {"CURLE_LDAP_INVALID_URL", CURLE_LDAP_INVALID_URL},
 473 #else
 474     {"CURLE_LDAP_INVALID_URL", -1},
 475 #endif
 476 #if HAVE_DECL_CURLE_FILESIZE_EXCEEDED
 477     {"CURLE_FILESIZE_EXCEEDED", CURLE_FILESIZE_EXCEEDED},
 478 #else
 479     {"CURLE_FILESIZE_EXCEEDED", -1},
 480 #endif
 481 #if HAVE_DECL_CURLE_FTP_SSL_FAILED
 482     {"CURLE_FTP_SSL_FAILED", CURLE_FTP_SSL_FAILED},
 483 #else
 484     {"CURLE_FTP_SSL_FAILED", -1},
 485 #endif
 486 #if HAVE_DECL_CURLE_SEND_FAIL_REWIND
 487     {"CURLE_SEND_FAIL_REWIND", CURLE_SEND_FAIL_REWIND},
 488 #else
 489     {"CURLE_SEND_FAIL_REWIND", -1},
 490 #endif
 491 #if HAVE_DECL_CURLE_SSL_ENGINE_INITFAILED
 492     {"CURLE_SSL_ENGINE_INITFAILED", CURLE_SSL_ENGINE_INITFAILED},
 493 #else
 494     {"CURLE_SSL_ENGINE_INITFAILED", -1},
 495 #endif
 496 #if HAVE_DECL_CURLE_LOGIN_DENIED
 497     {"CURLE_LOGIN_DENIED", CURLE_LOGIN_DENIED},
 498 #else
 499     {"CURLE_LOGIN_DENIED", -1},
 500 #endif
 501 #if HAVE_DECL_CURLE_TFTP_NOTFOUND
 502     {"CURLE_TFTP_NOTFOUND", CURLE_TFTP_NOTFOUND},
 503 #else
 504     {"CURLE_TFTP_NOTFOUND", -1},
 505 #endif
 506 #if HAVE_DECL_CURLE_TFTP_PERM
 507     {"CURLE_TFTP_PERM", CURLE_TFTP_PERM},
 508 #else
 509     {"CURLE_TFTP_PERM", -1},
 510 #endif
 511 #if HAVE_DECL_CURLE_REMOTE_DISK_FULL
 512     {"CURLE_REMOTE_DISK_FULL", CURLE_REMOTE_DISK_FULL},
 513 #else
 514     {"CURLE_REMOTE_DISK_FULL", -1},
 515 #endif
 516 #if HAVE_DECL_CURLE_TFTP_ILLEGAL
 517     {"CURLE_TFTP_ILLEGAL", CURLE_TFTP_ILLEGAL},
 518 #else
 519     {"CURLE_TFTP_ILLEGAL", -1},
 520 #endif
 521 #if HAVE_DECL_CURLE_TFTP_UNKNOWNID
 522     {"CURLE_TFTP_UNKNOWNID", CURLE_TFTP_UNKNOWNID},
 523 #else
 524     {"CURLE_TFTP_UNKNOWNID", -1},
 525 #endif
 526 #if HAVE_DECL_CURLE_REMOTE_FILE_EXISTS
 527     {"CURLE_REMOTE_FILE_EXISTS", CURLE_REMOTE_FILE_EXISTS},
 528 #else
 529     {"CURLE_REMOTE_FILE_EXISTS", -1},
 530 #endif
 531 #if HAVE_DECL_CURLE_TFTP_NOSUCHUSER
 532     {"CURLE_TFTP_NOSUCHUSER", CURLE_TFTP_NOSUCHUSER},
 533 #else
 534     {"CURLE_TFTP_NOSUCHUSER", -1},
 535 #endif
 536 #if HAVE_DECL_CURLE_CONV_FAILED
 537     {"CURLE_CONV_FAILED", CURLE_CONV_FAILED},
 538 #else
 539     {"CURLE_CONV_FAILED", -1},
 540 #endif
 541 #if HAVE_DECL_CURLE_CONV_REQD
 542     {"CURLE_CONV_REQD", CURLE_CONV_REQD},
 543 #else
 544     {"CURLE_CONV_REQD", -1},
 545 #endif
 546 #if HAVE_DECL_CURLE_SSL_CACERT_BADFILE
 547     {"CURLE_SSL_CACERT_BADFILE", CURLE_SSL_CACERT_BADFILE},
 548 #else
 549     {"CURLE_SSL_CACERT_BADFILE", -1},
 550 #endif
 551 #if HAVE_DECL_CURLE_REMOTE_FILE_NOT_FOUND
 552     {"CURLE_REMOTE_FILE_NOT_FOUND", CURLE_REMOTE_FILE_NOT_FOUND},
 553 #else
 554     {"CURLE_REMOTE_FILE_NOT_FOUND", -1},
 555 #endif
 556 #if HAVE_DECL_CURLE_SSH
 557     {"CURLE_SSH", CURLE_SSH},
 558 #else
 559     {"CURLE_SSH", -1},
 560 #endif
 561 #if HAVE_DECL_CURLE_SSL_SHUTDOWN_FAILED
 562     {"CURLE_SSL_SHUTDOWN_FAILED", CURLE_SSL_SHUTDOWN_FAILED},
 563 #else
 564     {"CURLE_SSL_SHUTDOWN_FAILED", -1},
 565 #endif
 566 #if HAVE_DECL_CURLE_AGAIN
 567     {"CURLE_AGAIN", CURLE_AGAIN},
 568 #else
 569     {"CURLE_AGAIN", -1},
 570 #endif
 571     {NULL, (CURLcode)0}
 572 };
 573
 574 typedef struct CURLOptionMapping CURLOptionMapping;
 575
 576 struct CURLOptionMapping
 577 {
 578     void (*optionHandler)(Connection *, value);
 579     char *name;
 580     OcamlValue ocamlValue;
 581 };
 582
 583 static char* strdup_ml(value v)
 584 {
 585   char* p = NULL;
 586   p = (char*)malloc(caml_string_length(v)+1);
 587   memcpy(p,String_val(v),caml_string_length(v)+1); // caml strings have terminating zero
 588   return p;
 589 }
 590
 591 static value ml_copy_string(char const* p, size_t size)
 592 {
 593   value v = caml_alloc_string(size);
 594   memcpy(&Byte(v,0),p,size);
 595   return v;
 596 }
 597
 598 /* prepends to the beginning of list */
 599 static struct curl_slist* curl_slist_prepend_ml(struct curl_slist* list, value v)
 600 {
 601   /* FIXME check NULLs */
 602   struct curl_slist* new_item = (struct curl_slist*)malloc(sizeof(struct curl_slist));
 603
 604   new_item->next = list;
 605   new_item->data = strdup_ml(v);
 606
 607   return new_item;
 608 }
 609
 610 static void free_curl_slist(struct curl_slist *slist)
 611 {
 612     if (NULL == slist)
 613       return;
 614
 615     curl_slist_free_all(slist);
 616 }
 617
 618 static void raiseError(Connection *conn, CURLcode code)
 619 {
 620     CAMLparam0();
 621     CAMLlocal1(exceptionData);
 622     value *exception;
 623     char *errorString = "Unknown Error";
 624     int i;
 625
 626     for (i = 0; errorMap[i].name != NULL; i++)
 627     {
 628         if (errorMap[i].error == code)
 629         {
 630             errorString = errorMap[i].name;
 631             break;
 632         }
 633     }
 634
 635     exceptionData = caml_alloc_tuple(3);
 636
 637     Store_field(exceptionData, 0, Val_int(code));
 638     Store_field(exceptionData, 1, Val_int(code));
 639     Store_field(exceptionData, 2, caml_copy_string(errorString));
 640
 641     if (conn != NULL && conn->curl_ERRORBUFFER != NULL)
 642     {
 643         Store_field(Field(conn->ocamlValues, Ocaml_ERRORBUFFER), 0, caml_copy_string(conn->curl_ERRORBUFFER));
 644     }
 645
 646     exception = caml_named_value("CurlException");
 647
 648     if (exception == NULL)
 649         caml_failwith("CurlException not registered");
 650
 651     caml_raise_with_arg(*exception, exceptionData);
 652
 653     CAMLreturn0;
 654 }
 655
 656 static void resetOcamlValues(Connection* connection)
 657 {
 658     int i;
 659
 660     for (i = 0; i < OcamlValuesSize; i++)
 661         Store_field(connection->ocamlValues, i, Val_unit);
 662 }
 663
 664 static Connection* allocConnection(CURL* h)
 665 {
 666     Connection* connection = (Connection *)malloc(sizeof(Connection));
 667
 668     connection->ocamlValues = caml_alloc(OcamlValuesSize, 0);
 669     resetOcamlValues(connection);
 670     caml_register_global_root(&connection->ocamlValues);
 671
 672     connection->handle = h;
 673     curl_easy_setopt(h, CURLOPT_PRIVATE, connection);
 674
 675     connection->refcount = 0;
 676
 677     connection->curl_ERRORBUFFER = NULL;
 678     connection->curl_POSTFIELDS = NULL;
 679     connection->curl_HTTPHEADER = NULL;
 680     connection->httpPostBuffers = NULL;
 681     connection->httpPostFirst = NULL;
 682     connection->httpPostLast = NULL;
 683     connection->curl_QUOTE = NULL;
 684     connection->curl_POSTQUOTE = NULL;
 685     connection->curl_HTTP200ALIASES = NULL;
 686     connection->curl_RESOLVE = NULL;
 687     connection->curl_MAIL_RCPT = NULL;
 688
 689     return connection;
 690 }
 691
 692 static Connection *newConnection(void)
 693 {
 694     CURL* h;
 695
 696     caml_enter_blocking_section();
 697     h = curl_easy_init();
 698     caml_leave_blocking_section();
 699
 700     return allocConnection(h);
 701 }
 702
 703 static void free_if(void* p) { if (NULL != p) free(p); }
 704
 705 static void removeConnection(Connection *connection, int finalization)
 706 {
 707     const char* fin_url = NULL;
 708
 709     if (!connection->handle)
 710     {
 711       return; /* already cleaned up */
 712     }
 713
 714     if (finalization)
 715     {
 716       /* cannot engage OCaml runtime at finalization, just report leak */
 717       if (CURLE_OK != curl_easy_getinfo(connection->handle, CURLINFO_EFFECTIVE_URL, &fin_url) || NULL == fin_url)
 718       {
 719         fin_url = "unknown";
 720       }
 721       fprintf(stderr,"Curl: handle %p leaked, conn %p, url %s\n", connection->handle, connection, fin_url);
 722       fflush(stderr);
 723     }
 724     else
 725     {
 726       caml_enter_blocking_section();
 727       curl_easy_cleanup(connection->handle);
 728       caml_leave_blocking_section();
 729     }
 730
 731     connection->handle = NULL;
 732
 733     caml_remove_global_root(&connection->ocamlValues);
 734
 735     free_if(connection->curl_ERRORBUFFER);
 736     free_if(connection->curl_POSTFIELDS);
 737     free_curl_slist(connection->curl_HTTPHEADER);
 738     free_curl_slist(connection->httpPostBuffers);
 739     if (connection->httpPostFirst != NULL)
 740         curl_formfree(connection->httpPostFirst);
 741     free_curl_slist(connection->curl_RESOLVE);
 742     free_curl_slist(connection->curl_QUOTE);
 743     free_curl_slist(connection->curl_POSTQUOTE);
 744     free_curl_slist(connection->curl_HTTP200ALIASES);
 745     free_curl_slist(connection->curl_MAIL_RCPT);
 746 }
 747
 748 static Connection* getConnection(CURL* h)
 749 {
 750   Connection* p = NULL;
 751
 752   if (CURLE_OK != curl_easy_getinfo(h, CURLINFO_PRIVATE, &p) || NULL == p)
 753   {
 754     caml_failwith("Unknown handle");
 755   }
 756
 757   return p;
 758 }
 759
 760 #if 1
 761 static void checkConnection(Connection * connection)
 762 {
 763   (void)connection;
 764 }
 765 #else
 766 static void checkConnection(Connection *connection)
 767 {
 768   if (connection != getConnection(connection->handle))
 769   {
 770     caml_failwith("Invalid Connection");
 771   }
 772 }
 773 #endif
 774
 775 void op_curl_easy_finalize(value v)
 776 {
 777   Connection* conn = Connection_val(v);
 778   /* same connection may be referenced by several different
 779      OCaml values, see e.g. caml_curl_multi_remove_finished */
 780   conn->refcount--;
 781   if (0 == conn->refcount)
 782   {
 783     removeConnection(conn, 1);
 784     free(conn);
 785   }
 786 }
 787
 788 int op_curl_easy_compare(value v1, value v2)
 789 {
 790   size_t p1 = (size_t)Connection_val(v1);
 791   size_t p2 = (size_t)Connection_val(v2);
 792   return (p1 == p2 ? 0 : (p1 > p2 ? 1 : -1)); /* compare addresses */
 793 }
 794
 795 intnat op_curl_easy_hash(value v)
 796 {
 797   return (size_t)Connection_val(v); /* address */
 798 }
 799
 800 static struct custom_operations curl_easy_ops = {
 801   "ygrek.curl_easy",
 802   op_curl_easy_finalize,
 803   op_curl_easy_compare,
 804   op_curl_easy_hash,
 805   custom_serialize_default,
 806   custom_deserialize_default,
 807 #if defined(custom_compare_ext_default)
 808   custom_compare_ext_default,
 809 #endif
 810 };
 811
 812 value caml_curl_alloc(Connection* conn)
 813 {
 814   value v = caml_alloc_custom(&curl_easy_ops, sizeof(Connection*), 0, 1);
 815   Connection_val(v) = conn;
 816   conn->refcount++;
 817   return v;
 818 }
 819
 820 static size_t cb_WRITEFUNCTION(char *ptr, size_t size, size_t nmemb, void *data)
 821 {
 822     caml_leave_blocking_section();
 823
 824     CAMLparam0();
 825     CAMLlocal2(result, str);
 826     Connection *conn = (Connection *)data;
 827
 828     checkConnection(conn);
 829
 830     str = ml_copy_string(ptr,size*nmemb);
 831
 832     result = caml_callback_exn(Field(conn->ocamlValues, Ocaml_WRITEFUNCTION), str);
 833
 834     size_t r = Is_exception_result(result) ? 0 : Int_val(result);
 835     CAMLdrop;
 836
 837     caml_enter_blocking_section();
 838     return r;
 839 }
 840
 841 static size_t cb_READFUNCTION(void *ptr, size_t size, size_t nmemb, void *data)
 842 {
 843     caml_leave_blocking_section();
 844
 845     CAMLparam0();
 846     CAMLlocal1(result);
 847     Connection *conn = (Connection *)data;
 848     size_t length;
 849
 850     checkConnection(conn);
 851
 852     result = caml_callback_exn(Field(conn->ocamlValues, Ocaml_READFUNCTION),
 853                       Val_int(size*nmemb));
 854
 855     if (Is_exception_result(result))
 856     {
 857       CAMLreturnT(size_t,CURL_READFUNC_ABORT);
 858     }
 859
 860     length = caml_string_length(result);
 861
 862     size_t r;
 863
 864     if (length <= size*nmemb)
 865     {
 866       memcpy(ptr, String_val(result), length);
 867       r = length;
 868     }
 869     else
 870     {
 871       r = CURL_READFUNC_ABORT;
 872     }
 873     CAMLdrop;
 874
 875     caml_enter_blocking_section();
 876     return r;
 877 }
 878
 879 static size_t cb_HEADERFUNCTION(char *ptr, size_t size, size_t nmemb, void *data)
 880 {
 881     caml_leave_blocking_section();
 882
 883     CAMLparam0();
 884     CAMLlocal2(result,str);
 885     Connection *conn = (Connection *)data;
 886
 887     checkConnection(conn);
 888
 889     str = ml_copy_string(ptr,size*nmemb);
 890
 891     result = caml_callback_exn(Field(conn->ocamlValues, Ocaml_HEADERFUNCTION), str);
 892
 893     size_t r = Is_exception_result(result) ? 0 : Int_val(result);
 894     CAMLdrop;
 895
 896     caml_enter_blocking_section();
 897     return r;
 898 }
 899
 900 static int cb_PROGRESSFUNCTION(void *data,
 901                             double dlTotal,
 902                             double dlNow,
 903                             double ulTotal,
 904                             double ulNow)
 905 {
 906     caml_leave_blocking_section();
 907
 908     CAMLparam0();
 909     CAMLlocal1(result);
 910     CAMLlocalN(callbackData, 4);
 911     Connection *conn = (Connection *)data;
 912
 913     checkConnection(conn);
 914
 915     callbackData[0] = caml_copy_double(dlTotal);
 916     callbackData[1] = caml_copy_double(dlNow);
 917     callbackData[2] = caml_copy_double(ulTotal);
 918     callbackData[3] = caml_copy_double(ulNow);
 919
 920     result = caml_callbackN_exn(Field(conn->ocamlValues, Ocaml_PROGRESSFUNCTION),
 921                        4, callbackData);
 922
 923     int r = Is_exception_result(result) ? 1 : Bool_val(result);
 924     CAMLdrop;
 925
 926     caml_enter_blocking_section();
 927     return r;
 928 }
 929
 930 static int cb_DEBUGFUNCTION(CURL *debugConnection,
 931                          curl_infotype infoType,
 932                          char *buffer,
 933                          size_t bufferLength,
 934                          void *data)
 935 {
 936     caml_leave_blocking_section();
 937
 938     CAMLparam0();
 939     CAMLlocal3(camlDebugConnection, camlInfoType, camlMessage);
 940     Connection *conn = (Connection *)data;
 941     (void)debugConnection; /* not used */
 942
 943     checkConnection(conn);
 944
 945     camlDebugConnection = caml_curl_alloc(conn);
 946     camlMessage = ml_copy_string(buffer,bufferLength);
 947     camlInfoType = Val_long(infoType <= CURLINFO_SSL_DATA_OUT ? infoType : CURLINFO_END);
 948
 949     caml_callback3_exn(Field(conn->ocamlValues, Ocaml_DEBUGFUNCTION),
 950               camlDebugConnection,
 951               camlInfoType,
 952               camlMessage);
 953
 954     CAMLdrop;
 955
 956     caml_enter_blocking_section();
 957     return 0;
 958 }
 959
 960 static curlioerr cb_IOCTLFUNCTION(CURL *ioctl,
 961                                int cmd,
 962                                void *data)
 963 {
 964     caml_leave_blocking_section();
 965
 966     CAMLparam0();
 967     CAMLlocal3(camlResult, camlConnection, camlCmd);
 968     Connection *conn = (Connection *)data;
 969     curlioerr result = CURLIOE_OK;
 970     (void)ioctl; /* not used */
 971
 972     checkConnection(conn);
 973
 974     if (cmd == CURLIOCMD_NOP)
 975         camlCmd = Val_long(0);
 976     else if (cmd == CURLIOCMD_RESTARTREAD)
 977         camlCmd = Val_long(1);
 978     else
 979         caml_failwith("Invalid IOCTL Cmd!");
 980
 981     camlConnection = caml_curl_alloc(conn);
 982
 983     camlResult = caml_callback2_exn(Field(conn->ocamlValues, Ocaml_IOCTLFUNCTION),
 984                            camlConnection,
 985                            camlCmd);
 986
 987     if (Is_exception_result(camlResult))
 988     {
 989       result = CURLIOE_FAILRESTART;
 990     }
 991     else
 992     switch (Long_val(camlResult))
 993     {
 994     case 0: /* CURLIOE_OK */
 995         result = CURLIOE_OK;
 996         break;
 997
 998     case 1: /* CURLIOE_UNKNOWNCMD */
 999         result = CURLIOE_UNKNOWNCMD;
1000         break;
1001
1002     case 2: /* CURLIOE_FAILRESTART */
1003         result = CURLIOE_FAILRESTART;
1004         break;
1005
1006     default: /* Incorrect return value, but let's handle it */
1007         result = CURLIOE_FAILRESTART;
1008         break;
1009     }
1010     CAMLdrop;
1011
1012     caml_enter_blocking_section();
1013     return result;
1014 }
1015
1016 #if HAVE_DECL_CURLOPT_SEEKFUNCTION
1017 static int cb_SEEKFUNCTION(void *data,
1018                         curl_off_t offset,
1019                         int origin)
1020 {
1021     caml_leave_blocking_section();
1022
1023     CAMLparam0();
1024     CAMLlocal3(camlResult, camlOffset, camlOrigin);
1025     Connection *conn = (Connection *)data;
1026
1027     camlOffset = caml_copy_int64(offset);
1028
1029     if (origin == SEEK_SET)
1030         camlOrigin = Val_long(0);
1031     else if (origin == SEEK_CUR)
1032         camlOrigin = Val_long(1);
1033     else if (origin == SEEK_END)
1034         camlOrigin = Val_long(2);
1035     else
1036         caml_failwith("Invalid seek code");
1037
1038     camlResult = caml_callback2_exn(Field(conn->ocamlValues,
1039                                  Ocaml_SEEKFUNCTION),
1040                            camlOffset,
1041                            camlOrigin);
1042
1043     int result;
1044     if (Is_exception_result(camlResult))
1045       result = CURL_SEEKFUNC_FAIL;
1046     else
1047     switch (Int_val(camlResult))
1048     {
1049       case 0: result = CURL_SEEKFUNC_OK; break;
1050       case 1: result = CURL_SEEKFUNC_FAIL; break;
1051       case 2: result = CURL_SEEKFUNC_CANTSEEK; break;
1052       default: caml_failwith("Invalid seek result");
1053     }
1054     CAMLdrop;
1055
1056     caml_enter_blocking_section();
1057     return result;
1058 }
1059 #endif
1060
1061 #if HAVE_DECL_CURLOPT_OPENSOCKETFUNCTION
1062 static int cb_OPENSOCKETFUNCTION(void *data,
1063                         curlsocktype purpose,
1064                         struct curl_sockaddr *addr)
1065 {
1066     caml_leave_blocking_section();
1067
1068     CAMLparam0();
1069     CAMLlocal1(result);
1070     Connection *conn = (Connection *)data;
1071     int sock = -1;
1072     (void)purpose; /* not used */
1073
1074     sock = socket(addr->family, addr->socktype, addr->protocol);
1075
1076     if (-1 != sock)
1077     {
1078       /* FIXME windows */
1079       result = caml_callback_exn(Field(conn->ocamlValues, Ocaml_OPENSOCKETFUNCTION), Val_int(sock));
1080       if (Is_exception_result(result))
1081       {
1082         close(sock);
1083         sock = -1;
1084       }
1085     }
1086     CAMLdrop;
1087
1088     caml_enter_blocking_section();
1089     return ((sock == -1) ? CURL_SOCKET_BAD : sock);
1090 }
1091 #endif
1092
1093 /**
1094  **  curl_global_init helper function
1095  **/
1096
1097 value helper_curl_global_init(value initOption)
1098 {
1099     CAMLparam1(initOption);
1100
1101     switch (Long_val(initOption))
1102     {
1103     case 0: /* CURLINIT_GLOBALALL */
1104         CAMLreturn(Val_long(curl_global_init(CURL_GLOBAL_ALL)));
1105         break;
1106
1107     case 1: /* CURLINIT_GLOBALSSL */
1108         CAMLreturn(Val_long(curl_global_init(CURL_GLOBAL_SSL)));
1109         break;
1110
1111     case 2: /* CURLINIT_GLOBALWIN32 */
1112         CAMLreturn(Val_long(curl_global_init(CURL_GLOBAL_WIN32)));
1113         break;
1114
1115     case 3: /* CURLINIT_GLOBALNOTHING */
1116         CAMLreturn(Val_long(curl_global_init(CURL_GLOBAL_NOTHING)));
1117         break;
1118
1119     default:
1120         caml_failwith("Invalid Initialization Option");
1121         break;
1122     }
1123
1124     /* Keep compiler happy, we should never get here due to caml_failwith() */
1125     CAMLreturn(Val_unit);
1126 }
1127
1128 /**
1129  **  curl_global_cleanup helper function
1130  **/
1131
1132 value helper_curl_global_cleanup(void)
1133 {
1134     CAMLparam0();
1135
1136     curl_global_cleanup();
1137
1138     CAMLreturn(Val_unit);
1139 }
1140
1141 /**
1142  ** curl_easy_init helper function
1143  **/
1144 value helper_curl_easy_init(void)
1145 {
1146     CAMLparam0();
1147     CAMLlocal1(result);
1148
1149     result = caml_curl_alloc(newConnection());
1150
1151     CAMLreturn(result);
1152 }
1153
1154 value helper_curl_easy_reset(value conn)
1155 {
1156     CAMLparam1(conn);
1157     Connection *connection = Connection_val(conn);
1158
1159     checkConnection(connection);
1160     curl_easy_reset(connection->handle);
1161     curl_easy_setopt(connection->handle, CURLOPT_PRIVATE, connection);
1162     resetOcamlValues(connection);
1163
1164     CAMLreturn(Val_unit);
1165 }
1166
1167 /**
1168  **  curl_easy_setopt helper utility functions
1169  **/
1170
1171 #define SETOPT_FUNCTION(name) \
1172 static void handle_##name##FUNCTION(Connection *conn, value option) \
1173 { \
1174     CAMLparam1(option); \
1175     CURLcode result = CURLE_OK; \
1176     Store_field(conn->ocamlValues, Ocaml_##name##FUNCTION, option); \
1177     result = curl_easy_setopt(conn->handle, CURLOPT_##name##FUNCTION, cb_##name##FUNCTION); \
1178     if (result != CURLE_OK) raiseError(conn, result); \
1179     result = curl_easy_setopt(conn->handle, CURLOPT_##name##DATA, conn); \
1180     if (result != CURLE_OK) raiseError(conn, result); \
1181     CAMLreturn0; \
1182 }
1183
1184 SETOPT_FUNCTION( WRITE)
1185 SETOPT_FUNCTION( READ)
1186 SETOPT_FUNCTION( HEADER)
1187 SETOPT_FUNCTION( PROGRESS)
1188 SETOPT_FUNCTION( DEBUG)
1189
1190 #if HAVE_DECL_CURLOPT_SEEKFUNCTION
1191 SETOPT_FUNCTION( SEEK)
1192 #endif
1193
1194 #if HAVE_DECL_CURLOPT_IOCTLFUNCTION
1195 SETOPT_FUNCTION( IOCTL)
1196 #endif
1197
1198 #if HAVE_DECL_CURLOPT_OPENSOCKETFUNCTION
1199 SETOPT_FUNCTION( OPENSOCKET)
1200 #endif
1201
1202 static void handle_slist(Connection *conn, struct curl_slist** slist, OcamlValue caml_option, CURLoption curl_option, value option)
1203 {
1204     CAMLparam1(option);
1205     CURLcode result = CURLE_OK;
1206
1207     Store_field(conn->ocamlValues, caml_option, option);
1208
1209     free_curl_slist(*slist);
1210     *slist = NULL;
1211
1212     while (Val_emptylist != option)
1213     {
1214         *slist = curl_slist_append(*slist, String_val(Field(option, 0)));
1215
1216         option = Field(option, 1);
1217     }
1218
1219     result = curl_easy_setopt(conn->handle, curl_option, *slist);
1220
1221     if (result != CURLE_OK)
1222         raiseError(conn, result);
1223
1224     CAMLreturn0;
1225 }
1226
1227 static long convert_bit_list(long *map, size_t map_size, value option)
1228 {
1229     CAMLparam1(option);
1230     long bits = 0;
1231     int index;
1232
1233     while (Val_emptylist != option)
1234     {
1235         index = Int_val(Field(option, 0));
1236         if ((index < 0) || ((size_t)index >= map_size))
1237           caml_invalid_argument("convert_bit_list");
1238
1239         bits |= map[index];
1240
1241         option = Field(option, 1);
1242     }
1243
1244     CAMLreturnT(long, bits);
1245 }
1246
1247 #define SETOPT_STRING(name) \
1248 static void handle_##name(Connection *conn, value option) \
1249 { \
1250     CAMLparam1(option); \
1251     CURLcode result = CURLE_OK; \
1252 \
1253     Store_field(conn->ocamlValues, Ocaml_##name, option); \
1254 \
1255     result = curl_easy_setopt(conn->handle, CURLOPT_##name, String_val(option)); \
1256 \
1257     if (result != CURLE_OK) \
1258         raiseError(conn, result); \
1259 \
1260     CAMLreturn0; \
1261 }
1262
1263 #define SETOPT_VAL_(func_name, curl_option, conv_val) \
1264 static void func_name(Connection *conn, value option) \
1265 { \
1266     CAMLparam1(option); \
1267     CURLcode result = CURLE_OK; \
1268 \
1269     result = curl_easy_setopt(conn->handle, curl_option, conv_val(option)); \
1270 \
1271     if (result != CURLE_OK) \
1272         raiseError(conn, result); \
1273 \
1274     CAMLreturn0; \
1275 }
1276
1277 #define SETOPT_VAL(name, conv) SETOPT_VAL_(handle_##name, CURLOPT_##name, conv)
1278 #define SETOPT_BOOL(name) SETOPT_VAL(name, Bool_val)
1279 #define SETOPT_LONG(name) SETOPT_VAL(name, Long_val)
1280 #define SETOPT_INT64(name) SETOPT_VAL(name, Int64_val)
1281
1282 #define SETOPT_SLIST(name) \
1283 static void handle_##name(Connection* conn, value option) \
1284 { \
1285   handle_slist(conn,&(conn->curl_##name),Ocaml_##name,CURLOPT_##name,option); \
1286 }
1287
1288 SETOPT_STRING( URL)
1289 SETOPT_LONG( INFILESIZE)
1290 SETOPT_STRING( PROXY)
1291 SETOPT_LONG( PROXYPORT)
1292 SETOPT_BOOL( HTTPPROXYTUNNEL)
1293 SETOPT_BOOL( VERBOSE)
1294 SETOPT_BOOL( HEADER)
1295 SETOPT_BOOL( NOPROGRESS)
1296
1297 #if HAVE_DECL_CURLOPT_NOSIGNAL
1298 SETOPT_BOOL( NOSIGNAL)
1299 #endif
1300
1301 SETOPT_BOOL( NOBODY)
1302 SETOPT_BOOL( FAILONERROR)
1303 SETOPT_BOOL( UPLOAD)
1304 SETOPT_BOOL( POST)
1305 SETOPT_BOOL( FTPLISTONLY)
1306 SETOPT_BOOL( FTPAPPEND)
1307
1308
1309 static void handle_NETRC(Connection *conn, value option)
1310 {
1311     CAMLparam1(option);
1312     CURLcode result = CURLE_OK;
1313     long netrc;
1314
1315     switch (Long_val(option))
1316     {
1317     case 0: /* CURL_NETRC_OPTIONAL */
1318         netrc = CURL_NETRC_OPTIONAL;
1319         break;
1320
1321     case 1:/* CURL_NETRC_IGNORED */
1322         netrc = CURL_NETRC_IGNORED;
1323         break;
1324
1325     case 2: /* CURL_NETRC_REQUIRED */
1326         netrc = CURL_NETRC_REQUIRED;
1327         break;
1328
1329     default:
1330         caml_failwith("Invalid NETRC Option");
1331         break;
1332     }
1333
1334     result = curl_easy_setopt(conn->handle,
1335                               CURLOPT_NETRC,
1336                               netrc);
1337
1338     if (result != CURLE_OK)
1339         raiseError(conn, result);
1340
1341     CAMLreturn0;
1342 }
1343
1344 #if HAVE_DECL_CURLOPT_ENCODING
1345 static void handle_ENCODING(Connection *conn, value option)
1346 {
1347     CAMLparam1(option);
1348     CURLcode result = CURLE_OK;
1349
1350     switch (Long_val(option))
1351     {
1352     case 0: /* CURL_ENCODING_NONE */
1353         result = curl_easy_setopt(conn->handle,
1354                                   CURLOPT_ENCODING,
1355                                   "identity");
1356         break;
1357
1358     case 1: /* CURL_ENCODING_DEFLATE */
1359         result = curl_easy_setopt(conn->handle,
1360                                   CURLOPT_ENCODING,
1361                                   "deflate");
1362         break;
1363
1364     case 2: /* CURL_ENCODING_GZIP */
1365         result = curl_easy_setopt(conn->handle,
1366                                   CURLOPT_ENCODING,
1367                                   "gzip");
1368         break;
1369
1370     case 3: /* CURL_ENCODING_ANY */
1371         result = curl_easy_setopt(conn->handle,
1372                                   CURLOPT_ENCODING,
1373                                   "");
1374         break;
1375
1376     default:
1377         caml_failwith("Invalid Encoding Option");
1378         break;
1379     }
1380
1381     if (result != CURLE_OK)
1382         raiseError(conn, result);
1383
1384     CAMLreturn0;
1385 }
1386 #endif
1387
1388
1389 SETOPT_BOOL( FOLLOWLOCATION)
1390 SETOPT_BOOL( TRANSFERTEXT)
1391 SETOPT_BOOL( PUT)
1392 SETOPT_STRING( USERPWD)
1393 SETOPT_STRING( PROXYUSERPWD)
1394 SETOPT_STRING( RANGE)
1395
1396 static void handle_ERRORBUFFER(Connection *conn, value option)
1397 {
1398     CAMLparam1(option);
1399     CURLcode result = CURLE_OK;
1400
1401     Store_field(conn->ocamlValues, Ocaml_ERRORBUFFER, option);
1402
1403     if (conn->curl_ERRORBUFFER != NULL)
1404         free(conn->curl_ERRORBUFFER);
1405
1406     conn->curl_ERRORBUFFER = (char*)malloc(sizeof(char) * CURL_ERROR_SIZE);
1407
1408     result = curl_easy_setopt(conn->handle,
1409                               CURLOPT_ERRORBUFFER,
1410                               conn->curl_ERRORBUFFER);
1411
1412     if (result != CURLE_OK)
1413         raiseError(conn, result);
1414
1415     CAMLreturn0;
1416 }
1417
1418 SETOPT_LONG( TIMEOUT)
1419
1420 static void handle_POSTFIELDS(Connection *conn, value option)
1421 {
1422     CAMLparam1(option);
1423     CURLcode result = CURLE_OK;
1424
1425     Store_field(conn->ocamlValues, Ocaml_POSTFIELDS, option);
1426
1427     if (conn->curl_POSTFIELDS != NULL)
1428         free(conn->curl_POSTFIELDS);
1429
1430     conn->curl_POSTFIELDS = strdup_ml(option);
1431
1432     result = curl_easy_setopt(conn->handle,
1433                               CURLOPT_POSTFIELDS,
1434                               conn->curl_POSTFIELDS);
1435
1436     if (result != CURLE_OK)
1437         raiseError(conn, result);
1438
1439     CAMLreturn0;
1440 }
1441
1442 SETOPT_LONG( POSTFIELDSIZE)
1443 SETOPT_STRING( REFERER)
1444 SETOPT_STRING( USERAGENT)
1445 SETOPT_STRING( FTPPORT)
1446 SETOPT_LONG( LOW_SPEED_LIMIT)
1447 SETOPT_LONG( LOW_SPEED_TIME)
1448 SETOPT_LONG( RESUME_FROM)
1449 SETOPT_STRING( COOKIE)
1450
1451 SETOPT_SLIST( HTTPHEADER)
1452
1453 static void handle_HTTPPOST(Connection *conn, value option)
1454 {
1455     CAMLparam1(option);
1456     CAMLlocal3(listIter, formItem, contentType);
1457     CURLcode result = CURLE_OK;
1458
1459     listIter = option;
1460
1461     Store_field(conn->ocamlValues, Ocaml_HTTPPOST, option);
1462
1463     free_curl_slist(conn->httpPostBuffers);
1464     if (conn->httpPostFirst != NULL)
1465         curl_formfree(conn->httpPostFirst);
1466
1467     conn->httpPostBuffers = NULL;
1468     conn->httpPostFirst = NULL;
1469     conn->httpPostLast = NULL;
1470
1471     while (!Is_long(listIter))
1472     {
1473         formItem = Field(listIter, 0);
1474
1475         switch (Tag_val(formItem))
1476         {
1477         case 0: /* CURLFORM_CONTENT */
1478             if (Wosize_val(formItem) < 3)
1479             {
1480                 caml_failwith("Incorrect CURLFORM_CONTENT parameters");
1481             }
1482
1483             if (Is_long(Field(formItem, 2)) &&
1484                 Long_val(Field(formItem, 2)) == 0)
1485             {
1486                 curl_formadd(&conn->httpPostFirst,
1487                              &conn->httpPostLast,
1488                              CURLFORM_COPYNAME,
1489                              String_val(Field(formItem, 0)),
1490                              CURLFORM_NAMELENGTH,
1491                              caml_string_length(Field(formItem, 0)),
1492                              CURLFORM_COPYCONTENTS,
1493                              String_val(Field(formItem, 1)),
1494                              CURLFORM_CONTENTSLENGTH,
1495                              caml_string_length(Field(formItem, 1)),
1496                              CURLFORM_END);
1497             }
1498             else if (Is_block(Field(formItem, 2)))
1499             {
1500                 contentType = Field(formItem, 2);
1501
1502                 curl_formadd(&conn->httpPostFirst,
1503                              &conn->httpPostLast,
1504                              CURLFORM_COPYNAME,
1505                              String_val(Field(formItem, 0)),
1506                              CURLFORM_NAMELENGTH,
1507                              caml_string_length(Field(formItem, 0)),
1508                              CURLFORM_COPYCONTENTS,
1509                              String_val(Field(formItem, 1)),
1510                              CURLFORM_CONTENTSLENGTH,
1511                              caml_string_length(Field(formItem, 1)),
1512                              CURLFORM_CONTENTTYPE,
1513                              String_val(Field(contentType, 0)),
1514                              CURLFORM_END);
1515             }
1516             else
1517             {
1518                 caml_failwith("Incorrect CURLFORM_CONTENT parameters");
1519             }
1520             break;
1521
1522         case 1: /* CURLFORM_FILECONTENT */
1523             if (Wosize_val(formItem) < 3)
1524             {
1525                 caml_failwith("Incorrect CURLFORM_FILECONTENT parameters");
1526             }
1527
1528             if (Is_long(Field(formItem, 2)) &&
1529                 Long_val(Field(formItem, 2)) == 0)
1530             {
1531                 curl_formadd(&conn->httpPostFirst,
1532                              &conn->httpPostLast,
1533                              CURLFORM_COPYNAME,
1534                              String_val(Field(formItem, 0)),
1535                              CURLFORM_NAMELENGTH,
1536                              caml_string_length(Field(formItem, 0)),
1537                              CURLFORM_FILECONTENT,
1538                              String_val(Field(formItem, 1)),
1539                              CURLFORM_END);
1540             }
1541             else if (Is_block(Field(formItem, 2)))
1542             {
1543                 contentType = Field(formItem, 2);
1544
1545                 curl_formadd(&conn->httpPostFirst,
1546                              &conn->httpPostLast,
1547                              CURLFORM_COPYNAME,
1548                              String_val(Field(formItem, 0)),
1549                              CURLFORM_NAMELENGTH,
1550                              caml_string_length(Field(formItem, 0)),
1551                              CURLFORM_FILECONTENT,
1552                              String_val(Field(formItem, 1)),
1553                              CURLFORM_CONTENTTYPE,
1554                              String_val(Field(contentType, 0)),
1555                              CURLFORM_END);
1556             }
1557             else
1558             {
1559                 caml_failwith("Incorrect CURLFORM_FILECONTENT parameters");
1560             }
1561             break;
1562
1563         case 2: /* CURLFORM_FILE */
1564             if (Wosize_val(formItem) < 3)
1565             {
1566                 caml_failwith("Incorrect CURLFORM_FILE parameters");
1567             }
1568
1569             if (Is_long(Field(formItem, 2)) &&
1570                 Long_val(Field(formItem, 2)) == 0)
1571             {
1572                 curl_formadd(&conn->httpPostFirst,
1573                              &conn->httpPostLast,
1574                              CURLFORM_COPYNAME,
1575                              String_val(Field(formItem, 0)),
1576                              CURLFORM_NAMELENGTH,
1577                              caml_string_length(Field(formItem, 0)),
1578                              CURLFORM_FILE,
1579                              String_val(Field(formItem, 1)),
1580                              CURLFORM_END);
1581             }
1582             else if (Is_block(Field(formItem, 2)))
1583             {
1584                 contentType = Field(formItem, 2);
1585
1586                 curl_formadd(&conn->httpPostFirst,
1587                              &conn->httpPostLast,
1588                              CURLFORM_COPYNAME,
1589                              String_val(Field(formItem, 0)),
1590                              CURLFORM_NAMELENGTH,
1591                              caml_string_length(Field(formItem, 0)),
1592                              CURLFORM_FILE,
1593                              String_val(Field(formItem, 1)),
1594                              CURLFORM_CONTENTTYPE,
1595                              String_val(Field(contentType, 0)),
1596                              CURLFORM_END);
1597             }
1598             else
1599             {
1600                 caml_failwith("Incorrect CURLFORM_FILE parameters");
1601             }
1602             break;
1603
1604         case 3: /* CURLFORM_BUFFER */
1605             if (Wosize_val(formItem) < 4)
1606             {
1607                 caml_failwith("Incorrect CURLFORM_BUFFER parameters");
1608             }
1609
1610             if (Is_long(Field(formItem, 3)) &&
1611                 Long_val(Field(formItem, 3)) == 0)
1612             {
1613                 conn->httpPostBuffers = curl_slist_prepend_ml(conn->httpPostBuffers, Field(formItem, 2));
1614
1615                 curl_formadd(&conn->httpPostFirst,
1616                              &conn->httpPostLast,
1617                              CURLFORM_COPYNAME,
1618                              String_val(Field(formItem, 0)),
1619                              CURLFORM_NAMELENGTH,
1620                              caml_string_length(Field(formItem, 0)),
1621                              CURLFORM_BUFFER,
1622                              String_val(Field(formItem, 1)),
1623                              CURLFORM_BUFFERPTR,
1624                              conn->httpPostBuffers->data,
1625                              CURLFORM_BUFFERLENGTH,
1626                              caml_string_length(Field(formItem, 2)),
1627                              CURLFORM_END);
1628             }
1629             else if (Is_block(Field(formItem, 3)))
1630             {
1631                 conn->httpPostBuffers = curl_slist_prepend_ml(conn->httpPostBuffers, Field(formItem, 2));
1632
1633                 contentType = Field(formItem, 3);
1634
1635                 curl_formadd(&conn->httpPostFirst,
1636                              &conn->httpPostLast,
1637                              CURLFORM_COPYNAME,
1638                              String_val(Field(formItem, 0)),
1639                              CURLFORM_NAMELENGTH,
1640                              caml_string_length(Field(formItem, 0)),
1641                              CURLFORM_BUFFER,
1642                              String_val(Field(formItem, 1)),
1643                              CURLFORM_BUFFERPTR,
1644                              conn->httpPostBuffers->data,
1645                              CURLFORM_BUFFERLENGTH,
1646                              caml_string_length(Field(formItem, 2)),
1647                              CURLFORM_CONTENTTYPE,
1648                              String_val(Field(contentType, 0)),
1649                              CURLFORM_END);
1650             }
1651             else
1652             {
1653                 caml_failwith("Incorrect CURLFORM_BUFFER parameters");
1654             }
1655             break;
1656         }
1657
1658         listIter = Field(listIter, 1);
1659     }
1660
1661     result = curl_easy_setopt(conn->handle,
1662                               CURLOPT_HTTPPOST,
1663                               conn->httpPostFirst);
1664
1665     if (result != CURLE_OK)
1666         raiseError(conn, result);
1667
1668     CAMLreturn0;
1669 }
1670
1671 SETOPT_STRING( SSLCERT)
1672 SETOPT_STRING( SSLCERTTYPE)
1673 SETOPT_STRING( SSLCERTPASSWD)
1674 SETOPT_STRING( SSLKEY)
1675 SETOPT_STRING( SSLKEYTYPE)
1676 SETOPT_STRING( SSLKEYPASSWD)
1677 SETOPT_STRING( SSLENGINE)
1678 SETOPT_BOOL( SSLENGINE_DEFAULT)
1679 SETOPT_BOOL( CRLF)
1680
1681 SETOPT_SLIST( QUOTE)
1682 SETOPT_SLIST( POSTQUOTE)
1683
1684 SETOPT_STRING( COOKIEFILE)
1685 #if HAVE_DECL_CURLOPT_CERTINFO
1686 SETOPT_BOOL( CERTINFO)
1687 #endif
1688
1689 #if !defined(CURL_SSLVERSION_TLSv1_0)
1690 #define CURL_SSLVERSION_TLSv1_0 CURL_SSLVERSION_TLSv1
1691 #endif
1692
1693 #if !defined(CURL_SSLVERSION_TLSv1_1)
1694 #define CURL_SSLVERSION_TLSv1_1 CURL_SSLVERSION_TLSv1
1695 #endif
1696
1697 #if !defined(CURL_SSLVERSION_TLSv1_2)
1698 #define CURL_SSLVERSION_TLSv1_2 CURL_SSLVERSION_TLSv1
1699 #endif
1700
1701 #if !defined(CURL_SSLVERSION_TLSv1_3)
1702 #define CURL_SSLVERSION_TLSv1_3 CURL_SSLVERSION_TLSv1
1703 #endif
1704
1705 static void handle_SSLVERSION(Connection *conn, value option)
1706 {
1707     CAMLparam1(option);
1708     CURLcode result = CURLE_OK;
1709     int v = CURL_SSLVERSION_DEFAULT;
1710
1711     switch (Long_val(option))
1712     {
1713     case 0: v = CURL_SSLVERSION_DEFAULT; break;
1714     case 1: v = CURL_SSLVERSION_TLSv1; break;
1715     case 2: v = CURL_SSLVERSION_SSLv2; break;
1716     case 3: v = CURL_SSLVERSION_SSLv3; break;
1717     case 4: v = CURL_SSLVERSION_TLSv1_0; break;
1718     case 5: v = CURL_SSLVERSION_TLSv1_1; break;
1719     case 6: v = CURL_SSLVERSION_TLSv1_2; break;
1720     case 7: v = CURL_SSLVERSION_TLSv1_3; break;
1721     default:
1722         caml_failwith("Invalid SSLVERSION Option");
1723         break;
1724     }
1725
1726     result = curl_easy_setopt(conn->handle, CURLOPT_SSLVERSION, v);
1727
1728     if (result != CURLE_OK)
1729         raiseError(conn, result);
1730
1731     CAMLreturn0;
1732 }
1733
1734 static void handle_TIMECONDITION(Connection *conn, value option)
1735 {
1736     CAMLparam1(option);
1737     CURLcode result = CURLE_OK;
1738     int timecond = CURL_TIMECOND_NONE;
1739
1740     switch (Long_val(option))
1741     {
1742     case 0: timecond = CURL_TIMECOND_NONE; break;
1743     case 1: timecond = CURL_TIMECOND_IFMODSINCE; break;
1744     case 2: timecond = CURL_TIMECOND_IFUNMODSINCE; break;
1745     case 3: timecond = CURL_TIMECOND_LASTMOD; break;
1746     default:
1747         caml_failwith("Invalid TIMECOND Option");
1748         break;
1749     }
1750
1751     result = curl_easy_setopt(conn->handle, CURLOPT_TIMECONDITION, timecond);
1752
1753     if (result != CURLE_OK)
1754         raiseError(conn, result);
1755
1756     CAMLreturn0;
1757 }
1758
1759 SETOPT_VAL( TIMEVALUE, Int32_val)
1760 SETOPT_STRING( CUSTOMREQUEST)
1761 SETOPT_STRING( INTERFACE)
1762
1763 static void handle_KRB4LEVEL(Connection *conn, value option)
1764 {
1765     CAMLparam1(option);
1766     CURLcode result = CURLE_OK;
1767
1768     switch (Long_val(option))
1769     {
1770     case 0: /* KRB4_NONE */
1771         result = curl_easy_setopt(conn->handle,
1772                                   CURLOPT_KRB4LEVEL,
1773                                   NULL);
1774         break;
1775
1776     case 1: /* KRB4_CLEAR */
1777         result = curl_easy_setopt(conn->handle,
1778                                   CURLOPT_KRB4LEVEL,
1779                                   "clear");
1780         break;
1781
1782     case 2: /* KRB4_SAFE */
1783         result = curl_easy_setopt(conn->handle,
1784                                   CURLOPT_KRB4LEVEL,
1785                                   "safe");
1786         break;
1787
1788     case 3: /* KRB4_CONFIDENTIAL */
1789         result = curl_easy_setopt(conn->handle,
1790                                   CURLOPT_KRB4LEVEL,
1791                                   "confidential");
1792         break;
1793
1794     case 4: /* KRB4_PRIVATE */
1795         result = curl_easy_setopt(conn->handle,
1796                                   CURLOPT_KRB4LEVEL,
1797                                   "private");
1798         break;
1799
1800     default:
1801         caml_failwith("Invalid KRB4 Option");
1802         break;
1803     }
1804
1805     if (result != CURLE_OK)
1806         raiseError(conn, result);
1807
1808     CAMLreturn0;
1809 }
1810
1811 SETOPT_BOOL( SSL_VERIFYPEER)
1812 SETOPT_STRING( CAINFO)
1813 SETOPT_STRING( CAPATH)
1814 SETOPT_BOOL( FILETIME)
1815 SETOPT_LONG( MAXREDIRS)
1816 SETOPT_LONG( MAXCONNECTS)
1817
1818 static void handle_CLOSEPOLICY(Connection *conn, value option)
1819 {
1820     CAMLparam1(option);
1821     CURLcode result = CURLE_OK;
1822
1823     switch (Long_val(option))
1824     {
1825     case 0: /* CLOSEPOLICY_OLDEST */
1826         result = curl_easy_setopt(conn->handle,
1827                                   CURLOPT_CLOSEPOLICY,
1828                                   CURLCLOSEPOLICY_OLDEST);
1829         break;
1830
1831     case 1: /* CLOSEPOLICY_LEAST_RECENTLY_USED */
1832         result = curl_easy_setopt(conn->handle,
1833                                   CURLOPT_CLOSEPOLICY,
1834                                   CURLCLOSEPOLICY_LEAST_RECENTLY_USED);
1835         break;
1836
1837     default:
1838         caml_failwith("Invalid CLOSEPOLICY Option");
1839         break;
1840     }
1841
1842     if (result != CURLE_OK)
1843         raiseError(conn, result);
1844
1845     CAMLreturn0;
1846 }
1847
1848 SETOPT_BOOL( FRESH_CONNECT)
1849 SETOPT_BOOL( FORBID_REUSE)
1850 SETOPT_STRING( RANDOM_FILE)
1851 SETOPT_STRING( EGDSOCKET)
1852 SETOPT_LONG( CONNECTTIMEOUT)
1853 SETOPT_BOOL( HTTPGET)
1854
1855 static void handle_SSL_VERIFYHOST(Connection *conn, value option)
1856 {
1857     CAMLparam1(option);
1858     CURLcode result = CURLE_OK;
1859
1860     switch (Long_val(option))
1861     {
1862     case 0: /* SSLVERIFYHOST_NONE */
1863     case 1: /* SSLVERIFYHOST_EXISTENCE */
1864     case 2: /* SSLVERIFYHOST_HOSTNAME */
1865         result = curl_easy_setopt(conn->handle,
1866                                   CURLOPT_SSL_VERIFYHOST,
1867                                   /* map EXISTENCE to HOSTNAME */
1868                                   Long_val(option) == 0 ? 0 : 2);
1869         break;
1870
1871     default:
1872         caml_failwith("Invalid SSLVERIFYHOST Option");
1873         break;
1874     }
1875
1876     if (result != CURLE_OK)
1877         raiseError(conn, result);
1878
1879     CAMLreturn0;
1880 }
1881
1882 SETOPT_STRING( COOKIEJAR)
1883 SETOPT_STRING( SSL_CIPHER_LIST)
1884
1885 static void handle_HTTP_VERSION(Connection *conn, value option)
1886 {
1887     CAMLparam1(option);
1888     CURLcode result = CURLE_OK;
1889
1890     long version = CURL_HTTP_VERSION_NONE;
1891
1892     switch (Long_val(option))
1893     {
1894     case 0: version = CURL_HTTP_VERSION_NONE; break;
1895     case 1: version = CURL_HTTP_VERSION_1_0; break;
1896     case 2: version = CURL_HTTP_VERSION_1_1; break;
1897     case 3:
1898 #if defined(CURL_HTTP_VERSION_2)
1899       version = CURL_HTTP_VERSION_2;
1900 #elif defined(CURL_HTTP_VERSION_2_0)
1901       version = CURL_HTTP_VERSION_2_0;
1902 #endif
1903       break;
1904     case 4:
1905 #if defined(CURL_HTTP_VERSION_2TLS)
1906       version = CURL_HTTP_VERSION_2TLS;
1907 #endif
1908       break;
1909     default:
1910       caml_invalid_argument("CURLOPT_HTTP_VERSION");
1911       break;
1912     }
1913
1914     result = curl_easy_setopt(conn->handle, CURLOPT_HTTP_VERSION, version);
1915
1916     if (result != CURLE_OK)
1917         raiseError(conn, result);
1918
1919     CAMLreturn0;
1920 }
1921
1922 SETOPT_BOOL( FTP_USE_EPSV)
1923 SETOPT_LONG( DNS_CACHE_TIMEOUT)
1924 SETOPT_BOOL( DNS_USE_GLOBAL_CACHE)
1925
1926 static void handle_PRIVATE(Connection *conn, value option)
1927 {
1928     CAMLparam1(option);
1929     Store_field(conn->ocamlValues, Ocaml_PRIVATE, option);
1930     CAMLreturn0;
1931 }
1932
1933 #if HAVE_DECL_CURLOPT_HTTP200ALIASES
1934 SETOPT_SLIST( HTTP200ALIASES)
1935 #endif
1936
1937 #if HAVE_DECL_CURLOPT_UNRESTRICTED_AUTH
1938 SETOPT_BOOL( UNRESTRICTED_AUTH)
1939 #endif
1940
1941 #if HAVE_DECL_CURLOPT_FTP_USE_EPRT
1942 SETOPT_BOOL( FTP_USE_EPRT)
1943 #endif
1944
1945 #if HAVE_DECL_CURLOPT_HTTPAUTH
1946 static void handle_HTTPAUTH(Connection *conn, value option)
1947 {
1948     CAMLparam1(option);
1949     CAMLlocal1(listIter);
1950     CURLcode result = CURLE_OK;
1951     long auth = CURLAUTH_NONE;
1952
1953     listIter = option;
1954
1955     while (!Is_long(listIter))
1956     {
1957         switch (Long_val(Field(listIter, 0)))
1958         {
1959         case 0: /* CURLAUTH_BASIC */
1960             auth |= CURLAUTH_BASIC;
1961             break;
1962
1963         case 1: /* CURLAUTH_DIGEST */
1964             auth |= CURLAUTH_DIGEST;
1965             break;
1966
1967         case 2: /* CURLAUTH_GSSNEGOTIATE */
1968             auth |= CURLAUTH_GSSNEGOTIATE;
1969             break;
1970
1971         case 3: /* CURLAUTH_NTLM */
1972             auth |= CURLAUTH_NTLM;
1973             break;
1974
1975         case 4: /* CURLAUTH_ANY */
1976             auth |= CURLAUTH_ANY;
1977             break;
1978
1979         case 5: /* CURLAUTH_ANYSAFE */
1980             auth |= CURLAUTH_ANYSAFE;
1981             break;
1982
1983         default:
1984             caml_failwith("Invalid HTTPAUTH Value");
1985             break;
1986         }
1987
1988         listIter = Field(listIter, 1);
1989     }
1990
1991     result = curl_easy_setopt(conn->handle,
1992                               CURLOPT_HTTPAUTH,
1993                               auth);
1994
1995     if (result != CURLE_OK)
1996         raiseError(conn, result);
1997
1998     CAMLreturn0;
1999 }
2000 #endif
2001
2002 #if HAVE_DECL_CURLOPT_FTP_CREATE_MISSING_DIRS
2003 SETOPT_BOOL( FTP_CREATE_MISSING_DIRS)
2004 #endif
2005
2006 #if HAVE_DECL_CURLOPT_PROXYAUTH
2007 static void handle_PROXYAUTH(Connection *conn, value option)
2008 {
2009     CAMLparam1(option);
2010     CAMLlocal1(listIter);
2011     CURLcode result = CURLE_OK;
2012     long auth = CURLAUTH_NONE;
2013
2014     listIter = option;
2015
2016     while (!Is_long(listIter))
2017     {
2018         switch (Long_val(Field(listIter, 0)))
2019         {
2020         case 0: /* CURLAUTH_BASIC */
2021             auth |= CURLAUTH_BASIC;
2022             break;
2023
2024         case 1: /* CURLAUTH_DIGEST */
2025             auth |= CURLAUTH_DIGEST;
2026             break;
2027
2028         case 2: /* CURLAUTH_GSSNEGOTIATE */
2029             auth |= CURLAUTH_GSSNEGOTIATE;
2030             break;
2031
2032         case 3: /* CURLAUTH_NTLM */
2033             auth |= CURLAUTH_NTLM;
2034             break;
2035
2036         case 4: /* CURLAUTH_ANY */
2037             auth |= CURLAUTH_ANY;
2038             break;
2039
2040         case 5: /* CURLAUTH_ANYSAFE */
2041             auth |= CURLAUTH_ANYSAFE;
2042             break;
2043
2044         default:
2045             caml_failwith("Invalid HTTPAUTH Value");
2046             break;
2047         }
2048
2049         listIter = Field(listIter, 1);
2050     }
2051
2052     result = curl_easy_setopt(conn->handle,
2053                               CURLOPT_PROXYAUTH,
2054                               auth);
2055
2056     if (result != CURLE_OK)
2057         raiseError(conn, result);
2058
2059     CAMLreturn0;
2060 }
2061 #endif
2062
2063 #if HAVE_DECL_CURLOPT_FTP_RESPONSE_TIMEOUT
2064 SETOPT_LONG( FTP_RESPONSE_TIMEOUT)
2065 #endif
2066
2067 #if HAVE_DECL_CURLOPT_IPRESOLVE
2068 static void handle_IPRESOLVE(Connection *conn, value option)
2069 {
2070     CAMLparam1(option);
2071     CURLcode result = CURLE_OK;
2072
2073     switch (Long_val(option))
2074     {
2075     case 0: /* CURL_IPRESOLVE_WHATEVER */
2076         result = curl_easy_setopt(conn->handle,
2077                                   CURLOPT_IPRESOLVE,
2078                                   CURL_IPRESOLVE_WHATEVER);
2079         break;
2080
2081     case 1: /* CURL_IPRESOLVE_V4 */
2082         result = curl_easy_setopt(conn->handle,
2083                                   CURLOPT_IPRESOLVE,
2084                                   CURL_IPRESOLVE_V4);
2085         break;
2086
2087     case 2: /* CURL_IPRESOLVE_V6 */
2088         result = curl_easy_setopt(conn->handle,
2089                                   CURLOPT_IPRESOLVE,
2090                                   CURL_IPRESOLVE_V6);
2091         break;
2092
2093     default:
2094         caml_failwith("Invalid IPRESOLVE Value");
2095         break;
2096     }
2097
2098     if (result != CURLE_OK)
2099         raiseError(conn, result);
2100
2101     CAMLreturn0;
2102 }
2103 #endif
2104
2105 #if HAVE_DECL_CURLOPT_MAXFILESIZE
2106 SETOPT_VAL( MAXFILESIZE, Int32_val)
2107 #endif
2108
2109 #if HAVE_DECL_CURLOPT_INFILESIZE_LARGE
2110 SETOPT_INT64( INFILESIZE_LARGE)
2111 #endif
2112
2113 #if HAVE_DECL_CURLOPT_RESUME_FROM_LARGE
2114 SETOPT_INT64( RESUME_FROM_LARGE)
2115 #endif
2116
2117 #if HAVE_DECL_CURLOPT_MAXFILESIZE_LARGE
2118 SETOPT_INT64( MAXFILESIZE_LARGE)
2119 #endif
2120
2121 #if HAVE_DECL_CURLOPT_NETRC_FILE
2122 SETOPT_STRING( NETRC_FILE)
2123 #endif
2124
2125 #if HAVE_DECL_CURLOPT_FTP_SSL
2126 static void handle_FTP_SSL(Connection *conn, value option)
2127 {
2128     CAMLparam1(option);
2129     CURLcode result = CURLE_OK;
2130
2131     switch (Long_val(option))
2132     {
2133     case 0: /* CURLFTPSSL_NONE */
2134         result = curl_easy_setopt(conn->handle,
2135                                   CURLOPT_FTP_SSL,
2136                                   CURLFTPSSL_NONE);
2137         break;
2138
2139     case 1: /* CURLFTPSSL_TRY */
2140         result = curl_easy_setopt(conn->handle,
2141                                   CURLOPT_FTP_SSL,
2142                                   CURLFTPSSL_TRY);
2143         break;
2144
2145     case 2: /* CURLFTPSSL_CONTROL */
2146         result = curl_easy_setopt(conn->handle,
2147                                   CURLOPT_FTP_SSL,
2148                                   CURLFTPSSL_CONTROL);
2149         break;
2150
2151     case 3: /* CURLFTPSSL_ALL */
2152         result = curl_easy_setopt(conn->handle,
2153                                   CURLOPT_FTP_SSL,
2154                                   CURLFTPSSL_ALL);
2155         break;
2156
2157     default:
2158         caml_failwith("Invalid FTP_SSL Value");
2159         break;
2160     }
2161
2162     if (result != CURLE_OK)
2163         raiseError(conn, result);
2164
2165     CAMLreturn0;
2166 }
2167 #endif
2168
2169 #if HAVE_DECL_CURLOPT_POSTFIELDSIZE_LARGE
2170 SETOPT_INT64( POSTFIELDSIZE_LARGE)
2171 #endif
2172
2173 #if HAVE_DECL_CURLOPT_TCP_NODELAY
2174 /* not using SETOPT_BOOL here because of TCP_NODELAY defined in winsock.h */
2175 SETOPT_VAL_( handle_TCP_NODELAY, CURLOPT_TCP_NODELAY, Bool_val)
2176 #endif
2177
2178 #if HAVE_DECL_CURLOPT_FTPSSLAUTH
2179 static void handle_FTPSSLAUTH(Connection *conn, value option)
2180 {
2181     CAMLparam1(option);
2182     CURLcode result = CURLE_OK;
2183
2184     switch (Long_val(option))
2185     {
2186     case 0: /* CURLFTPAUTH_DEFAULT */
2187         result = curl_easy_setopt(conn->handle,
2188                                   CURLOPT_FTPSSLAUTH,
2189                                   CURLFTPAUTH_DEFAULT);
2190         break;
2191
2192     case 1: /* CURLFTPAUTH_SSL */
2193         result = curl_easy_setopt(conn->handle,
2194                                   CURLOPT_FTPSSLAUTH,
2195                                   CURLFTPAUTH_SSL);
2196         break;
2197
2198     case 2: /* CURLFTPAUTH_TLS */
2199         result = curl_easy_setopt(conn->handle,
2200                                   CURLOPT_FTPSSLAUTH,
2201                                   CURLFTPAUTH_TLS);
2202         break;
2203
2204     default:
2205         caml_failwith("Invalid FTPSSLAUTH value");
2206         break;
2207     }
2208
2209     if (result != CURLE_OK)
2210         raiseError(conn, result);
2211
2212     CAMLreturn0;
2213 }
2214 #endif
2215
2216 #if HAVE_DECL_CURLOPT_FTP_ACCOUNT
2217 SETOPT_STRING( FTP_ACCOUNT)
2218 #endif
2219
2220 #if HAVE_DECL_CURLOPT_COOKIELIST
2221 SETOPT_STRING( COOKIELIST)
2222 #endif
2223
2224 #if HAVE_DECL_CURLOPT_IGNORE_CONTENT_LENGTH
2225 SETOPT_BOOL( IGNORE_CONTENT_LENGTH)
2226 #endif
2227
2228 #if HAVE_DECL_CURLOPT_FTP_SKIP_PASV_IP
2229 SETOPT_BOOL( FTP_SKIP_PASV_IP)
2230 #endif
2231
2232 #if HAVE_DECL_CURLOPT_FTP_FILEMETHOD
2233 static void handle_FTP_FILEMETHOD(Connection *conn, value option)
2234 {
2235     CAMLparam1(option);
2236     CURLcode result = CURLE_OK;
2237
2238     switch (Long_val(option))
2239     {
2240     case 0: /* CURLFTPMETHOD_DEFAULT */
2241         result = curl_easy_setopt(conn->handle,
2242                                   CURLOPT_FTP_FILEMETHOD,
2243                                   CURLFTPMETHOD_DEFAULT);
2244         break;
2245
2246     case 1: /* CURLFTMETHOD_MULTICWD */
2247         result = curl_easy_setopt(conn->handle,
2248                                   CURLOPT_FTP_FILEMETHOD,
2249                                   CURLFTPMETHOD_MULTICWD);
2250         break;
2251
2252     case 2: /* CURLFTPMETHOD_NOCWD */
2253         result = curl_easy_setopt(conn->handle,
2254                                   CURLOPT_FTP_FILEMETHOD,
2255                                   CURLFTPMETHOD_NOCWD);
2256         break;
2257
2258     case 3: /* CURLFTPMETHOD_SINGLECWD */
2259         result = curl_easy_setopt(conn->handle,
2260                                   CURLOPT_FTP_FILEMETHOD,
2261                                   CURLFTPMETHOD_SINGLECWD);
2262
2263     default:
2264         caml_failwith("Invalid FTP_FILEMETHOD value");
2265         break;
2266     }
2267
2268     if (result != CURLE_OK)
2269         raiseError(conn, result);
2270
2271     CAMLreturn0;
2272 }
2273 #endif
2274
2275 #if HAVE_DECL_CURLOPT_LOCALPORT
2276 SETOPT_LONG( LOCALPORT)
2277 #endif
2278
2279 #if HAVE_DECL_CURLOPT_LOCALPORTRANGE
2280 SETOPT_LONG( LOCALPORTRANGE)
2281 #endif
2282
2283 #if HAVE_DECL_CURLOPT_CONNECT_ONLY
2284 SETOPT_BOOL( CONNECT_ONLY)
2285 #endif
2286
2287 #if HAVE_DECL_CURLOPT_MAX_SEND_SPEED_LARGE
2288 SETOPT_INT64( MAX_SEND_SPEED_LARGE)
2289 #endif
2290
2291 #if HAVE_DECL_CURLOPT_MAX_RECV_SPEED_LARGE
2292 SETOPT_INT64( MAX_RECV_SPEED_LARGE)
2293 #endif
2294
2295 #if HAVE_DECL_CURLOPT_FTP_ALTERNATIVE_TO_USER
2296 SETOPT_STRING( FTP_ALTERNATIVE_TO_USER)
2297 #endif
2298
2299 #if HAVE_DECL_CURLOPT_SSL_SESSIONID_CACHE
2300 SETOPT_BOOL( SSL_SESSIONID_CACHE)
2301 #endif
2302
2303 #if HAVE_DECL_CURLOPT_SSH_AUTH_TYPES
2304 static void handle_SSH_AUTH_TYPES(Connection *conn, value option)
2305 {
2306     CAMLparam1(option);
2307     CAMLlocal1(listIter);
2308     CURLcode result = CURLE_OK;
2309     long authTypes = CURLSSH_AUTH_NONE;
2310
2311     listIter = option;
2312
2313     while (!Is_long(listIter))
2314     {
2315         switch (Long_val(Field(listIter, 0)))
2316         {
2317         case 0: /* CURLSSH_AUTH_ANY */
2318             authTypes |= CURLSSH_AUTH_ANY;
2319             break;
2320
2321         case 1: /* CURLSSH_AUTH_PUBLICKEY */
2322             authTypes |= CURLSSH_AUTH_PUBLICKEY;
2323             break;
2324
2325         case 2: /* CURLSSH_AUTH_PASSWORD */
2326             authTypes |= CURLSSH_AUTH_PASSWORD;
2327             break;
2328
2329         case 3: /* CURLSSH_AUTH_HOST */
2330             authTypes |= CURLSSH_AUTH_HOST;
2331             break;
2332
2333         case 4: /* CURLSSH_AUTH_KEYBOARD */
2334             authTypes |= CURLSSH_AUTH_KEYBOARD;
2335             break;
2336
2337         default:
2338             caml_failwith("Invalid CURLSSH_AUTH_TYPES Value");
2339             break;
2340         }
2341
2342         listIter = Field(listIter, 1);
2343     }
2344
2345     result = curl_easy_setopt(conn->handle,
2346                               CURLOPT_SSH_AUTH_TYPES,
2347                               authTypes);
2348
2349     if (result != CURLE_OK)
2350         raiseError(conn, result);
2351
2352     CAMLreturn0;
2353 }
2354 #endif
2355
2356 #if HAVE_DECL_CURLOPT_SSH_PUBLIC_KEYFILE
2357 SETOPT_STRING( SSH_PUBLIC_KEYFILE)
2358 #endif
2359
2360 #if HAVE_DECL_CURLOPT_SSH_PRIVATE_KEYFILE
2361 SETOPT_STRING( SSH_PRIVATE_KEYFILE)
2362 #endif
2363
2364 #if HAVE_DECL_CURLOPT_FTP_SSL_CCC
2365 static void handle_FTP_SSL_CCC(Connection *conn, value option)
2366 {
2367     CAMLparam1(option);
2368     CURLcode result = CURLE_OK;
2369
2370     switch (Long_val(option))
2371     {
2372     case 0: /* CURLFTPSSL_CCC_NONE */
2373         result = curl_easy_setopt(conn->handle,
2374                                   CURLOPT_FTP_SSL_CCC,
2375                                   CURLFTPSSL_CCC_NONE);
2376         break;
2377
2378     case 1: /* CURLFTPSSL_CCC_PASSIVE */
2379         result = curl_easy_setopt(conn->handle,
2380                                   CURLOPT_FTP_SSL_CCC,
2381                                   CURLFTPSSL_CCC_PASSIVE);
2382         break;
2383
2384     case 2: /* CURLFTPSSL_CCC_ACTIVE */
2385         result = curl_easy_setopt(conn->handle,
2386                                   CURLOPT_FTP_SSL_CCC,
2387                                   CURLFTPSSL_CCC_ACTIVE);
2388         break;
2389
2390     default:
2391         caml_failwith("Invalid FTPSSL_CCC value");
2392         break;
2393     }
2394
2395     if (result != CURLE_OK)
2396         raiseError(conn, result);
2397
2398     CAMLreturn0;
2399 }
2400 #endif
2401
2402 #if HAVE_DECL_CURLOPT_TIMEOUT_MS
2403 SETOPT_LONG( TIMEOUT_MS)
2404 #endif
2405
2406 #if HAVE_DECL_CURLOPT_CONNECTTIMEOUT_MS
2407 SETOPT_LONG( CONNECTTIMEOUT_MS)
2408 #endif
2409
2410 #if HAVE_DECL_CURLOPT_HTTP_TRANSFER_DECODING
2411 SETOPT_BOOL( HTTP_TRANSFER_DECODING)
2412 #endif
2413
2414 #if HAVE_DECL_CURLOPT_HTTP_CONTENT_DECODING
2415 SETOPT_BOOL( HTTP_CONTENT_DECODING)
2416 #endif
2417
2418 #if HAVE_DECL_CURLOPT_NEW_FILE_PERMS
2419 SETOPT_LONG( NEW_FILE_PERMS)
2420 #endif
2421
2422 #if HAVE_DECL_CURLOPT_NEW_DIRECTORY_PERMS
2423 SETOPT_LONG( NEW_DIRECTORY_PERMS)
2424 #endif
2425
2426 #if HAVE_DECL_CURLOPT_POST301
2427 SETOPT_BOOL( POST301)
2428 #endif
2429
2430 #if HAVE_DECL_CURLOPT_SSH_HOST_PUBLIC_KEY_MD5
2431 SETOPT_STRING( SSH_HOST_PUBLIC_KEY_MD5)
2432 #endif
2433
2434 #if HAVE_DECL_CURLOPT_COPYPOSTFIELDS
2435 SETOPT_STRING( COPYPOSTFIELDS)
2436 #endif
2437
2438 #if HAVE_DECL_CURLOPT_PROXY_TRANSFER_MODE
2439 SETOPT_BOOL( PROXY_TRANSFER_MODE)
2440 #endif
2441
2442 #if HAVE_DECL_CURLOPT_AUTOREFERER
2443 SETOPT_BOOL( AUTOREFERER)
2444 #endif
2445
2446 #if HAVE_DECL_CURLOPT_PROXYTYPE
2447 static void handle_PROXYTYPE(Connection *conn, value option)
2448 {
2449     CAMLparam1(option);
2450     CURLcode result = CURLE_OK;
2451     long proxy_type;
2452
2453     switch (Long_val(option))
2454     {
2455       case 0: proxy_type = CURLPROXY_HTTP; break;
2456       case 1: proxy_type = CURLPROXY_HTTP_1_0; break;
2457       case 2: proxy_type = CURLPROXY_SOCKS4; break;
2458       case 3: proxy_type = CURLPROXY_SOCKS5; break;
2459       case 4: proxy_type = CURLPROXY_SOCKS4A; break;
2460       case 5: proxy_type = CURLPROXY_SOCKS5_HOSTNAME; break;
2461       default:
2462         caml_failwith("Invalid curl proxy type");
2463     }
2464
2465     result = curl_easy_setopt(conn->handle,
2466                               CURLOPT_PROXYTYPE,
2467                               proxy_type);
2468
2469     if (result != CURLE_OK)
2470         raiseError(conn, result);
2471
2472     CAMLreturn0;
2473 }
2474 #endif
2475
2476 #if HAVE_DECL_CURLOPT_PROTOCOLS || HAVE_DECL_CURLOPT_REDIR_PROTOCOLS
2477
2478 long protoMap[] =
2479 {
2480   CURLPROTO_ALL,
2481   CURLPROTO_HTTP, CURLPROTO_HTTPS, CURLPROTO_FTP, CURLPROTO_FTPS, CURLPROTO_SCP, CURLPROTO_SFTP,
2482   CURLPROTO_TELNET, CURLPROTO_LDAP, CURLPROTO_LDAPS, CURLPROTO_DICT, CURLPROTO_FILE, CURLPROTO_TFTP,
2483 /* factor out with autoconf? */
2484 #if defined(CURLPROTO_IMAP)
2485   CURLPROTO_IMAP,
2486 #else
2487   0,
2488 #endif
2489 #if defined(CURLPROTO_IMAPS)
2490   CURLPROTO_IMAPS,
2491 #else
2492   0,
2493 #endif
2494 #if defined(CURLPROTO_POP3)
2495   CURLPROTO_POP3,
2496 #else
2497   0,
2498 #endif
2499 #if defined(CURLPROTO_POP3S)
2500   CURLPROTO_POP3S,
2501 #else
2502   0,
2503 #endif
2504 #if defined(CURLPROTO_SMTP)
2505   CURLPROTO_SMTP,
2506 #else
2507   0,
2508 #endif
2509 #if defined(CURLPROTO_SMTPS)
2510   CURLPROTO_SMTPS,
2511 #else
2512   0,
2513 #endif
2514 #if defined(CURLPROTO_RTSP)
2515   CURLPROTO_RTSP,
2516 #else
2517   0,
2518 #endif
2519 #if defined(CURLPROTO_RTMP)
2520   CURLPROTO_RTMP,
2521 #else
2522   0,
2523 #endif
2524 #if defined(CURLPROTO_RTMPT)
2525   CURLPROTO_RTMPT,
2526 #else
2527   0,
2528 #endif
2529 #if defined(CURLPROTO_RTMPE)
2530   CURLPROTO_RTMPE,
2531 #else
2532   0,
2533 #endif
2534 #if defined(CURLPROTO_RTMPTE)
2535   CURLPROTO_RTMPTE,
2536 #else
2537   0,
2538 #endif
2539 #if defined(CURLPROTO_RTMPS)
2540   CURLPROTO_RTMPS,
2541 #else
2542   0,
2543 #endif
2544 #if defined(CURLPROTO_RTMPTS)
2545   CURLPROTO_RTMPTS,
2546 #else
2547   0,
2548 #endif
2549 #if defined(CURLPROTO_GOPHER)
2550   CURLPROTO_GOPHER,
2551 #else
2552   0,
2553 #endif
2554 };
2555
2556 static void handle_PROTOCOLSOPTION(CURLoption curlopt, Connection *conn, value option)
2557 {
2558     CAMLparam1(option);
2559     CURLcode result = CURLE_OK;
2560     long bits = convert_bit_list(protoMap, sizeof(protoMap) / sizeof(protoMap[0]), option);
2561
2562     result = curl_easy_setopt(conn->handle, curlopt, bits);
2563
2564     if (result != CURLE_OK)
2565         raiseError(conn, result);
2566
2567     CAMLreturn0;
2568 }
2569 #endif
2570
2571 #if HAVE_DECL_CURLOPT_PROTOCOLS
2572 static void handle_PROTOCOLS(Connection *conn, value option)
2573 {
2574   handle_PROTOCOLSOPTION(CURLOPT_PROTOCOLS, conn, option);
2575 }
2576 #endif
2577
2578 #if HAVE_DECL_CURLOPT_REDIR_PROTOCOLS
2579 static void handle_REDIR_PROTOCOLS(Connection *conn, value option)
2580 {
2581   handle_PROTOCOLSOPTION(CURLOPT_REDIR_PROTOCOLS, conn, option);
2582 }
2583 #endif
2584
2585 #if HAVE_DECL_CURLOPT_RESOLVE
2586 SETOPT_SLIST( RESOLVE)
2587 #endif
2588
2589 #if HAVE_DECL_CURLOPT_DNS_SERVERS
2590 SETOPT_STRING( DNS_SERVERS)
2591 #endif
2592
2593 #if HAVE_DECL_CURLOPT_MAIL_FROM
2594 SETOPT_STRING( MAIL_FROM)
2595 #endif
2596
2597 #if HAVE_DECL_CURLOPT_MAIL_RCPT
2598 SETOPT_SLIST( MAIL_RCPT)
2599 #endif
2600
2601 #if HAVE_DECL_CURLOPT_PIPEWAIT
2602 SETOPT_BOOL( PIPEWAIT)
2603 #endif
2604
2605 #if HAVE_DECL_CURLOPT_USERNAME
2606 SETOPT_STRING( USERNAME)
2607 #endif
2608
2609 #if HAVE_DECL_CURLOPT_PASSWORD
2610 SETOPT_STRING( PASSWORD)
2611 #endif
2612
2613 /**
2614  **  curl_easy_setopt helper function
2615  **/
2616
2617 #define MAP(name) { handle_ ## name, "CURLOPT_"#name, Ocaml_##name }
2618 #define MAP_NO(name) { NULL, "CURLOPT_"#name , Ocaml_##name }
2619 #define IMM(name) { handle_ ## name, "CURLOPT_"#name, (OcamlValue)(-1) }
2620 #define IMM_NO(name) { NULL, "CURLOPT_"#name , (OcamlValue)(-1) }
2621
2622 CURLOptionMapping implementedOptionMap[] =
2623 {
2624   MAP(WRITEFUNCTION),
2625   MAP(READFUNCTION),
2626   IMM(INFILESIZE),
2627   MAP(URL),
2628   MAP(PROXY),
2629   IMM(PROXYPORT),
2630   IMM(HTTPPROXYTUNNEL),
2631   IMM(VERBOSE),
2632   IMM(HEADER),
2633   IMM(NOPROGRESS),
2634 #if HAVE_DECL_CURLOPT_NOSIGNAL
2635   IMM(NOSIGNAL),
2636 #else
2637   IMM_NO(NOSIGNAL),
2638 #endif
2639   IMM(NOBODY),
2640   IMM(FAILONERROR),
2641   IMM(UPLOAD),
2642   IMM(POST),
2643   IMM(FTPLISTONLY),
2644   IMM(FTPAPPEND),
2645   IMM(NETRC),
2646 #if HAVE_DECL_CURLOPT_ENCODING
2647   IMM(ENCODING),
2648 #else
2649   IMM_NO(ENCODING),
2650 #endif
2651   IMM(FOLLOWLOCATION),
2652   IMM(TRANSFERTEXT),
2653   IMM(PUT),
2654   MAP(USERPWD),
2655   MAP(PROXYUSERPWD),
2656   MAP(RANGE),
2657   IMM(ERRORBUFFER), /* mutable buffer, as output value, do not duplicate */
2658   IMM(TIMEOUT),
2659   MAP(POSTFIELDS),
2660   IMM(POSTFIELDSIZE),
2661   MAP(REFERER),
2662   MAP(USERAGENT),
2663   MAP(FTPPORT),
2664   IMM(LOW_SPEED_LIMIT),
2665   IMM(LOW_SPEED_TIME),
2666   IMM(RESUME_FROM),
2667   MAP(COOKIE),
2668   MAP(HTTPHEADER),
2669   MAP(HTTPPOST),
2670   MAP(SSLCERT),
2671   MAP(SSLCERTTYPE),
2672   MAP(SSLCERTPASSWD),
2673   MAP(SSLKEY),
2674   MAP(SSLKEYTYPE),
2675   MAP(SSLKEYPASSWD),
2676   MAP(SSLENGINE),
2677   IMM(SSLENGINE_DEFAULT),
2678   IMM(CRLF),
2679   MAP(QUOTE),
2680   MAP(POSTQUOTE),
2681   MAP(HEADERFUNCTION),
2682   MAP(COOKIEFILE),
2683   IMM(SSLVERSION),
2684   IMM(TIMECONDITION),
2685   IMM(TIMEVALUE),
2686   MAP(CUSTOMREQUEST),
2687   MAP(INTERFACE),
2688   IMM(KRB4LEVEL),
2689   MAP(PROGRESSFUNCTION),
2690   IMM(SSL_VERIFYPEER),
2691   MAP(CAINFO),
2692   MAP(CAPATH),
2693   IMM(FILETIME),
2694   IMM(MAXREDIRS),
2695   IMM(MAXCONNECTS),
2696   IMM(CLOSEPOLICY),
2697   IMM(FRESH_CONNECT),
2698   IMM(FORBID_REUSE),
2699   MAP(RANDOM_FILE),
2700   MAP(EGDSOCKET),
2701   IMM(CONNECTTIMEOUT),
2702   IMM(HTTPGET),
2703   IMM(SSL_VERIFYHOST),
2704   MAP(COOKIEJAR),
2705   MAP(SSL_CIPHER_LIST),
2706   IMM(HTTP_VERSION),
2707   IMM(FTP_USE_EPSV),
2708   IMM(DNS_CACHE_TIMEOUT),
2709   IMM(DNS_USE_GLOBAL_CACHE),
2710   MAP(DEBUGFUNCTION),
2711   MAP(PRIVATE),
2712 #if HAVE_DECL_CURLOPT_HTTP200ALIASES
2713   MAP(HTTP200ALIASES),
2714 #else
2715   MAP_NO(HTTP200ALIASES),
2716 #endif
2717 #if HAVE_DECL_CURLOPT_UNRESTRICTED_AUTH
2718   IMM(UNRESTRICTED_AUTH),
2719 #else
2720   IMM_NO(UNRESTRICTED_AUTH),
2721 #endif
2722 #if HAVE_DECL_CURLOPT_FTP_USE_EPRT
2723   IMM(FTP_USE_EPRT),
2724 #else
2725   IMM_NO(FTP_USE_EPRT),
2726 #endif
2727 #if HAVE_DECL_CURLOPT_HTTPAUTH
2728   IMM(HTTPAUTH),
2729 #else
2730   IMM_NO(HTTPAUTH),
2731 #endif
2732 #if HAVE_DECL_CURLOPT_FTP_CREATE_MISSING_DIRS
2733   IMM(FTP_CREATE_MISSING_DIRS),
2734 #else
2735   IMM_NO(FTP_CREATE_MISSING_DIRS),
2736 #endif
2737 #if HAVE_DECL_CURLOPT_PROXYAUTH
2738   IMM(PROXYAUTH),
2739 #else
2740   IMM_NO(PROXYAUTH),
2741 #endif
2742 #if HAVE_DECL_CURLOPT_FTP_RESPONSE_TIMEOUT
2743   IMM(FTP_RESPONSE_TIMEOUT),
2744 #else
2745   IMM_NO(FTP_RESPONSE_TIMEOUT),
2746 #endif
2747 #if HAVE_DECL_CURLOPT_IPRESOLVE
2748   IMM(IPRESOLVE),
2749 #else
2750   IMM_NO(IPRESOLVE),
2751 #endif
2752 #if HAVE_DECL_CURLOPT_MAXFILESIZE
2753   IMM(MAXFILESIZE),
2754 #else
2755   IMM_NO(MAXFILESIZE),
2756 #endif
2757 #if HAVE_DECL_CURLOPT_INFILESIZE_LARGE
2758   IMM(INFILESIZE_LARGE),
2759 #else
2760   IMM_NO(INFILESIZE_LARGE),
2761 #endif
2762 #if HAVE_DECL_CURLOPT_RESUME_FROM_LARGE
2763   IMM(RESUME_FROM_LARGE),
2764 #else
2765   IMM_NO(RESUME_FROM_LARGE),
2766 #endif
2767 #if HAVE_DECL_CURLOPT_MAXFILESIZE_LARGE
2768   IMM(MAXFILESIZE_LARGE),
2769 #else
2770   IMM_NO(MAXFILESIZE_LARGE),
2771 #endif
2772 #if HAVE_DECL_CURLOPT_NETRC_FILE
2773   MAP(NETRC_FILE),
2774 #else
2775   MAP_NO(NETRC_FILE),
2776 #endif
2777 #if HAVE_DECL_CURLOPT_FTP_SSL
2778   IMM(FTP_SSL),
2779 #else
2780   IMM_NO(FTP_SSL),
2781 #endif
2782 #if HAVE_DECL_CURLOPT_POSTFIELDSIZE_LARGE
2783   IMM(POSTFIELDSIZE_LARGE),
2784 #else
2785   IMM_NO(POSTFIELDSIZE_LARGE),
2786 #endif
2787 #if HAVE_DECL_CURLOPT_TCP_NODELAY
2788   IMM(TCP_NODELAY),
2789 #else
2790   IMM_NO(TCP_NODELAY),
2791 #endif
2792 #if HAVE_DECL_CURLOPT_FTPSSLAUTH
2793   IMM(FTPSSLAUTH),
2794 #else
2795   IMM_NO(FTPSSLAUTH),
2796 #endif
2797 #if HAVE_DECL_CURLOPT_IOCTLFUNCTION
2798   MAP(IOCTLFUNCTION),
2799 #else
2800   MAP_NO(IOCTLFUNCTION),
2801 #endif
2802 #if HAVE_DECL_CURLOPT_FTP_ACCOUNT
2803   MAP(FTP_ACCOUNT),
2804 #else
2805   MAP_NO(FTP_ACCOUNT),
2806 #endif
2807 #if HAVE_DECL_CURLOPT_COOKIELIST
2808   MAP(COOKIELIST),
2809 #else
2810   MAP_NO(COOKIELIST),
2811 #endif
2812 #if HAVE_DECL_CURLOPT_IGNORE_CONTENT_LENGTH
2813   IMM(IGNORE_CONTENT_LENGTH),
2814 #else
2815   IMM_NO(IGNORE_CONTENT_LENGTH),
2816 #endif
2817 #if HAVE_DECL_CURLOPT_FTP_SKIP_PASV_IP
2818   IMM(FTP_SKIP_PASV_IP),
2819 #else
2820   IMM_NO(FTP_SKIP_PASV_IP),
2821 #endif
2822 #if HAVE_DECL_CURLOPT_FTP_FILEMETHOD
2823   IMM(FTP_FILEMETHOD),
2824 #else
2825   IMM_NO(FTP_FILEMETHOD),
2826 #endif
2827 #if HAVE_DECL_CURLOPT_LOCALPORT
2828   IMM(LOCALPORT),
2829 #else
2830   IMM_NO(LOCALPORT),
2831 #endif
2832 #if HAVE_DECL_CURLOPT_LOCALPORTRANGE
2833   IMM(LOCALPORTRANGE),
2834 #else
2835   IMM_NO(LOCALPORTRANGE),
2836 #endif
2837 #if HAVE_DECL_CURLOPT_CONNECT_ONLY
2838   IMM(CONNECT_ONLY),
2839 #else
2840   IMM_NO(CONNECT_ONLY),
2841 #endif
2842 #if HAVE_DECL_CURLOPT_MAX_SEND_SPEED_LARGE
2843   IMM(MAX_SEND_SPEED_LARGE),
2844 #else
2845   IMM_NO(MAX_SEND_SPEED_LARGE),
2846 #endif
2847 #if HAVE_DECL_CURLOPT_MAX_RECV_SPEED_LARGE
2848   IMM(MAX_RECV_SPEED_LARGE),
2849 #else
2850   IMM_NO(MAX_RECV_SPEED_LARGE),
2851 #endif
2852 #if HAVE_DECL_CURLOPT_FTP_ALTERNATIVE_TO_USER
2853   MAP(FTP_ALTERNATIVE_TO_USER),
2854 #else
2855   MAP_NO(FTP_ALTERNATIVE_TO_USER),
2856 #endif
2857 #if HAVE_DECL_CURLOPT_SSL_SESSIONID_CACHE
2858   IMM(SSL_SESSIONID_CACHE),
2859 #else
2860   IMM_NO(SSL_SESSIONID_CACHE),
2861 #endif
2862 #if HAVE_DECL_CURLOPT_SSH_AUTH_TYPES
2863   IMM(SSH_AUTH_TYPES),
2864 #else
2865   IMM_NO(SSH_AUTH_TYPES),
2866 #endif
2867 #if HAVE_DECL_CURLOPT_SSH_PUBLIC_KEYFILE
2868   MAP(SSH_PUBLIC_KEYFILE),
2869 #else
2870   MAP_NO(SSH_PUBLIC_KEYFILE),
2871 #endif
2872 #if HAVE_DECL_CURLOPT_SSH_PRIVATE_KEYFILE
2873   MAP(SSH_PRIVATE_KEYFILE),
2874 #else
2875   MAP_NO(SSH_PRIVATE_KEYFILE),
2876 #endif
2877 #if HAVE_DECL_CURLOPT_FTP_SSL_CCC
2878   IMM(FTP_SSL_CCC),
2879 #else
2880   IMM_NO(FTP_SSL_CCC),
2881 #endif
2882 #if HAVE_DECL_CURLOPT_TIMEOUT_MS
2883   IMM(TIMEOUT_MS),
2884 #else
2885   IMM_NO(TIMEOUT_MS),
2886 #endif
2887 #if HAVE_DECL_CURLOPT_CONNECTTIMEOUT_MS
2888   IMM(CONNECTTIMEOUT_MS),
2889 #else
2890   IMM_NO(CONNECTTIMEOUT_MS),
2891 #endif
2892 #if HAVE_DECL_CURLOPT_HTTP_TRANSFER_DECODING
2893   IMM(HTTP_TRANSFER_DECODING),
2894 #else
2895   IMM_NO(HTTP_TRANSFER_DECODING),
2896 #endif
2897 #if HAVE_DECL_CURLOPT_HTTP_CONTENT_DECODING
2898   IMM(HTTP_CONTENT_DECODING),
2899 #else
2900   IMM_NO(HTTP_CONTENT_DECODING),
2901 #endif
2902 #if HAVE_DECL_CURLOPT_NEW_FILE_PERMS
2903   IMM(NEW_FILE_PERMS),
2904 #else
2905   IMM_NO(NEW_FILE_PERMS),
2906 #endif
2907 #if HAVE_DECL_CURLOPT_NEW_DIRECTORY_PERMS
2908   IMM(NEW_DIRECTORY_PERMS),
2909 #else
2910   IMM_NO(NEW_DIRECTORY_PERMS),
2911 #endif
2912 #if HAVE_DECL_CURLOPT_POST301
2913   IMM(POST301),
2914 #else
2915   IMM_NO(POST301),
2916 #endif
2917 #if HAVE_DECL_CURLOPT_SSH_HOST_PUBLIC_KEY_MD5
2918   MAP(SSH_HOST_PUBLIC_KEY_MD5),
2919 #else
2920   MAP_NO(SSH_HOST_PUBLIC_KEY_MD5),
2921 #endif
2922 #if HAVE_DECL_CURLOPT_COPYPOSTFIELDS
2923   MAP(COPYPOSTFIELDS),
2924 #else
2925   MAP_NO(COPYPOSTFIELDS),
2926 #endif
2927 #if HAVE_DECL_CURLOPT_PROXY_TRANSFER_MODE
2928   IMM(PROXY_TRANSFER_MODE),
2929 #else
2930   IMM_NO(PROXY_TRANSFER_MODE),
2931 #endif
2932 #if HAVE_DECL_CURLOPT_SEEKFUNCTION
2933   MAP(SEEKFUNCTION),
2934 #else
2935   MAP_NO(SEEKFUNCTION),
2936 #endif
2937 #if HAVE_DECL_CURLOPT_AUTOREFERER
2938   IMM(AUTOREFERER),
2939 #else
2940   IMM_NO(AUTOREFERER),
2941 #endif
2942 #if HAVE_DECL_CURLOPT_OPENSOCKETFUNCTION
2943   MAP(OPENSOCKETFUNCTION),
2944 #else
2945   MAP_NO(OPENSOCKETFUNCTION),
2946 #endif
2947 #if HAVE_DECL_CURLOPT_PROXYTYPE
2948   IMM(PROXYTYPE),
2949 #else
2950   IMM_NO(PROXYTYPE),
2951 #endif
2952 #if HAVE_DECL_CURLOPT_PROTOCOLS
2953   IMM(PROTOCOLS),
2954 #else
2955   IMM_NO(PROTOCOLS),
2956 #endif
2957 #if HAVE_DECL_CURLOPT_REDIR_PROTOCOLS
2958   IMM(REDIR_PROTOCOLS),
2959 #else
2960   IMM_NO(REDIR_PROTOCOLS),
2961 #endif
2962 #if HAVE_DECL_CURLOPT_RESOLVE
2963   MAP(RESOLVE),
2964 #else
2965   MAP_NO(RESOLVE),
2966 #endif
2967 #if HAVE_DECL_CURLOPT_DNS_SERVERS
2968   MAP(DNS_SERVERS),
2969 #else
2970   MAP_NO(DNS_SERVERS),
2971 #endif
2972 #if HAVE_DECL_CURLOPT_MAIL_FROM
2973   MAP(MAIL_FROM),
2974 #else
2975   MAP_NO(MAIL_FROM),
2976 #endif
2977 #if HAVE_DECL_CURLOPT_MAIL_RCPT
2978   MAP(MAIL_RCPT),
2979 #else
2980   MAP_NO(MAIL_RCPT),
2981 #endif
2982 #if HAVE_DECL_CURLOPT_PIPEWAIT
2983   IMM(PIPEWAIT),
2984 #else
2985   IMM_NO(PIPEWAIT),
2986 #endif
2987 #if HAVE_DECL_CURLOPT_CERTINFO
2988   IMM(CERTINFO),
2989 #else
2990   IMM_NO(CERTINFO),
2991 #endif
2992 #if HAVE_DECL_CURLOPT_USERNAME
2993   MAP(USERNAME),
2994 #else
2995   MAP_NO(USERNAME),
2996 #endif
2997 #if HAVE_DECL_CURLOPT_PASSWORD
2998   MAP(PASSWORD),
2999 #else
3000   MAP_NO(PASSWORD),
3001 #endif
3002 };
3003
3004 static Connection *duplicateConnection(Connection *original)
3005 {
3006     Connection *connection = NULL;
3007     CURL* h = NULL;
3008     size_t i = 0;
3009     CURLOptionMapping* self = NULL;
3010
3011     caml_enter_blocking_section();
3012     h  = curl_easy_duphandle(original->handle);
3013     caml_leave_blocking_section();
3014
3015     connection = allocConnection(h);
3016
3017     for (i = 0; i < sizeof(implementedOptionMap)/sizeof(CURLOptionMapping); i++)
3018     {
3019       self = &implementedOptionMap[i];
3020       if (-1 == self->ocamlValue) continue;
3021       if (self->optionHandler && (Field(original->ocamlValues, self->ocamlValue) != Val_unit))
3022       {
3023         self->optionHandler(connection, Field(original->ocamlValues, self->ocamlValue));
3024       }
3025     }
3026
3027     return connection;
3028 }
3029
3030 value helper_curl_easy_setopt(value conn, value option)
3031 {
3032     CAMLparam2(conn, option);
3033     CAMLlocal1(data);
3034     Connection *connection = Connection_val(conn);
3035     CURLOptionMapping* thisOption = NULL;
3036     static value* exception = NULL;
3037
3038     checkConnection(connection);
3039
3040     data = Field(option, 0);
3041
3042     if (Tag_val(option) < sizeof(implementedOptionMap)/sizeof(CURLOptionMapping))
3043     {
3044       thisOption = &implementedOptionMap[Tag_val(option)];
3045       if (thisOption->optionHandler)
3046       {
3047         thisOption->optionHandler(connection, data);
3048       }
3049       else
3050       {
3051         if (NULL == exception)
3052         {
3053           exception = caml_named_value("Curl.NotImplemented");
3054           if (NULL == exception) caml_invalid_argument("Curl.NotImplemented");
3055         }
3056
3057         caml_raise_with_string(*exception, thisOption->name);
3058       }
3059     }
3060     else
3061     {
3062       caml_failwith("Invalid CURLOPT Option");
3063     }
3064
3065     CAMLreturn(Val_unit);
3066 }
3067
3068 /**
3069  **  curl_easy_perform helper function
3070  **/
3071
3072 value helper_curl_easy_perform(value conn)
3073 {
3074     CAMLparam1(conn);
3075     CURLcode result = CURLE_OK;
3076     Connection *connection = Connection_val(conn);
3077
3078     checkConnection(connection);
3079
3080     caml_enter_blocking_section();
3081     result = curl_easy_perform(connection->handle);
3082     caml_leave_blocking_section();
3083
3084     if (result != CURLE_OK)
3085         raiseError(connection, result);
3086
3087     CAMLreturn(Val_unit);
3088 }
3089
3090 /**
3091  **  curl_easy_cleanup helper function
3092  **/
3093
3094 value helper_curl_easy_cleanup(value conn)
3095 {
3096     CAMLparam1(conn);
3097     Connection *connection = Connection_val(conn);
3098
3099     checkConnection(connection);
3100
3101     removeConnection(connection, 0);
3102
3103     CAMLreturn(Val_unit);
3104 }
3105
3106 /**
3107  **  curl_easy_duphandle helper function
3108  **/
3109
3110 value helper_curl_easy_duphandle(value conn)
3111 {
3112     CAMLparam1(conn);
3113     CAMLlocal1(result);
3114     Connection *connection = Connection_val(conn);
3115
3116     checkConnection(connection);
3117
3118     result = caml_curl_alloc(duplicateConnection(connection));
3119
3120     CAMLreturn(result);
3121 }
3122
3123 /**
3124  **  curl_easy_getinfo helper function
3125  **/
3126
3127 enum GetInfoResultType {
3128     StringValue, LongValue, DoubleValue, StringListValue, StringListListValue,
3129     OCamlValue, /* keep last - no matching OCaml CURLINFO_ constructor */
3130 };
3131
3132 value convertStringList(struct curl_slist *p)
3133 {
3134     CAMLparam0();
3135     CAMLlocal3(result, current, next);
3136
3137     result = Val_emptylist;
3138     current = Val_emptylist;
3139     next = Val_emptylist;
3140
3141     while (p != NULL)
3142     {
3143         next = caml_alloc_tuple(2);
3144         Store_field(next, 0, caml_copy_string(p->data));
3145         Store_field(next, 1, Val_emptylist);
3146
3147         if (result == Val_emptylist)
3148             result = next;
3149
3150         if (current != Val_emptylist)
3151           Store_field(current, 1, next);
3152
3153         current = next;
3154
3155         p = p->next;
3156     }
3157
3158     CAMLreturn(result);
3159 }
3160
3161 value helper_curl_easy_getinfo(value conn, value option)
3162 {
3163     CAMLparam2(conn, option);
3164     CAMLlocal3(result, current, next);
3165     CURLcode curlResult;
3166     Connection *connection = Connection_val(conn);
3167     enum GetInfoResultType resultType;
3168     char *strValue = NULL;
3169     double doubleValue;
3170     long longValue;
3171     struct curl_slist *stringListValue = NULL;
3172 #if HAVE_DECL_CURLINFO_CERTINFO
3173     int i;
3174     union {
3175       struct curl_slist    *to_info;
3176       struct curl_certinfo *to_certinfo;
3177     } ptr;
3178 #endif
3179
3180     checkConnection(connection);
3181
3182     switch(Long_val(option))
3183     {
3184 #if HAVE_DECL_CURLINFO_EFFECTIVE_URL
3185     case 0: /* CURLINFO_EFFECTIVE_URL */
3186         resultType = StringValue;
3187
3188         curlResult = curl_easy_getinfo(connection->handle,
3189                                        CURLINFO_EFFECTIVE_URL,
3190                                        &strValue);
3191         break;
3192 #else
3193 #pragma message("libcurl does not provide CURLINFO_EFFECTIVE_URL")
3194 #endif
3195
3196 #if HAVE_DECL_CURLINFO_RESPONSE_CODE || HAVE_DECL_CURLINFO_HTTP_CODE
3197     case 1: /* CURLINFO_HTTP_CODE */
3198     case 2: /* CURLINFO_RESPONSE_CODE */
3199 #if HAVE_DECL_CURLINFO_RESPONSE_CODE
3200         resultType = LongValue;
3201
3202         curlResult = curl_easy_getinfo(connection->handle,
3203                                        CURLINFO_RESPONSE_CODE,
3204                                        &longValue);
3205 #else
3206         resultType = LongValue;
3207
3208         curlResult = curl_easy_getinfo(connection->handle,
3209                                        CURLINFO_HTTP_CODE,
3210                                        &longValue);
3211 #endif
3212         break;
3213 #endif
3214
3215 #if HAVE_DECL_CURLINFO_TOTAL_TIME
3216     case 3: /* CURLINFO_TOTAL_TIME */
3217         resultType = DoubleValue;
3218
3219         curlResult = curl_easy_getinfo(connection->handle,
3220                                        CURLINFO_TOTAL_TIME,
3221                                        &doubleValue);
3222         break;
3223 #endif
3224
3225 #if HAVE_DECL_CURLINFO_NAMELOOKUP_TIME
3226     case 4: /* CURLINFO_NAMELOOKUP_TIME */
3227         resultType = DoubleValue;
3228
3229         curlResult = curl_easy_getinfo(connection->handle,
3230                                        CURLINFO_NAMELOOKUP_TIME,
3231                                        &doubleValue);
3232         break;
3233 #endif
3234
3235 #if HAVE_DECL_CURLINFO_CONNECT_TIME
3236     case 5: /* CURLINFO_CONNECT_TIME */
3237         resultType = DoubleValue;
3238
3239         curlResult = curl_easy_getinfo(connection->handle,
3240                                        CURLINFO_CONNECT_TIME,
3241                                        &doubleValue);
3242         break;
3243 #endif
3244
3245 #if HAVE_DECL_CURLINFO_PRETRANSFER_TIME
3246     case 6: /* CURLINFO_PRETRANSFER_TIME */
3247         resultType = DoubleValue;
3248
3249         curlResult = curl_easy_getinfo(connection->handle,
3250                                        CURLINFO_PRETRANSFER_TIME,
3251                                        &doubleValue);
3252         break;
3253 #endif
3254
3255 #if HAVE_DECL_CURLINFO_SIZE_UPLOAD
3256     case 7: /* CURLINFO_SIZE_UPLOAD */
3257         resultType = DoubleValue;
3258
3259         curlResult = curl_easy_getinfo(connection->handle,
3260                                        CURLINFO_SIZE_UPLOAD,
3261                                        &doubleValue);
3262         break;
3263 #endif
3264
3265 #if HAVE_DECL_CURLINFO_SIZE_DOWNLOAD
3266     case 8: /* CURLINFO_SIZE_DOWNLOAD */
3267         resultType = DoubleValue;
3268
3269         curlResult = curl_easy_getinfo(connection->handle,
3270                                        CURLINFO_SIZE_DOWNLOAD,
3271                                        &doubleValue);
3272         break;
3273 #endif
3274
3275 #if HAVE_DECL_CURLINFO_SPEED_DOWNLOAD
3276     case 9: /* CURLINFO_SPEED_DOWNLOAD */
3277         resultType = DoubleValue;
3278
3279         curlResult = curl_easy_getinfo(connection->handle,
3280                                        CURLINFO_SPEED_DOWNLOAD,
3281                                        &doubleValue);
3282         break;
3283 #endif
3284
3285 #if HAVE_DECL_CURLINFO_SPEED_UPLOAD
3286     case 10: /* CURLINFO_SPEED_UPLOAD */
3287         resultType = DoubleValue;
3288
3289         curlResult = curl_easy_getinfo(connection->handle,
3290                                        CURLINFO_SPEED_UPLOAD,
3291                                        &doubleValue);
3292         break;
3293
3294 #endif
3295
3296 #if HAVE_DECL_CURLINFO_HEADER_SIZE
3297     case 11: /* CURLINFO_HEADER_SIZE */
3298         resultType = LongValue;
3299
3300         curlResult = curl_easy_getinfo(connection->handle,
3301                                        CURLINFO_HEADER_SIZE,
3302                                        &longValue);
3303         break;
3304 #endif
3305
3306 #if HAVE_DECL_CURLINFO_REQUEST_SIZE
3307     case 12: /* CURLINFO_REQUEST_SIZE */
3308         resultType = LongValue;
3309
3310         curlResult = curl_easy_getinfo(connection->handle,
3311                                        CURLINFO_REQUEST_SIZE,
3312                                        &longValue);
3313         break;
3314 #endif
3315
3316 #if HAVE_DECL_CURLINFO_SSL_VERIFYRESULT
3317     case 13: /* CURLINFO_SSL_VERIFYRESULT */
3318         resultType = LongValue;
3319
3320         curlResult = curl_easy_getinfo(connection->handle,
3321                                        CURLINFO_SSL_VERIFYRESULT,
3322                                        &longValue);
3323         break;
3324 #endif
3325
3326 #if HAVE_DECL_CURLINFO_FILETIME
3327     case 14: /* CURLINFO_FILETIME */
3328         resultType = DoubleValue;
3329
3330         curlResult = curl_easy_getinfo(connection->handle,
3331                                        CURLINFO_FILETIME,
3332                                        &longValue);
3333
3334         doubleValue = longValue;
3335         break;
3336 #endif
3337
3338 #if HAVE_DECL_CURLINFO_CONTENT_LENGTH_DOWNLOAD
3339     case 15: /* CURLINFO_CONTENT_LENGTH_DOWNLOAD */
3340         resultType = DoubleValue;
3341
3342         curlResult = curl_easy_getinfo(connection->handle,
3343                                        CURLINFO_CONTENT_LENGTH_DOWNLOAD,
3344                                        &doubleValue);
3345         break;
3346 #endif
3347
3348 #if HAVE_DECL_CURLINFO_CONTENT_LENGTH_UPLOAD
3349     case 16: /* CURLINFO_CONTENT_LENGTH_UPLOAD */
3350         resultType = DoubleValue;
3351
3352         curlResult = curl_easy_getinfo(connection->handle,
3353                                        CURLINFO_CONTENT_LENGTH_UPLOAD,
3354                                        &doubleValue);
3355         break;
3356 #endif
3357
3358 #if HAVE_DECL_CURLINFO_STARTTRANSFER_TIME
3359     case 17: /* CURLINFO_STARTTRANSFER_TIME */
3360         resultType = DoubleValue;
3361
3362         curlResult = curl_easy_getinfo(connection->handle,
3363                                        CURLINFO_STARTTRANSFER_TIME,
3364                                        &doubleValue);
3365         break;
3366 #endif
3367
3368 #if HAVE_DECL_CURLINFO_CONTENT_TYPE
3369     case 18: /* CURLINFO_CONTENT_TYPE */
3370         resultType = StringValue;
3371
3372         curlResult = curl_easy_getinfo(connection->handle,
3373                                        CURLINFO_CONTENT_TYPE,
3374                                        &strValue);
3375         break;
3376 #endif
3377
3378 #if HAVE_DECL_CURLINFO_REDIRECT_TIME
3379     case 19: /* CURLINFO_REDIRECT_TIME */
3380         resultType = DoubleValue;
3381
3382         curlResult = curl_easy_getinfo(connection->handle,
3383                                        CURLINFO_REDIRECT_TIME,
3384                                        &doubleValue);
3385         break;
3386 #endif
3387
3388 #if HAVE_DECL_CURLINFO_REDIRECT_COUNT
3389     case 20: /* CURLINFO_REDIRECT_COUNT */
3390         resultType = LongValue;
3391
3392         curlResult = curl_easy_getinfo(connection->handle,
3393                                        CURLINFO_REDIRECT_COUNT,
3394                                        &longValue);
3395         break;
3396 #endif
3397
3398     case 21: /* CURLINFO_PRIVATE */
3399         resultType = OCamlValue;
3400         curlResult = CURLE_OK;
3401         result = caml_alloc(1, StringValue);
3402         Store_field(result, 0, Field(connection->ocamlValues, Ocaml_PRIVATE));
3403         break;
3404
3405 #if HAVE_DECL_CURLINFO_HTTP_CONNECTCODE
3406     case 22: /* CURLINFO_HTTP_CONNECTCODE */
3407         resultType = LongValue;
3408
3409         curlResult = curl_easy_getinfo(connection->handle,
3410                                        CURLINFO_HTTP_CONNECTCODE,
3411                                        &longValue);
3412         break;
3413 #endif
3414
3415 #if HAVE_DECL_CURLINFO_HTTPAUTH_AVAIL
3416     case 23: /* CURLINFO_HTTPAUTH_AVAIL */
3417         resultType = LongValue;
3418
3419         curlResult = curl_easy_getinfo(connection->handle,
3420                                        CURLINFO_HTTPAUTH_AVAIL,
3421                                        &longValue);
3422         break;
3423 #endif
3424
3425 #if HAVE_DECL_CURLINFO_PROXYAUTH_AVAIL
3426     case 24: /* CURLINFO_PROXYAUTH_AVAIL */
3427         resultType = LongValue;
3428
3429         curlResult = curl_easy_getinfo(connection->handle,
3430                                        CURLINFO_PROXYAUTH_AVAIL,
3431                                        &longValue);
3432         break;
3433 #endif
3434
3435 #if HAVE_DECL_CURLINFO_OS_ERRNO
3436     case 25: /* CURLINFO_OS_ERRNO */
3437         resultType = LongValue;
3438
3439         curlResult = curl_easy_getinfo(connection->handle,
3440                                        CURLINFO_OS_ERRNO,
3441                                        &longValue);
3442         break;
3443 #endif
3444
3445 #if HAVE_DECL_CURLINFO_NUM_CONNECTS
3446     case 26: /* CURLINFO_NUM_CONNECTS */
3447         resultType = LongValue;
3448
3449         curlResult = curl_easy_getinfo(connection->handle,
3450                                        CURLINFO_NUM_CONNECTS,
3451                                        &longValue);
3452         break;
3453 #endif
3454
3455 #if HAVE_DECL_CURLINFO_SSL_ENGINES
3456     case 27: /* CURLINFO_SSL_ENGINES */
3457         resultType = StringListValue;
3458
3459         curlResult = curl_easy_getinfo(connection->handle,
3460                                        CURLINFO_SSL_ENGINES,
3461                                        &stringListValue);
3462         break;
3463 #endif
3464
3465 #if HAVE_DECL_CURLINFO_COOKIELIST
3466     case 28: /* CURLINFO_COOKIELIST */
3467         resultType = StringListValue;
3468
3469         curlResult = curl_easy_getinfo(connection->handle,
3470                                        CURLINFO_COOKIELIST,
3471                                        &stringListValue);
3472         break;
3473 #endif
3474
3475 #if HAVE_DECL_CURLINFO_LASTSOCKET
3476     case 29: /* CURLINFO_LASTSOCKET */
3477         resultType = LongValue;
3478
3479         curlResult = curl_easy_getinfo(connection->handle,
3480                                        CURLINFO_LASTSOCKET,
3481                                        &longValue);
3482         break;
3483 #endif
3484
3485 #if HAVE_DECL_CURLINFO_FTP_ENTRY_PATH
3486     case 30: /* CURLINFO_FTP_ENTRY_PATH */
3487         resultType = StringValue;
3488
3489         curlResult = curl_easy_getinfo(connection->handle,
3490                                        CURLINFO_FTP_ENTRY_PATH,
3491                                        &strValue);
3492         break;
3493 #endif
3494
3495 #if HAVE_DECL_CURLINFO_REDIRECT_URL
3496     case 31: /* CURLINFO_REDIRECT_URL */
3497         resultType = StringValue;
3498
3499         curlResult = curl_easy_getinfo(connection->handle,
3500                                        CURLINFO_REDIRECT_URL,
3501                                        &strValue);
3502         break;
3503 #else
3504 #pragma message("libcurl does not provide CURLINFO_REDIRECT_URL")
3505 #endif
3506
3507 #if HAVE_DECL_CURLINFO_PRIMARY_IP
3508     case 32: /* CURLINFO_PRIMARY_IP */
3509         resultType = StringValue;
3510
3511         curlResult = curl_easy_getinfo(connection->handle,
3512                                        CURLINFO_PRIMARY_IP,
3513                                        &strValue);
3514         break;
3515 #else
3516 #pragma message("libcurl does not provide CURLINFO_PRIMARY_IP")
3517 #endif
3518
3519 #if HAVE_DECL_CURLINFO_LOCAL_IP
3520     case 33: /* CURLINFO_LOCAL_IP */
3521         resultType = StringValue;
3522
3523         curlResult = curl_easy_getinfo(connection->handle,
3524                                        CURLINFO_LOCAL_IP,
3525                                        &strValue);
3526         break;
3527 #else
3528 #pragma message("libcurl does not provide CURLINFO_LOCAL_IP")
3529 #endif
3530
3531 #if HAVE_DECL_CURLINFO_LOCAL_PORT
3532     case 34: /* CURLINFO_LOCAL_PORT */
3533         resultType = LongValue;
3534
3535         curlResult = curl_easy_getinfo(connection->handle,
3536                                        CURLINFO_LOCAL_PORT,
3537                                        &longValue);
3538         break;
3539 #else
3540 #pragma message("libcurl does not provide CURLINFO_LOCAL_PORT")
3541 #endif
3542
3543 #if HAVE_DECL_CURLINFO_CONDITION_UNMET
3544     case 35: /* CURLINFO_CONDITION_UNMET */
3545         resultType = LongValue;
3546
3547         curlResult = curl_easy_getinfo(connection->handle,
3548                                        CURLINFO_CONDITION_UNMET,
3549                                        &longValue);
3550         break;
3551 #else
3552 #pragma message("libcurl does not provide CURLINFO_CONDITION_UNMET")
3553 #endif
3554 #if HAVE_DECL_CURLINFO_CERTINFO
3555     case 36: /* CURLINFO_CERTINFO */
3556         resultType = StringListListValue;
3557         ptr.to_info = NULL;
3558         curlResult = curl_easy_getinfo(connection->handle,
3559                                        CURLINFO_CERTINFO,
3560                                        &ptr.to_info);
3561
3562         result = Val_emptylist;
3563         current = Val_emptylist;
3564         next = Val_emptylist;
3565
3566         if (curlResult != CURLE_OK || !ptr.to_info)
3567           break;
3568
3569         for (i = 0; i < ptr.to_certinfo->num_of_certs; i++) {
3570           next = caml_alloc_tuple(2);
3571           Store_field(next, 0, convertStringList(ptr.to_certinfo->certinfo[i]));
3572           Store_field(next, 1, current);
3573           current = next;
3574         }
3575         break;
3576 #else
3577 #pragma message("libcurl does not provide CURLINFO_CERTINFO")
3578 #endif
3579     default:
3580         caml_failwith("Invalid CURLINFO Option");
3581         break;
3582     }
3583
3584     if (curlResult != CURLE_OK)
3585         raiseError(connection, curlResult);
3586
3587     switch (resultType)
3588     {
3589     case StringValue:
3590         result = caml_alloc(1, StringValue);
3591         Store_field(result, 0, caml_copy_string(strValue?strValue:""));
3592         break;
3593
3594     case LongValue:
3595         result = caml_alloc(1, LongValue);
3596         Store_field(result, 0, Val_long(longValue));
3597         break;
3598
3599     case DoubleValue:
3600         result = caml_alloc(1, DoubleValue);
3601         Store_field(result, 0, caml_copy_double(doubleValue));
3602         break;
3603
3604     case StringListValue:
3605         result = caml_alloc(1, StringListValue);
3606         Store_field(result, 0, convertStringList(stringListValue));
3607         curl_slist_free_all(stringListValue);
3608         break;
3609
3610     case StringListListValue:
3611         result = caml_alloc(1, StringListListValue);
3612         Store_field(result, 0, current);
3613         break;
3614
3615     case OCamlValue:
3616         break;
3617     }
3618
3619     CAMLreturn(result);
3620 }
3621
3622 /**
3623  **  curl_escape helper function
3624  **/
3625
3626 value helper_curl_escape(value str)
3627 {
3628     CAMLparam1(str);
3629     CAMLlocal1(result);
3630     char *curlResult;
3631
3632     curlResult = curl_escape(String_val(str), caml_string_length(str));
3633     result = caml_copy_string(curlResult);
3634     free(curlResult);
3635
3636     CAMLreturn(result);
3637 }
3638
3639 /**
3640  **  curl_unescape helper function
3641  **/
3642
3643 value helper_curl_unescape(value str)
3644 {
3645     CAMLparam1(str);
3646     CAMLlocal1(result);
3647     char *curlResult;
3648
3649     curlResult = curl_unescape(String_val(str), caml_string_length(str));
3650     result = caml_copy_string(curlResult);
3651     free(curlResult);
3652
3653     CAMLreturn(result);
3654 }
3655
3656 /**
3657  **  curl_getdate helper function
3658  **/
3659
3660 value helper_curl_getdate(value str, value now)
3661 {
3662     CAMLparam2(str, now);
3663     CAMLlocal1(result);
3664     time_t curlResult;
3665     time_t curlNow;
3666
3667     curlNow = (time_t)Double_val(now);
3668     curlResult = curl_getdate(String_val(str), &curlNow);
3669     result = caml_copy_double((double)curlResult);
3670
3671     CAMLreturn(result);
3672 }
3673
3674 /**
3675  **  curl_version helper function
3676  **/
3677
3678 value helper_curl_version(void)
3679 {
3680     CAMLparam0();
3681     CAMLlocal1(result);
3682     char *str;
3683
3684     str = curl_version();
3685     result = caml_copy_string(str);
3686
3687     CAMLreturn(result);
3688 }
3689
3690 struct CURLVersionBitsMapping
3691 {
3692     int code;
3693     char *name;
3694 };
3695
3696 struct CURLVersionBitsMapping versionBitsMap[] =
3697 {
3698     {CURL_VERSION_IPV6, "ipv6"},
3699     {CURL_VERSION_KERBEROS4, "kerberos4"},
3700     {CURL_VERSION_SSL, "ssl"},
3701     {CURL_VERSION_LIBZ, "libz"},
3702     {CURL_VERSION_NTLM, "ntlm"},
3703     {CURL_VERSION_GSSNEGOTIATE, "gssnegotiate"},
3704     {CURL_VERSION_DEBUG, "debug"},
3705     {CURL_VERSION_CURLDEBUG, "curldebug"},
3706     {CURL_VERSION_ASYNCHDNS, "asynchdns"},
3707     {CURL_VERSION_SPNEGO, "spnego"},
3708     {CURL_VERSION_LARGEFILE, "largefile"},
3709     {CURL_VERSION_IDN, "idn"},
3710     {CURL_VERSION_SSPI, "sspi"},
3711     {CURL_VERSION_CONV, "conv"},
3712 #if HAVE_DECL_CURL_VERSION_TLSAUTH_SRP
3713     {CURL_VERSION_TLSAUTH_SRP, "srp"},
3714 #endif
3715 #if HAVE_DECL_CURL_VERSION_NTLM_WB
3716     {CURL_VERSION_NTLM_WB, "wb"},
3717 #endif
3718 };
3719
3720 value caml_curl_version_info(value unit)
3721 {
3722   CAMLparam1(unit);
3723   CAMLlocal4(v, vlist, vnum, vfeatures);
3724   const char* const* p = NULL;
3725   size_t i = 0;
3726
3727   curl_version_info_data* data = curl_version_info(CURLVERSION_NOW);
3728   if (NULL == data) caml_failwith("curl_version_info");
3729
3730   vlist = Val_emptylist;
3731   for (p = data->protocols; NULL != *p; p++)
3732   {
3733     vlist = Val_cons(vlist, caml_copy_string(*p));
3734   }
3735
3736   vfeatures = Val_emptylist;
3737   for (i = 0; i < sizeof(versionBitsMap)/sizeof(versionBitsMap[0]); i++)
3738   {
3739     if (0 != (versionBitsMap[i].code & data->features))
3740       vfeatures = Val_cons(vfeatures, caml_copy_string(versionBitsMap[i].name));
3741   }
3742
3743   vnum = caml_alloc_tuple(3);
3744   Store_field(vnum,0,Val_int(0xFF & (data->version_num >> 16)));
3745   Store_field(vnum,1,Val_int(0xFF & (data->version_num >> 8)));
3746   Store_field(vnum,2,Val_int(0xFF & (data->version_num)));
3747
3748   v = caml_alloc_tuple(12);
3749   Store_field(v,0,caml_copy_string(data->version));
3750   Store_field(v,1,vnum);
3751   Store_field(v,2,caml_copy_string(data->host));
3752   Store_field(v,3,vfeatures);
3753   Store_field(v,4,data->ssl_version ? Val_some(caml_copy_string(data->ssl_version)) : Val_none);
3754   Store_field(v,5,data->libz_version ? Val_some(caml_copy_string(data->libz_version)) : Val_none);
3755   Store_field(v,6,vlist);
3756   Store_field(v,7,caml_copy_string((data->age >= 1 && data->ares) ? data->ares : ""));
3757   Store_field(v,8,Val_int((data->age >= 1) ? data->ares_num : 0));
3758   Store_field(v,9,caml_copy_string((data->age >= 2 && data->libidn) ? data->libidn : ""));
3759   Store_field(v,10,Val_int((data->age >= 3) ? data->iconv_ver_num : 0));
3760   Store_field(v,11,caml_copy_string((data->age >= 3 && data->libssh_version) ? data->libssh_version : ""));
3761
3762   CAMLreturn(v);
3763 }
3764
3765 value caml_curl_pause(value conn, value opts)
3766 {
3767   CAMLparam2(conn, opts);
3768   CAMLlocal4(v, vlist, vnum, vfeatures);
3769   Connection *connection = Connection_val(conn);
3770   int bitmask = 0;
3771   CURLcode result;
3772
3773   while (Val_emptylist != opts)
3774   {
3775     switch (Int_val(Field(opts,0)))
3776     {
3777       case 0: bitmask |= CURLPAUSE_SEND; break;
3778       case 1: bitmask |= CURLPAUSE_RECV; break;
3779       case 2: bitmask |= CURLPAUSE_ALL; break;
3780       default: caml_failwith("wrong pauseOption");
3781     }
3782     opts = Field(opts,1);
3783   }
3784
3785   result = curl_easy_pause(connection->handle,bitmask);
3786   if (result != CURLE_OK)
3787     raiseError(connection, result);
3788
3789   CAMLreturn(Val_unit);
3790 }
3791
3792 /*
3793  * Curl multi stack support
3794  *
3795  * Exported thin wrappers for libcurl are prefixed with caml_curl_multi_.
3796  * Other exported functions are prefixed with caml_curlm_, some of them
3797  * can/should be decomposed into smaller parts.
3798  */
3799
3800 struct ml_multi_handle
3801 {
3802   CURLM* handle;
3803   value values; /* callbacks */
3804 };
3805
3806 enum
3807 {
3808   curlmopt_socket_function,
3809   curlmopt_timer_function,
3810
3811   /* last, not used */
3812   multi_values_total
3813 };
3814
3815 typedef struct ml_multi_handle ml_multi_handle;
3816
3817 #define Multi_val(v) (*(ml_multi_handle**)Data_custom_val(v))
3818 #define CURLM_val(v) (Multi_val(v)->handle)
3819
3820 static struct custom_operations curl_multi_ops = {
3821   "ygrek.curl_multi",
3822   custom_finalize_default,
3823   custom_compare_default,
3824   custom_hash_default,
3825   custom_serialize_default,
3826   custom_deserialize_default,
3827 #if defined(custom_compare_ext_default)
3828   custom_compare_ext_default,
3829 #endif
3830 };
3831
3832 value caml_curl_multi_init(value unit)
3833 {
3834   CAMLparam1(unit);
3835   CAMLlocal1(v);
3836   ml_multi_handle* multi = (ml_multi_handle*)caml_stat_alloc(sizeof(ml_multi_handle));
3837   CURLM* h = curl_multi_init();
3838
3839   if (!h)
3840   {
3841     caml_stat_free(multi);
3842     caml_failwith("caml_curl_multi_init");
3843   }
3844
3845   multi->handle = h;
3846   multi->values = caml_alloc(multi_values_total, 0);
3847   caml_register_generational_global_root(&multi->values);
3848
3849   v = caml_alloc_custom(&curl_multi_ops, sizeof(ml_multi_handle*), 0, 1);
3850   Multi_val(v) = multi;
3851
3852   CAMLreturn(v);
3853 }
3854
3855 value caml_curl_multi_cleanup(value handle)
3856 {
3857   CAMLparam1(handle);
3858   ml_multi_handle* h = Multi_val(handle);
3859
3860   if (NULL == h)
3861     CAMLreturn(Val_unit);
3862
3863   caml_remove_generational_global_root(&h->values);
3864
3865   if (CURLM_OK != curl_multi_cleanup(h->handle))
3866     caml_failwith("caml_curl_multi_cleanup");
3867
3868   caml_stat_free(h);
3869   Multi_val(handle) = (ml_multi_handle*)NULL;
3870
3871   CAMLreturn(Val_unit);
3872 }
3873
3874 static CURL* curlm_remove_finished(CURLM* multi_handle, CURLcode* result)
3875 {
3876   int msgs_in_queue = 0;
3877
3878   while (1)
3879   {
3880     CURLMsg* msg = curl_multi_info_read(multi_handle, &msgs_in_queue);
3881     if (NULL == msg) return NULL;
3882     if (CURLMSG_DONE == msg->msg)
3883     {
3884       CURL* easy_handle = msg->easy_handle;
3885       if (result) *result = msg->data.result;
3886       if (CURLM_OK != curl_multi_remove_handle(multi_handle, easy_handle))
3887       {
3888         /*caml_failwith("curlm_remove_finished");*/
3889       }
3890       return easy_handle;
3891     }
3892   }
3893 }
3894
3895 value caml_curlm_remove_finished(value v_multi)
3896 {
3897   CAMLparam1(v_multi);
3898   CAMLlocal2(v_easy, v_tuple);
3899   CURL* handle;
3900   CURLM* multi_handle;
3901   CURLcode result;
3902   Connection* conn = NULL;
3903
3904   multi_handle = CURLM_val(v_multi);
3905
3906   caml_enter_blocking_section();
3907   handle = curlm_remove_finished(multi_handle,&result);
3908   caml_leave_blocking_section();
3909
3910   if (NULL == handle)
3911   {
3912     CAMLreturn(Val_none);
3913   }
3914   else
3915   {
3916     conn = getConnection(handle);
3917     if (conn->curl_ERRORBUFFER != NULL)
3918     {
3919         Store_field(Field(conn->ocamlValues, Ocaml_ERRORBUFFER), 0, caml_copy_string(conn->curl_ERRORBUFFER));
3920     }
3921     conn->refcount--;
3922     /* NB: same handle, but different block */
3923     v_easy = caml_curl_alloc(conn);
3924     v_tuple = caml_alloc(2, 0);
3925     Store_field(v_tuple,0,v_easy);
3926     Store_field(v_tuple,1,Val_int(result)); /* CURLcode */
3927     CAMLreturn(Val_some(v_tuple));
3928   }
3929 }
3930
3931 static int curlm_wait_data(CURLM* multi_handle)
3932 {
3933         struct timeval timeout;
3934   CURLMcode ret;
3935
3936         fd_set fdread;
3937         fd_set fdwrite;
3938         fd_set fdexcep;
3939         int maxfd = -1;
3940
3941         FD_ZERO(&fdread);
3942         FD_ZERO(&fdwrite);
3943         FD_ZERO(&fdexcep);
3944
3945         /* set a suitable timeout */
3946         timeout.tv_sec = 1;
3947         timeout.tv_usec = 0;
3948
3949         /* get file descriptors from the transfers */
3950         ret = curl_multi_fdset(multi_handle, &fdread, &fdwrite, &fdexcep, &maxfd);
3951
3952         if (ret == CURLM_OK && maxfd >= 0)
3953         {
3954                 int rc = select(maxfd+1, &fdread, &fdwrite, &fdexcep, &timeout);
3955                 if (-1 != rc) return 0;
3956         }
3957         return 1;
3958 }
3959
3960 value caml_curlm_wait_data(value v_multi)
3961 {
3962   CAMLparam1(v_multi);
3963   int ret;
3964   CURLM* h = CURLM_val(v_multi);
3965
3966   caml_enter_blocking_section();
3967   ret = curlm_wait_data(h);
3968   caml_leave_blocking_section();
3969
3970   CAMLreturn(Val_bool(0 == ret));
3971 }
3972
3973 value caml_curl_multi_add_handle(value v_multi, value v_easy)
3974 {
3975   CAMLparam2(v_multi,v_easy);
3976   CURLM* multi = CURLM_val(v_multi);
3977   Connection* conn = Connection_val(v_easy);
3978
3979   /* prevent collection of OCaml value while the easy handle is used
3980    and may invoke callbacks registered on OCaml side */
3981   conn->refcount++;
3982
3983   /* may invoke callbacks so need to be consistent with locks */
3984   caml_enter_blocking_section();
3985   if (CURLM_OK != curl_multi_add_handle(multi, conn->handle))
3986   {
3987     conn->refcount--; /* not added, revert */
3988     caml_leave_blocking_section();
3989     caml_failwith("caml_curl_multi_add_handle");
3990   }
3991   caml_leave_blocking_section();
3992
3993   CAMLreturn(Val_unit);
3994 }
3995
3996 value caml_curl_multi_remove_handle(value v_multi, value v_easy)
3997 {
3998   CAMLparam2(v_multi,v_easy);
3999   CURLM* multi = CURLM_val(v_multi);
4000   Connection* conn = Connection_val(v_easy);
4001
4002   /* may invoke callbacks so need to be consistent with locks */
4003   caml_enter_blocking_section();
4004   if (CURLM_OK != curl_multi_remove_handle(multi, conn->handle))
4005   {
4006     caml_leave_blocking_section();
4007     caml_failwith("caml_curl_multi_remove_handle");
4008   }
4009   conn->refcount--;
4010   caml_leave_blocking_section();
4011
4012   CAMLreturn(Val_unit);
4013 }
4014
4015 value caml_curl_multi_perform_all(value v_multi)
4016 {
4017   CAMLparam1(v_multi);
4018   int still_running = 0;
4019   CURLM* h = CURLM_val(v_multi);
4020
4021   caml_enter_blocking_section();
4022   while (CURLM_CALL_MULTI_PERFORM == curl_multi_perform(h, &still_running));
4023   caml_leave_blocking_section();
4024
4025   CAMLreturn(Val_int(still_running));
4026 }
4027
4028 value helper_curl_easy_strerror(value v_code)
4029 {
4030   CAMLparam1(v_code);
4031   CAMLreturn(caml_copy_string(curl_easy_strerror((CURLcode)Int_val(v_code))));
4032 }
4033
4034 /*
4035  * Wrappers for the curl_multi_socket_action infrastructure
4036  * Based on curl hiperfifo.c example
4037  */
4038
4039 #ifdef _WIN32
4040 #ifndef Val_socket
4041 #define Val_socket(v) win_alloc_socket(v)
4042 #endif
4043 #ifndef Socket_val
4044 #error Socket_val not defined in unixsupport.h
4045 #endif
4046 #else /* _WIN32 */
4047 #ifndef Socket_val
4048 #define Socket_val(v) Long_val(v)
4049 #endif
4050 #ifndef Val_socket
4051 #define Val_socket(v) Val_int(v)
4052 #endif
4053 #endif  /* _WIN32 */
4054
4055 static void raise_multi_error(char const* msg)
4056 {
4057   static value* exception = NULL;
4058
4059   if (NULL == exception)
4060   {
4061     exception = caml_named_value("Curl.Multi.Error");
4062     if (NULL == exception) caml_invalid_argument("Curl.Multi.Error");
4063   }
4064
4065   caml_raise_with_string(*exception, msg);
4066 }
4067
4068 static void check_mcode(CURLMcode code)
4069 {
4070   char const *s = NULL;
4071   switch (code)
4072   {
4073     case CURLM_OK                  : return;
4074     case CURLM_CALL_MULTI_PERFORM  : s="CURLM_CALL_MULTI_PERFORM"; break;
4075     case CURLM_BAD_HANDLE          : s="CURLM_BAD_HANDLE";         break;
4076     case CURLM_BAD_EASY_HANDLE     : s="CURLM_BAD_EASY_HANDLE";    break;
4077     case CURLM_OUT_OF_MEMORY       : s="CURLM_OUT_OF_MEMORY";      break;
4078     case CURLM_INTERNAL_ERROR      : s="CURLM_INTERNAL_ERROR";     break;
4079     case CURLM_UNKNOWN_OPTION      : s="CURLM_UNKNOWN_OPTION";     break;
4080     case CURLM_LAST                : s="CURLM_LAST";               break;
4081     case CURLM_BAD_SOCKET          : s="CURLM_BAD_SOCKET";         break;
4082     default                        : s="CURLM_unknown";            break;
4083   }
4084   raise_multi_error(s);
4085 }
4086
4087 value caml_curl_multi_socket_action(value v_multi, value v_fd, value v_kind)
4088 {
4089   CAMLparam3(v_multi, v_fd, v_kind);
4090   CURLM* h = CURLM_val(v_multi);
4091   int still_running = 0;
4092   CURLMcode rc = CURLM_OK;
4093   curl_socket_t socket;
4094   int kind = 0;
4095
4096   if (Val_none == v_fd)
4097   {
4098     socket = CURL_SOCKET_TIMEOUT;
4099   }
4100   else
4101   {
4102     socket = Socket_val(Field(v_fd, 0));
4103   }
4104
4105   switch (Int_val(v_kind))
4106   {
4107     case 0 : break;
4108     case 1 : kind |= CURL_CSELECT_IN; break;
4109     case 2 : kind |= CURL_CSELECT_OUT; break;
4110     case 3 : kind |= CURL_CSELECT_IN | CURL_CSELECT_OUT; break;
4111     default:
4112       raise_multi_error("caml_curl_multi_socket_action");
4113   }
4114
4115 /*  fprintf(stdout,"fd %u kind %u\n",socket, kind); fflush(stdout); */
4116
4117   caml_enter_blocking_section();
4118   do {
4119     rc = curl_multi_socket_action(h, socket, kind, &still_running);
4120   } while (rc == CURLM_CALL_MULTI_PERFORM);
4121   caml_leave_blocking_section();
4122
4123   check_mcode(rc);
4124
4125   CAMLreturn(Val_int(still_running));
4126 }
4127
4128 value caml_curl_multi_socket_all(value v_multi)
4129 {
4130   CAMLparam1(v_multi);
4131   int still_running = 0;
4132   CURLMcode rc = CURLM_OK;
4133   CURLM* h = CURLM_val(v_multi);
4134
4135   caml_enter_blocking_section();
4136   do {
4137     rc = curl_multi_socket_all(h, &still_running);
4138   } while (rc == CURLM_CALL_MULTI_PERFORM);
4139   caml_leave_blocking_section();
4140
4141   check_mcode(rc);
4142
4143   CAMLreturn(Val_int(still_running));
4144 }
4145
4146 static int curlm_sock_cb(CURL *e, curl_socket_t sock, int what, void *cbp, void *sockp)
4147 {
4148   caml_leave_blocking_section();
4149
4150   CAMLparam0();
4151   CAMLlocal2(v_what,csock);
4152   (void)e;
4153   (void)sockp; /* not used */
4154
4155   /* v_what = Val_int(what); */
4156   switch (what)
4157   {
4158     case CURL_POLL_NONE   : v_what = Val_int(0); break;
4159     case CURL_POLL_IN     : v_what = Val_int(1); break;
4160     case CURL_POLL_OUT    : v_what = Val_int(2); break;
4161     case CURL_POLL_INOUT  : v_what = Val_int(3); break;
4162     case CURL_POLL_REMOVE : v_what = Val_int(4); break;
4163     default:
4164       fprintf(stderr, "curlm_sock_cb sock=%d what=%d\n", sock, what);
4165       fflush(stderr);
4166       raise_multi_error("curlm_sock_cb"); /* FIXME exception from callback */
4167   }
4168   csock=Val_socket(sock);
4169   caml_callback2(Field(((ml_multi_handle*)cbp)->values,curlmopt_socket_function),
4170                  csock, v_what);
4171   CAMLdrop;
4172
4173   caml_enter_blocking_section();
4174   return 0;
4175 }
4176
4177 value caml_curl_multi_socketfunction(value v_multi, value v_cb)
4178 {
4179   CAMLparam2(v_multi, v_cb);
4180   ml_multi_handle* multi = Multi_val(v_multi);
4181
4182   Store_field(multi->values, curlmopt_socket_function, v_cb);
4183
4184   curl_multi_setopt(multi->handle, CURLMOPT_SOCKETFUNCTION, curlm_sock_cb);
4185   curl_multi_setopt(multi->handle, CURLMOPT_SOCKETDATA, multi);
4186
4187   CAMLreturn(Val_unit);
4188 }
4189
4190 static int curlm_timer_cb(CURLM *multi, long timeout_ms, void *userp)
4191 {
4192   caml_leave_blocking_section();
4193
4194   CAMLparam0();
4195   (void)multi;
4196   caml_callback(Field(((ml_multi_handle*)userp)->values,curlmopt_timer_function), Val_long(timeout_ms));
4197   CAMLdrop;
4198
4199   caml_enter_blocking_section();
4200   return 0;
4201 }
4202
4203 value caml_curl_multi_timerfunction(value v_multi, value v_cb)
4204 {
4205   CAMLparam2(v_multi, v_cb);
4206   ml_multi_handle* multi = Multi_val(v_multi);
4207
4208   Store_field(multi->values, curlmopt_timer_function, v_cb);
4209
4210   curl_multi_setopt(multi->handle, CURLMOPT_TIMERFUNCTION, curlm_timer_cb);
4211   curl_multi_setopt(multi->handle, CURLMOPT_TIMERDATA, multi);
4212
4213   CAMLreturn(Val_unit);
4214 }
4215
4216 value caml_curl_multi_timeout(value v_multi)
4217 {
4218   CAMLparam1(v_multi);
4219   long ms = 0;
4220   CURLMcode rc = CURLM_OK;
4221   ml_multi_handle* multi = Multi_val(v_multi);
4222
4223   rc = curl_multi_timeout(multi->handle, &ms);
4224
4225   check_mcode(rc);
4226
4227   CAMLreturn(Val_long(ms));
4228 }
4229
4230 #define SETMOPT_VAL_(func_name, curl_option, conv_val) \
4231 static void func_name(CURLM *handle, value option) \
4232 { \
4233     CAMLparam1(option); \
4234     CURLMcode result = CURLM_OK; \
4235 \
4236     result = curl_multi_setopt(handle, curl_option, conv_val(option)); \
4237 \
4238     check_mcode(result); \
4239 \
4240     CAMLreturn0; \
4241 }
4242
4243 #define SETMOPT_VAL(name, conv) SETMOPT_VAL_(handle_multi_##name, CURLMOPT_##name, conv)
4244 #define SETMOPT_BOOL(name) SETMOPT_VAL(name, Bool_val)
4245 #define SETMOPT_LONG(name) SETMOPT_VAL(name, Long_val)
4246 #define SETMOPT_INT64(name) SETMOPT_VAL(name, Int64_val)
4247
4248 long pipeliningMap[] =
4249 {
4250   0, /* CURLPIPE_NOTHING */
4251   1, /* CURLPIPE_HTTP1 */
4252   2, /* CURLPIPE_MULTIPLEX */
4253 };
4254
4255 static void handle_multi_PIPELINING(CURLM* handle, value option)
4256 {
4257   CAMLparam1(option);
4258   CURLMcode result = CURLM_OK;
4259
4260   long bits = convert_bit_list(pipeliningMap, sizeof(pipeliningMap) / sizeof(pipeliningMap[0]), option);
4261
4262   result = curl_multi_setopt(handle, CURLMOPT_PIPELINING, bits);
4263
4264   check_mcode(result);
4265
4266   CAMLreturn0;
4267 }
4268
4269 #if HAVE_DECL_CURLMOPT_MAXCONNECTS
4270 SETMOPT_LONG( MAXCONNECTS)
4271 #endif
4272
4273 #if HAVE_DECL_CURLMOPT_MAX_PIPELINE_LENGTH
4274 SETMOPT_LONG( MAX_PIPELINE_LENGTH)
4275 #endif
4276
4277 #if HAVE_DECL_CURLMOPT_MAX_HOST_CONNECTIONS
4278 SETMOPT_LONG( MAX_HOST_CONNECTIONS)
4279 #endif
4280
4281 typedef struct CURLMOptionMapping CURLMOptionMapping;
4282 #define OPT(name) { handle_multi_## name, "CURLMOPT_"#name}
4283 #define NO_OPT(name) { NULL, "CURLMOPT_"#name}
4284
4285 struct CURLMOptionMapping
4286 {
4287     void (*optionHandler)(CURLM *, value);
4288     char *name;
4289 };
4290
4291 CURLMOptionMapping implementedMOptionMap[] = {
4292   OPT( PIPELINING),
4293 #if HAVE_DECL_CURLMOPT_MAXCONNECTS
4294   OPT( MAXCONNECTS),
4295 #else
4296   NO_OPT( MAXCONNECTS),
4297 #endif
4298 #if HAVE_DECL_CURLMOPT_MAX_PIPELINE_LENGTH
4299   OPT( MAX_PIPELINE_LENGTH),
4300 #else
4301   NO_OPT( MAX_PIPELINE_LENGTH),
4302 #endif
4303 #if HAVE_DECL_CURLMOPT_MAX_HOST_CONNECTIONS
4304   OPT( MAX_HOST_CONNECTIONS),
4305 #else
4306   NO_OPT( MAX_HOST_CONNECTIONS),
4307 #endif
4308 };
4309
4310 value caml_curl_multi_setopt(value v_multi, value option)
4311 {
4312     CAMLparam2(v_multi, option);
4313     CAMLlocal1(data);
4314     CURLM *handle = Multi_val(v_multi)->handle;
4315     CURLMOptionMapping* thisOption = NULL;
4316     static value* exception = NULL;
4317
4318     data = Field(option, 0);
4319
4320     if (Tag_val(option) < sizeof(implementedMOptionMap)/sizeof(CURLMOptionMapping))
4321     {
4322       thisOption = &implementedMOptionMap[Tag_val(option)];
4323       if (thisOption->optionHandler)
4324       {
4325         thisOption->optionHandler(handle, data);
4326       }
4327       else
4328       {
4329         if (NULL == exception)
4330         {
4331           exception = caml_named_value("Curl.NotImplemented");
4332           if (NULL == exception) caml_invalid_argument("Curl.NotImplemented");
4333         }
4334
4335         caml_raise_with_string(*exception, thisOption->name);
4336       }
4337     }
4338     else
4339     {
4340       caml_failwith("Invalid CURLMOPT Option");
4341     }
4342
4343     CAMLreturn(Val_unit);
4344 }
4345
4346 struct used_enum
4347 {
4348   int last_used;
4349   int last;
4350   char const* name;
4351 };
4352
4353 #define CURL_ENUM(name,last_used) { CURL_ ## name ## _ ## last_used, CURL_ ## name ## _LAST, #name }
4354
4355 struct used_enum check_enums[] = {
4356   { CURLINFO_SSL_DATA_OUT, CURLINFO_END, "CURLINFO" },
4357 #if defined(CURL_HTTP_VERSION_2TLS) /* FIXME */
4358   CURL_ENUM(HTTP_VERSION, 2TLS),
4359 #endif
4360 };
4361
4362 value caml_curl_outdated_enums(value v_unit)
4363 {
4364   CAMLparam0();
4365   CAMLlocal1(v);
4366   size_t i;
4367
4368   v = Val_emptylist;
4369
4370   for (i = 0; i < sizeof(check_enums) / sizeof(struct used_enum); i++)
4371   {
4372     if (check_enums[i].last_used + 1 != check_enums[i].last)
4373     {
4374       v = Val_cons(v, caml_copy_string(check_enums[i].name));
4375     }
4376   }
4377
4378   CAMLreturn(v);
4379 }
4380
4381 #ifdef __cplusplus
4382 }
4383 #endif