curl-helper.c

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