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