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