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