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(name) \
 948 static size_t cb_##name(char *ptr, size_t size, size_t nmemb, void *data)\
 949 {\
 950     size_t result;\
 951     leave_blocking_section();\
 952     result = cb_##name##_nolock(ptr,size,nmemb,data);\
 953     enter_blocking_section();\
 954     return result;\
 955 }
 956
 957 static size_t cb_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 cb_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 cb_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 cb_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 cb_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 = cb_PROGRESSFUNCTION_nolock(data,dlTotal,dlNow,ulTotal,ulNow);
1065   enter_blocking_section();
1066   return r;
1067 }
1068
1069 static int cb_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 cb_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 = cb_DEBUGFUNCTION_nolock(debugConnection, infoType, buffer, bufferLength, data);
1107   enter_blocking_section();
1108   return r;
1109 }
1110
1111 static curlioerr cb_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 cb_IOCTLFUNCTION(CURL *ioctl,
1164                                int cmd,
1165                                void *data)
1166 {
1167   curlioerr r;
1168   leave_blocking_section();
1169   r = cb_IOCTLFUNCTION_nolock(ioctl, cmd, data);
1170   enter_blocking_section();
1171   return r;
1172 }
1173
1174 #if HAVE_DECL_CURLOPT_SEEKFUNCTION
1175 static int cb_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 cb_SEEKFUNCTION(void *data,
1215                         curl_off_t offset,
1216                         int origin)
1217 {
1218   int r;
1219   leave_blocking_section();
1220   r = cb_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 cb_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 cb_OPENSOCKETFUNCTION(void *data,
1255                         curlsocktype purpose,
1256                         struct curl_sockaddr *address)
1257 {
1258   int r;
1259   leave_blocking_section();
1260   r = cb_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 #define SETOPT_FUNCTION(name) \
1345 static void handle_##name##FUNCTION(Connection *conn, value option) \
1346 { \
1347     CAMLparam1(option); \
1348     CURLcode result = CURLE_OK; \
1349     Store_field(conn->ocamlValues, Ocaml_##name##FUNCTION, option); \
1350     result = curl_easy_setopt(conn->connection, CURLOPT_##name##FUNCTION, cb_##name##FUNCTION); \
1351     if (result != CURLE_OK) raiseError(conn, result); \
1352     result = curl_easy_setopt(conn->connection, CURLOPT_##name##DATA, conn); \
1353     if (result != CURLE_OK) raiseError(conn, result); \
1354     CAMLreturn0; \
1355 }
1356
1357 SETOPT_FUNCTION( WRITE)
1358 SETOPT_FUNCTION( READ)
1359 SETOPT_FUNCTION( HEADER)
1360 SETOPT_FUNCTION( PROGRESS)
1361 SETOPT_FUNCTION( DEBUG)
1362
1363 #if HAVE_DECL_CURLOPT_SEEKFUNCTION
1364 SETOPT_FUNCTION( SEEK)
1365 #endif
1366
1367 #if HAVE_DECL_CURLOPT_IOCTLFUNCTION
1368 SETOPT_FUNCTION( IOCTL)
1369 #endif
1370
1371 #if HAVE_DECL_CURLOPT_OPENSOCKETFUNCTION
1372 SETOPT_FUNCTION( OPENSOCKET)
1373 #endif
1374
1375 static void handle_slist(Connection *conn, struct curl_slist** slist, OcamlValue caml_option, CURLoption curl_option, value option)
1376 {
1377     CAMLparam1(option);
1378     CURLcode result = CURLE_OK;
1379
1380     Store_field(conn->ocamlValues, caml_option, option);
1381
1382     free_curl_slist(*slist);
1383     *slist = NULL;
1384
1385     while (Val_emptylist != option)
1386     {
1387         *slist = curl_slist_append(*slist, String_val(Field(option, 0)));
1388
1389         option = Field(option, 1);
1390     }
1391
1392     result = curl_easy_setopt(conn->connection, curl_option, *slist);
1393
1394     if (result != CURLE_OK)
1395         raiseError(conn, result);
1396
1397     CAMLreturn0;
1398 }
1399
1400 #define SETOPT_STRING(name) \
1401 static void handle_##name(Connection *conn, value option) \
1402 { \
1403     CAMLparam1(option); \
1404     CURLcode result = CURLE_OK; \
1405 \
1406     Store_field(conn->ocamlValues, Ocaml_##name, option); \
1407 \
1408     if (conn->curl_##name != NULL) \
1409         free(conn->curl_##name); \
1410 \
1411     conn->curl_##name = strdup(String_val(option)); \
1412 \
1413     result = curl_easy_setopt(conn->connection, CURLOPT_##name, conn->curl_##name); \
1414 \
1415     if (result != CURLE_OK) \
1416         raiseError(conn, result); \
1417 \
1418     CAMLreturn0; \
1419 }
1420
1421 #define SETOPT_VAL_(func_name, curl_option, conv_val) \
1422 static void func_name(Connection *conn, value option) \
1423 { \
1424     CAMLparam1(option); \
1425     CURLcode result = CURLE_OK; \
1426 \
1427     result = curl_easy_setopt(conn->connection, curl_option, conv_val(option)); \
1428 \
1429     if (result != CURLE_OK) \
1430         raiseError(conn, result); \
1431 \
1432     CAMLreturn0; \
1433 }
1434
1435 #define SETOPT_VAL(name, conv) SETOPT_VAL_(handle_##name, CURLOPT_##name, conv)
1436 #define SETOPT_BOOL(name) SETOPT_VAL(name, Bool_val)
1437 #define SETOPT_LONG(name) SETOPT_VAL(name, Long_val)
1438 #define SETOPT_INT64(name) SETOPT_VAL(name, Int64_val)
1439
1440 #define SETOPT_SLIST(name) \
1441 static void handle_##name(Connection* conn, value option) \
1442 { \
1443   handle_slist(conn,&(conn->curl_##name),Ocaml_##name,CURLOPT_##name,option); \
1444 }
1445
1446 SETOPT_STRING( URL)
1447 SETOPT_LONG( INFILESIZE)
1448 SETOPT_STRING( PROXY)
1449 SETOPT_LONG( PROXYPORT)
1450 SETOPT_BOOL( HTTPPROXYTUNNEL)
1451 SETOPT_BOOL( VERBOSE)
1452 SETOPT_BOOL( HEADER)
1453 SETOPT_BOOL( NOPROGRESS)
1454
1455 #if HAVE_DECL_CURLOPT_NOSIGNAL
1456 SETOPT_BOOL( NOSIGNAL)
1457 #endif
1458
1459 SETOPT_BOOL( NOBODY)
1460 SETOPT_BOOL( FAILONERROR)
1461 SETOPT_BOOL( UPLOAD)
1462 SETOPT_BOOL( POST)
1463 SETOPT_BOOL( FTPLISTONLY)
1464 SETOPT_BOOL( FTPAPPEND)
1465
1466
1467 static void handle_NETRC(Connection *conn, value option)
1468 {
1469     CAMLparam1(option);
1470     CURLcode result = CURLE_OK;
1471     long netrc;
1472
1473     switch (Long_val(option))
1474     {
1475     case 0: /* CURL_NETRC_OPTIONAL */
1476         netrc = CURL_NETRC_OPTIONAL;
1477         break;
1478
1479     case 1:/* CURL_NETRC_IGNORED */
1480         netrc = CURL_NETRC_IGNORED;
1481         break;
1482
1483     case 2: /* CURL_NETRC_REQUIRED */
1484         netrc = CURL_NETRC_REQUIRED;
1485         break;
1486
1487     default:
1488         failwith("Invalid NETRC Option");
1489         break;
1490     }
1491
1492     result = curl_easy_setopt(conn->connection,
1493                               CURLOPT_NETRC,
1494                               netrc);
1495
1496     if (result != CURLE_OK)
1497         raiseError(conn, result);
1498
1499     CAMLreturn0;
1500 }
1501
1502 #if HAVE_DECL_CURLOPT_ENCODING
1503 static void handle_ENCODING(Connection *conn, value option)
1504 {
1505     CAMLparam1(option);
1506     CURLcode result = CURLE_OK;
1507
1508     switch (Long_val(option))
1509     {
1510     case 0: /* CURL_ENCODING_NONE */
1511         result = curl_easy_setopt(conn->connection,
1512                                   CURLOPT_ENCODING,
1513                                   "identity");
1514         break;
1515
1516     case 1: /* CURL_ENCODING_DEFLATE */
1517         result = curl_easy_setopt(conn->connection,
1518                                   CURLOPT_ENCODING,
1519                                   "deflate");
1520         break;
1521
1522     case 2: /* CURL_ENCODING_GZIP */
1523         result = curl_easy_setopt(conn->connection,
1524                                   CURLOPT_ENCODING,
1525                                   "gzip");
1526         break;
1527
1528     case 3: /* CURL_ENCODING_ANY */
1529         result = curl_easy_setopt(conn->connection,
1530                                   CURLOPT_ENCODING,
1531                                   "");
1532         break;
1533
1534     default:
1535         failwith("Invalid Encoding Option");
1536         break;
1537     }
1538
1539     if (result != CURLE_OK)
1540         raiseError(conn, result);
1541
1542     CAMLreturn0;
1543 }
1544 #endif
1545
1546
1547 SETOPT_BOOL( FOLLOWLOCATION)
1548 SETOPT_BOOL( TRANSFERTEXT)
1549 SETOPT_BOOL( PUT)
1550 SETOPT_STRING( USERPWD)
1551 SETOPT_STRING( PROXYUSERPWD)
1552 SETOPT_STRING( RANGE)
1553
1554 static void handle_ERRORBUFFER(Connection *conn, value option)
1555 {
1556     CAMLparam1(option);
1557     CURLcode result = CURLE_OK;
1558
1559     Store_field(conn->ocamlValues, Ocaml_ERRORBUFFER, option);
1560
1561     if (conn->curl_ERRORBUFFER != NULL)
1562         free(conn->curl_ERRORBUFFER);
1563
1564     conn->curl_ERRORBUFFER = malloc(sizeof(char) * CURL_ERROR_SIZE);
1565
1566     result = curl_easy_setopt(conn->connection,
1567                               CURLOPT_ERRORBUFFER,
1568                               conn->curl_ERRORBUFFER);
1569
1570     if (result != CURLE_OK)
1571         raiseError(conn, result);
1572
1573     CAMLreturn0;
1574 }
1575
1576 SETOPT_LONG( TIMEOUT)
1577
1578 static void handle_POSTFIELDS(Connection *conn, value option)
1579 {
1580     CAMLparam1(option);
1581     CURLcode result = CURLE_OK;
1582
1583     Store_field(conn->ocamlValues, Ocaml_POSTFIELDS, option);
1584
1585     if (conn->curl_POSTFIELDS != NULL)
1586         free(conn->curl_POSTFIELDS);
1587
1588     conn->curl_POSTFIELDS = strdup_ml(option);
1589
1590     result = curl_easy_setopt(conn->connection,
1591                               CURLOPT_POSTFIELDS,
1592                               conn->curl_POSTFIELDS);
1593
1594     if (result != CURLE_OK)
1595         raiseError(conn, result);
1596
1597     CAMLreturn0;
1598 }
1599
1600 SETOPT_LONG( POSTFIELDSIZE)
1601 SETOPT_STRING( REFERER)
1602 SETOPT_STRING( USERAGENT)
1603 SETOPT_STRING( FTPPORT)
1604 SETOPT_LONG( LOW_SPEED_LIMIT)
1605 SETOPT_LONG( LOW_SPEED_TIME)
1606 SETOPT_LONG( RESUME_FROM)
1607 SETOPT_STRING( COOKIE)
1608
1609 SETOPT_SLIST( HTTPHEADER)
1610
1611 static void handle_HTTPPOST(Connection *conn, value option)
1612 {
1613     CAMLparam1(option);
1614     CAMLlocal3(listIter, formItem, contentType);
1615     CURLcode result = CURLE_OK;
1616
1617     listIter = option;
1618
1619     Store_field(conn->ocamlValues, Ocaml_HTTPPOST, option);
1620
1621     free_curl_slist(conn->httpPostBuffers);
1622     if (conn->httpPostFirst != NULL)
1623         curl_formfree(conn->httpPostFirst);
1624
1625     conn->httpPostBuffers = NULL;
1626     conn->httpPostFirst = NULL;
1627     conn->httpPostLast = NULL;
1628
1629     while (!Is_long(listIter))
1630     {
1631         formItem = Field(listIter, 0);
1632
1633         switch (Tag_val(formItem))
1634         {
1635         case 0: /* CURLFORM_CONTENT */
1636             if (Wosize_val(formItem) < 3)
1637             {
1638                 failwith("Incorrect CURLFORM_CONTENT parameters");
1639             }
1640
1641             if (Is_long(Field(formItem, 2)) &&
1642                 Long_val(Field(formItem, 2)) == 0)
1643             {
1644                 curl_formadd(&conn->httpPostFirst,
1645                              &conn->httpPostLast,
1646                              CURLFORM_COPYNAME,
1647                              String_val(Field(formItem, 0)),
1648                              CURLFORM_NAMELENGTH,
1649                              string_length(Field(formItem, 0)),
1650                              CURLFORM_COPYCONTENTS,
1651                              String_val(Field(formItem, 1)),
1652                              CURLFORM_CONTENTSLENGTH,
1653                              string_length(Field(formItem, 1)),
1654                              CURLFORM_END);
1655             }
1656             else if (Is_block(Field(formItem, 2)))
1657             {
1658                 contentType = Field(formItem, 2);
1659
1660                 curl_formadd(&conn->httpPostFirst,
1661                              &conn->httpPostLast,
1662                              CURLFORM_COPYNAME,
1663                              String_val(Field(formItem, 0)),
1664                              CURLFORM_NAMELENGTH,
1665                              string_length(Field(formItem, 0)),
1666                              CURLFORM_PTRCONTENTS,
1667                              String_val(Field(formItem, 1)),
1668                              CURLFORM_CONTENTSLENGTH,
1669                              string_length(Field(formItem, 1)),
1670                              CURLFORM_CONTENTTYPE,
1671                              String_val(Field(contentType, 0)),
1672                              CURLFORM_END);
1673             }
1674             else
1675             {
1676                 failwith("Incorrect CURLFORM_CONTENT parameters");
1677             }
1678             break;
1679
1680         case 1: /* CURLFORM_FILECONTENT */
1681             if (Wosize_val(formItem) < 3)
1682             {
1683                 failwith("Incorrect CURLFORM_FILECONTENT parameters");
1684             }
1685
1686             if (Is_long(Field(formItem, 2)) &&
1687                 Long_val(Field(formItem, 2)) == 0)
1688             {
1689                 curl_formadd(&conn->httpPostFirst,
1690                              &conn->httpPostLast,
1691                              CURLFORM_COPYNAME,
1692                              String_val(Field(formItem, 0)),
1693                              CURLFORM_NAMELENGTH,
1694                              string_length(Field(formItem, 0)),
1695                              CURLFORM_FILECONTENT,
1696                              String_val(Field(formItem, 1)),
1697                              CURLFORM_END);
1698             }
1699             else if (Is_block(Field(formItem, 2)))
1700             {
1701                 contentType = Field(formItem, 2);
1702
1703                 curl_formadd(&conn->httpPostFirst,
1704                              &conn->httpPostLast,
1705                              CURLFORM_COPYNAME,
1706                              String_val(Field(formItem, 0)),
1707                              CURLFORM_NAMELENGTH,
1708                              string_length(Field(formItem, 0)),
1709                              CURLFORM_FILECONTENT,
1710                              String_val(Field(formItem, 1)),
1711                              CURLFORM_CONTENTTYPE,
1712                              String_val(Field(contentType, 0)),
1713                              CURLFORM_END);
1714             }
1715             else
1716             {
1717                 failwith("Incorrect CURLFORM_FILECONTENT parameters");
1718             }
1719             break;
1720
1721         case 2: /* CURLFORM_FILE */
1722             if (Wosize_val(formItem) < 3)
1723             {
1724                 failwith("Incorrect CURLFORM_FILE parameters");
1725             }
1726
1727             if (Is_long(Field(formItem, 2)) &&
1728                 Long_val(Field(formItem, 2)) == 0)
1729             {
1730                 curl_formadd(&conn->httpPostFirst,
1731                              &conn->httpPostLast,
1732                              CURLFORM_COPYNAME,
1733                              String_val(Field(formItem, 0)),
1734                              CURLFORM_NAMELENGTH,
1735                              string_length(Field(formItem, 0)),
1736                              CURLFORM_FILE,
1737                              String_val(Field(formItem, 1)),
1738                              CURLFORM_END);
1739             }
1740             else if (Is_block(Field(formItem, 2)))
1741             {
1742                 contentType = Field(formItem, 2);
1743
1744                 curl_formadd(&conn->httpPostFirst,
1745                              &conn->httpPostLast,
1746                              CURLFORM_COPYNAME,
1747                              String_val(Field(formItem, 0)),
1748                              CURLFORM_NAMELENGTH,
1749                              string_length(Field(formItem, 0)),
1750                              CURLFORM_FILE,
1751                              String_val(Field(formItem, 1)),
1752                              CURLFORM_CONTENTTYPE,
1753                              String_val(Field(contentType, 0)),
1754                              CURLFORM_END);
1755             }
1756             else
1757             {
1758                 failwith("Incorrect CURLFORM_FILE parameters");
1759             }
1760             break;
1761
1762         case 3: /* CURLFORM_BUFFER */
1763             if (Wosize_val(formItem) < 4)
1764             {
1765                 failwith("Incorrect CURLFORM_BUFFER parameters");
1766             }
1767
1768             if (Is_long(Field(formItem, 3)) &&
1769                 Long_val(Field(formItem, 3)) == 0)
1770             {
1771                 conn->httpPostBuffers = curl_slist_append(conn->httpPostBuffers, String_val(Field(formItem, 2)));
1772
1773                 curl_formadd(&conn->httpPostFirst,
1774                              &conn->httpPostLast,
1775                              CURLFORM_COPYNAME,
1776                              String_val(Field(formItem, 0)),
1777                              CURLFORM_NAMELENGTH,
1778                              string_length(Field(formItem, 0)),
1779                              CURLFORM_BUFFER,
1780                              String_val(Field(formItem, 1)),
1781                              CURLFORM_BUFFERPTR,
1782                              conn->httpPostBuffers->data,
1783                              CURLFORM_BUFFERLENGTH,
1784                              string_length(Field(formItem, 2)),
1785                              CURLFORM_END);
1786             }
1787             else if (Is_block(Field(formItem, 3)))
1788             {
1789                 conn->httpPostBuffers = curl_slist_append(conn->httpPostBuffers, String_val(Field(formItem, 2)));
1790
1791                 contentType = Field(formItem, 3);
1792
1793                 curl_formadd(&conn->httpPostFirst,
1794                              &conn->httpPostLast,
1795                              CURLFORM_COPYNAME,
1796                              String_val(Field(formItem, 0)),
1797                              CURLFORM_NAMELENGTH,
1798                              string_length(Field(formItem, 0)),
1799                              CURLFORM_BUFFER,
1800                              String_val(Field(formItem, 1)),
1801                              CURLFORM_BUFFERPTR,
1802                              conn->httpPostBuffers->data,
1803                              CURLFORM_BUFFERLENGTH,
1804                              string_length(Field(formItem, 2)),
1805                              CURLFORM_CONTENTTYPE,
1806                              String_val(Field(contentType, 0)),
1807                              CURLFORM_END);
1808             }
1809             else
1810             {
1811                 failwith("Incorrect CURLFORM_BUFFER parameters");
1812             }
1813             break;
1814         }
1815
1816         listIter = Field(listIter, 1);
1817     }
1818
1819     result = curl_easy_setopt(conn->connection,
1820                               CURLOPT_HTTPPOST,
1821                               conn->httpPostFirst);
1822
1823     if (result != CURLE_OK)
1824         raiseError(conn, result);
1825
1826     CAMLreturn0;
1827 }
1828
1829 SETOPT_STRING( SSLCERT)
1830 SETOPT_STRING( SSLCERTTYPE)
1831 SETOPT_STRING( SSLCERTPASSWD)
1832 SETOPT_STRING( SSLKEY)
1833 SETOPT_STRING( SSLKEYTYPE)
1834 SETOPT_STRING( SSLKEYPASSWD)
1835 SETOPT_STRING( SSLENGINE)
1836 SETOPT_BOOL( SSLENGINE_DEFAULT)
1837 SETOPT_BOOL( CRLF)
1838
1839 SETOPT_SLIST( QUOTE)
1840 SETOPT_SLIST( POSTQUOTE)
1841
1842 SETOPT_STRING( COOKIEFILE)
1843 SETOPT_LONG( SSLVERSION)
1844
1845 static void handle_TIMECONDITION(Connection *conn, value option)
1846 {
1847     CAMLparam1(option);
1848     CURLcode result = CURLE_OK;
1849     int timecond = CURL_TIMECOND_NONE;
1850
1851     switch (Long_val(option))
1852     {
1853     case 0: timecond = CURL_TIMECOND_NONE; break;
1854     case 1: timecond = CURL_TIMECOND_IFMODSINCE; break;
1855     case 2: timecond = CURL_TIMECOND_IFUNMODSINCE; break;
1856     case 3: timecond = CURL_TIMECOND_LASTMOD; break;
1857     default:
1858         failwith("Invalid TIMECOND Option");
1859         break;
1860     }
1861
1862     result = curl_easy_setopt(conn->connection, CURLOPT_TIMECONDITION, timecond);
1863
1864     if (result != CURLE_OK)
1865         raiseError(conn, result);
1866
1867     CAMLreturn0;
1868 }
1869
1870 SETOPT_VAL( TIMEVALUE, Int32_val)
1871 SETOPT_STRING( CUSTOMREQUEST)
1872 SETOPT_STRING( INTERFACE)
1873
1874 static void handle_KRB4LEVEL(Connection *conn, value option)
1875 {
1876     CAMLparam1(option);
1877     CURLcode result = CURLE_OK;
1878
1879     switch (Long_val(option))
1880     {
1881     case 0: /* KRB4_NONE */
1882         result = curl_easy_setopt(conn->connection,
1883                                   CURLOPT_KRB4LEVEL,
1884                                   NULL);
1885         break;
1886
1887     case 1: /* KRB4_CLEAR */
1888         result = curl_easy_setopt(conn->connection,
1889                                   CURLOPT_KRB4LEVEL,
1890                                   "clear");
1891         break;
1892
1893     case 2: /* KRB4_SAFE */
1894         result = curl_easy_setopt(conn->connection,
1895                                   CURLOPT_KRB4LEVEL,
1896                                   "safe");
1897         break;
1898
1899     case 3: /* KRB4_CONFIDENTIAL */
1900         result = curl_easy_setopt(conn->connection,
1901                                   CURLOPT_KRB4LEVEL,
1902                                   "confidential");
1903         break;
1904
1905     case 4: /* KRB4_PRIVATE */
1906         result = curl_easy_setopt(conn->connection,
1907                                   CURLOPT_KRB4LEVEL,
1908                                   "private");
1909         break;
1910
1911     default:
1912         failwith("Invalid KRB4 Option");
1913         break;
1914     }
1915
1916     if (result != CURLE_OK)
1917         raiseError(conn, result);
1918
1919     CAMLreturn0;
1920 }
1921
1922 SETOPT_BOOL( SSL_VERIFYPEER)
1923 SETOPT_STRING( CAINFO)
1924 SETOPT_STRING( CAPATH)
1925 SETOPT_BOOL( FILETIME)
1926 SETOPT_LONG( MAXREDIRS)
1927 SETOPT_LONG( MAXCONNECTS)
1928
1929 static void handle_CLOSEPOLICY(Connection *conn, value option)
1930 {
1931     CAMLparam1(option);
1932     CURLcode result = CURLE_OK;
1933
1934     switch (Long_val(option))
1935     {
1936     case 0: /* CLOSEPOLICY_OLDEST */
1937         result = curl_easy_setopt(conn->connection,
1938                                   CURLOPT_CLOSEPOLICY,
1939                                   CURLCLOSEPOLICY_OLDEST);
1940         break;
1941
1942     case 1: /* CLOSEPOLICY_LEAST_RECENTLY_USED */
1943         result = curl_easy_setopt(conn->connection,
1944                                   CURLOPT_CLOSEPOLICY,
1945                                   CURLCLOSEPOLICY_LEAST_RECENTLY_USED);
1946         break;
1947
1948     default:
1949         failwith("Invalid CLOSEPOLICY Option");
1950         break;
1951     }
1952
1953     if (result != CURLE_OK)
1954         raiseError(conn, result);
1955
1956     CAMLreturn0;
1957 }
1958
1959 SETOPT_BOOL( FRESH_CONNECT)
1960 SETOPT_BOOL( FORBID_REUSE)
1961 SETOPT_STRING( RANDOM_FILE)
1962 SETOPT_STRING( EGDSOCKET)
1963 SETOPT_LONG( CONNECTTIMEOUT)
1964 SETOPT_BOOL( HTTPGET)
1965
1966 static void handle_SSL_VERIFYHOST(Connection *conn, value option)
1967 {
1968     CAMLparam1(option);
1969     CURLcode result = CURLE_OK;
1970
1971     switch (Long_val(option))
1972     {
1973     case 0: /* SSLVERIFYHOST_NONE */
1974     case 1: /* SSLVERIFYHOST_EXISTENCE */
1975     case 2: /* SSLVERIFYHOST_HOSTNAME */
1976         result = curl_easy_setopt(conn->connection,
1977                                   CURLOPT_SSL_VERIFYHOST,
1978                                   /* map EXISTENCE to HOSTNAME */
1979                                   Long_val(option) == 0 ? 0 : 2);
1980         break;
1981
1982     default:
1983         failwith("Invalid SSLVERIFYHOST Option");
1984         break;
1985     }
1986
1987     if (result != CURLE_OK)
1988         raiseError(conn, result);
1989
1990     CAMLreturn0;
1991 }
1992
1993 SETOPT_STRING( COOKIEJAR)
1994 SETOPT_STRING( SSL_CIPHER_LIST)
1995
1996 static void handle_HTTP_VERSION(Connection *conn, value option)
1997 {
1998     CAMLparam1(option);
1999     CURLcode result = CURLE_OK;
2000
2001     switch (Long_val(option))
2002     {
2003     case 0: /* HTTP_VERSION_NONE */
2004         result = curl_easy_setopt(conn->connection,
2005                                   CURLOPT_HTTP_VERSION,
2006                                   CURL_HTTP_VERSION_NONE);
2007         break;
2008
2009     case 1: /* HTTP_VERSION_1_0 */
2010         result = curl_easy_setopt(conn->connection,
2011                                   CURLOPT_HTTP_VERSION,
2012                                   CURL_HTTP_VERSION_1_0);
2013         break;
2014
2015     case 2: /* HTTP_VERSION_1_1 */
2016         result = curl_easy_setopt(conn->connection,
2017                                   CURLOPT_HTTP_VERSION,
2018                                   CURL_HTTP_VERSION_1_1);
2019         break;
2020
2021     default:
2022         failwith("Invalid HTTP_VERSION Option");
2023         break;
2024     }
2025
2026     if (result != CURLE_OK)
2027         raiseError(conn, result);
2028
2029     CAMLreturn0;
2030 }
2031
2032 SETOPT_BOOL( FTP_USE_EPSV)
2033 SETOPT_LONG( DNS_CACHE_TIMEOUT)
2034 SETOPT_BOOL( DNS_USE_GLOBAL_CACHE)
2035
2036 #if HAVE_DECL_CURLOPT_PRIVATE
2037 SETOPT_STRING( PRIVATE)
2038 #endif
2039
2040 #if HAVE_DECL_CURLOPT_HTTP200ALIASES
2041 SETOPT_SLIST( HTTP200ALIASES)
2042 #endif
2043
2044 #if HAVE_DECL_CURLOPT_UNRESTRICTED_AUTH
2045 SETOPT_BOOL( UNRESTRICTED_AUTH)
2046 #endif
2047
2048 #if HAVE_DECL_CURLOPT_FTP_USE_EPRT
2049 SETOPT_BOOL( FTP_USE_EPRT)
2050 #endif
2051
2052 #if HAVE_DECL_CURLOPT_HTTPAUTH
2053 static void handle_HTTPAUTH(Connection *conn, value option)
2054 {
2055     CAMLparam1(option);
2056     CAMLlocal1(listIter);
2057     CURLcode result = CURLE_OK;
2058     long auth = CURLAUTH_NONE;
2059
2060     listIter = option;
2061
2062     while (!Is_long(listIter))
2063     {
2064         switch (Long_val(Field(listIter, 0)))
2065         {
2066         case 0: /* CURLAUTH_BASIC */
2067             auth |= CURLAUTH_BASIC;
2068             break;
2069
2070         case 1: /* CURLAUTH_DIGEST */
2071             auth |= CURLAUTH_DIGEST;
2072             break;
2073
2074         case 2: /* CURLAUTH_GSSNEGOTIATE */
2075             auth |= CURLAUTH_GSSNEGOTIATE;
2076             break;
2077
2078         case 3: /* CURLAUTH_NTLM */
2079             auth |= CURLAUTH_NTLM;
2080             break;
2081
2082         case 4: /* CURLAUTH_ANY */
2083             auth |= CURLAUTH_ANY;
2084             break;
2085
2086         case 5: /* CURLAUTH_ANYSAFE */
2087             auth |= CURLAUTH_ANYSAFE;
2088             break;
2089
2090         default:
2091             failwith("Invalid HTTPAUTH Value");
2092             break;
2093         }
2094
2095         listIter = Field(listIter, 1);
2096     }
2097
2098     result = curl_easy_setopt(conn->connection,
2099                               CURLOPT_HTTPAUTH,
2100                               auth);
2101
2102     if (result != CURLE_OK)
2103         raiseError(conn, result);
2104
2105     CAMLreturn0;
2106 }
2107 #endif
2108
2109 #if HAVE_DECL_CURLOPT_FTP_CREATE_MISSING_DIRS
2110 SETOPT_BOOL( FTP_CREATE_MISSING_DIRS)
2111 #endif
2112
2113 #if HAVE_DECL_CURLOPT_PROXYAUTH
2114 static void handle_PROXYAUTH(Connection *conn, value option)
2115 {
2116     CAMLparam1(option);
2117     CAMLlocal1(listIter);
2118     CURLcode result = CURLE_OK;
2119     long auth = CURLAUTH_NONE;
2120
2121     listIter = option;
2122
2123     while (!Is_long(listIter))
2124     {
2125         switch (Long_val(Field(listIter, 0)))
2126         {
2127         case 0: /* CURLAUTH_BASIC */
2128             auth |= CURLAUTH_BASIC;
2129             break;
2130
2131         case 1: /* CURLAUTH_DIGEST */
2132             auth |= CURLAUTH_DIGEST;
2133             break;
2134
2135         case 2: /* CURLAUTH_GSSNEGOTIATE */
2136             auth |= CURLAUTH_GSSNEGOTIATE;
2137             break;
2138
2139         case 3: /* CURLAUTH_NTLM */
2140             auth |= CURLAUTH_NTLM;
2141             break;
2142
2143         case 4: /* CURLAUTH_ANY */
2144             auth |= CURLAUTH_ANY;
2145             break;
2146
2147         case 5: /* CURLAUTH_ANYSAFE */
2148             auth |= CURLAUTH_ANYSAFE;
2149             break;
2150
2151         default:
2152             failwith("Invalid HTTPAUTH Value");
2153             break;
2154         }
2155
2156         listIter = Field(listIter, 1);
2157     }
2158
2159     result = curl_easy_setopt(conn->connection,
2160                               CURLOPT_PROXYAUTH,
2161                               auth);
2162
2163     if (result != CURLE_OK)
2164         raiseError(conn, result);
2165
2166     CAMLreturn0;
2167 }
2168 #endif
2169
2170 #if HAVE_DECL_CURLOPT_FTP_RESPONSE_TIMEOUT
2171 SETOPT_LONG( FTP_RESPONSE_TIMEOUT)
2172 #endif
2173
2174 #if HAVE_DECL_CURLOPT_IPRESOLVE
2175 static void handle_IPRESOLVE(Connection *conn, value option)
2176 {
2177     CAMLparam1(option);
2178     CURLcode result = CURLE_OK;
2179
2180     switch (Long_val(option))
2181     {
2182     case 0: /* CURL_IPRESOLVE_WHATEVER */
2183         result = curl_easy_setopt(conn->connection,
2184                                   CURLOPT_IPRESOLVE,
2185                                   CURL_IPRESOLVE_WHATEVER);
2186         break;
2187
2188     case 1: /* CURL_IPRESOLVE_V4 */
2189         result = curl_easy_setopt(conn->connection,
2190                                   CURLOPT_IPRESOLVE,
2191                                   CURL_IPRESOLVE_V4);
2192         break;
2193
2194     case 2: /* CURL_IPRESOLVE_V6 */
2195         result = curl_easy_setopt(conn->connection,
2196                                   CURLOPT_IPRESOLVE,
2197                                   CURL_IPRESOLVE_V6);
2198         break;
2199
2200     default:
2201         failwith("Invalid IPRESOLVE Value");
2202         break;
2203     }
2204
2205     if (result != CURLE_OK)
2206         raiseError(conn, result);
2207
2208     CAMLreturn0;
2209 }
2210 #endif
2211
2212 #if HAVE_DECL_CURLOPT_MAXFILESIZE
2213 SETOPT_VAL( MAXFILESIZE, Int32_val)
2214 #endif
2215
2216 #if HAVE_DECL_CURLOPT_INFILESIZE_LARGE
2217 SETOPT_INT64( INFILESIZE_LARGE)
2218 #endif
2219
2220 #if HAVE_DECL_CURLOPT_RESUME_FROM_LARGE
2221 SETOPT_INT64( RESUME_FROM_LARGE)
2222 #endif
2223
2224 #if HAVE_DECL_CURLOPT_MAXFILESIZE_LARGE
2225 SETOPT_INT64( MAXFILESIZE_LARGE)
2226 #endif
2227
2228 #if HAVE_DECL_CURLOPT_NETRC_FILE
2229 SETOPT_STRING( NETRC_FILE)
2230 #endif
2231
2232 #if HAVE_DECL_CURLOPT_FTP_SSL
2233 static void handle_FTP_SSL(Connection *conn, value option)
2234 {
2235     CAMLparam1(option);
2236     CURLcode result = CURLE_OK;
2237
2238     switch (Long_val(option))
2239     {
2240     case 0: /* CURLFTPSSL_NONE */
2241         result = curl_easy_setopt(conn->connection,
2242                                   CURLOPT_FTP_SSL,
2243                                   CURLFTPSSL_NONE);
2244         break;
2245
2246     case 1: /* CURLFTPSSL_TRY */
2247         result = curl_easy_setopt(conn->connection,
2248                                   CURLOPT_FTP_SSL,
2249                                   CURLFTPSSL_TRY);
2250         break;
2251
2252     case 2: /* CURLFTPSSL_CONTROL */
2253         result = curl_easy_setopt(conn->connection,
2254                                   CURLOPT_FTP_SSL,
2255                                   CURLFTPSSL_CONTROL);
2256         break;
2257
2258     case 3: /* CURLFTPSSL_ALL */
2259         result = curl_easy_setopt(conn->connection,
2260                                   CURLOPT_FTP_SSL,
2261                                   CURLFTPSSL_ALL);
2262         break;
2263
2264     default:
2265         failwith("Invalid FTP_SSL Value");
2266         break;
2267     }
2268
2269     if (result != CURLE_OK)
2270         raiseError(conn, result);
2271
2272     CAMLreturn0;
2273 }
2274 #endif
2275
2276 #if HAVE_DECL_CURLOPT_POSTFIELDSIZE_LARGE
2277 SETOPT_INT64( POSTFIELDSIZE_LARGE)
2278 #endif
2279
2280 #if HAVE_DECL_CURLOPT_TCP_NODELAY
2281 /* not using SETOPT_BOOL here because of TCP_NODELAY defined in winsock.h */
2282 SETOPT_VAL_( handle_TCP_NODELAY, CURLOPT_TCP_NODELAY, Bool_val)
2283 #endif
2284
2285 #if HAVE_DECL_CURLOPT_FTPSSLAUTH
2286 static void handle_FTPSSLAUTH(Connection *conn, value option)
2287 {
2288     CAMLparam1(option);
2289     CURLcode result = CURLE_OK;
2290
2291     switch (Long_val(option))
2292     {
2293     case 0: /* CURLFTPAUTH_DEFAULT */
2294         result = curl_easy_setopt(conn->connection,
2295                                   CURLOPT_FTPSSLAUTH,
2296                                   CURLFTPAUTH_DEFAULT);
2297         break;
2298
2299     case 1: /* CURLFTPAUTH_SSL */
2300         result = curl_easy_setopt(conn->connection,
2301                                   CURLOPT_FTPSSLAUTH,
2302                                   CURLFTPAUTH_SSL);
2303         break;
2304
2305     case 2: /* CURLFTPAUTH_TLS */
2306         result = curl_easy_setopt(conn->connection,
2307                                   CURLOPT_FTPSSLAUTH,
2308                                   CURLFTPAUTH_TLS);
2309         break;
2310
2311     default:
2312         failwith("Invalid FTPSSLAUTH value");
2313         break;
2314     }
2315
2316     if (result != CURLE_OK)
2317         raiseError(conn, result);
2318
2319     CAMLreturn0;
2320 }
2321 #endif
2322
2323 #if HAVE_DECL_CURLOPT_FTP_ACCOUNT
2324 SETOPT_STRING( FTP_ACCOUNT)
2325 #endif
2326
2327 #if HAVE_DECL_CURLOPT_COOKIELIST
2328 SETOPT_STRING( COOKIELIST)
2329 #endif
2330
2331 #if HAVE_DECL_CURLOPT_IGNORE_CONTENT_LENGTH
2332 SETOPT_BOOL( IGNORE_CONTENT_LENGTH)
2333 #endif
2334
2335 #if HAVE_DECL_CURLOPT_FTP_SKIP_PASV_IP
2336 SETOPT_BOOL( FTP_SKIP_PASV_IP)
2337 #endif
2338
2339 #if HAVE_DECL_CURLOPT_FTP_FILEMETHOD
2340 static void handle_FTP_FILEMETHOD(Connection *conn, value option)
2341 {
2342     CAMLparam1(option);
2343     CURLcode result = CURLE_OK;
2344
2345     switch (Long_val(option))
2346     {
2347     case 0: /* CURLFTPMETHOD_DEFAULT */
2348         result = curl_easy_setopt(conn->connection,
2349                                   CURLOPT_FTP_FILEMETHOD,
2350                                   CURLFTPMETHOD_DEFAULT);
2351         break;
2352
2353     case 1: /* CURLFTMETHOD_MULTICWD */
2354         result = curl_easy_setopt(conn->connection,
2355                                   CURLOPT_FTP_FILEMETHOD,
2356                                   CURLFTPMETHOD_MULTICWD);
2357         break;
2358
2359     case 2: /* CURLFTPMETHOD_NOCWD */
2360         result = curl_easy_setopt(conn->connection,
2361                                   CURLOPT_FTP_FILEMETHOD,
2362                                   CURLFTPMETHOD_NOCWD);
2363         break;
2364
2365     case 3: /* CURLFTPMETHOD_SINGLECWD */
2366         result = curl_easy_setopt(conn->connection,
2367                                   CURLOPT_FTP_FILEMETHOD,
2368                                   CURLFTPMETHOD_SINGLECWD);
2369
2370     default:
2371         failwith("Invalid FTP_FILEMETHOD value");
2372         break;
2373     }
2374
2375     if (result != CURLE_OK)
2376         raiseError(conn, result);
2377
2378     CAMLreturn0;
2379 }
2380 #endif
2381
2382 #if HAVE_DECL_CURLOPT_LOCALPORT
2383 SETOPT_LONG( LOCALPORT)
2384 #endif
2385
2386 #if HAVE_DECL_CURLOPT_LOCALPORTRANGE
2387 SETOPT_LONG( LOCALPORTRANGE)
2388 #endif
2389
2390 #if HAVE_DECL_CURLOPT_CONNECT_ONLY
2391 SETOPT_BOOL( CONNECT_ONLY)
2392 #endif
2393
2394 #if HAVE_DECL_CURLOPT_MAX_SEND_SPEED_LARGE
2395 SETOPT_INT64( MAX_SEND_SPEED_LARGE)
2396 #endif
2397
2398 #if HAVE_DECL_CURLOPT_MAX_RECV_SPEED_LARGE
2399 SETOPT_INT64( MAX_RECV_SPEED_LARGE)
2400 #endif
2401
2402 #if HAVE_DECL_CURLOPT_FTP_ALTERNATIVE_TO_USER
2403 SETOPT_STRING( FTP_ALTERNATIVE_TO_USER)
2404 #endif
2405
2406 #if HAVE_DECL_CURLOPT_SSL_SESSIONID_CACHE
2407 SETOPT_BOOL( SSL_SESSIONID_CACHE)
2408 #endif
2409
2410 #if HAVE_DECL_CURLOPT_SSH_AUTH_TYPES
2411 static void handle_SSH_AUTH_TYPES(Connection *conn, value option)
2412 {
2413     CAMLparam1(option);
2414     CAMLlocal1(listIter);
2415     CURLcode result = CURLE_OK;
2416     long authTypes = CURLSSH_AUTH_NONE;
2417
2418     listIter = option;
2419
2420     while (!Is_long(listIter))
2421     {
2422         switch (Long_val(Field(listIter, 0)))
2423         {
2424         case 0: /* CURLSSH_AUTH_ANY */
2425             authTypes |= CURLSSH_AUTH_ANY;
2426             break;
2427
2428         case 1: /* CURLSSH_AUTH_PUBLICKEY */
2429             authTypes |= CURLSSH_AUTH_PUBLICKEY;
2430             break;
2431
2432         case 2: /* CURLSSH_AUTH_PASSWORD */
2433             authTypes |= CURLSSH_AUTH_PASSWORD;
2434             break;
2435
2436         case 3: /* CURLSSH_AUTH_HOST */
2437             authTypes |= CURLSSH_AUTH_HOST;
2438             break;
2439
2440         case 4: /* CURLSSH_AUTH_KEYBOARD */
2441             authTypes |= CURLSSH_AUTH_KEYBOARD;
2442             break;
2443
2444         default:
2445             failwith("Invalid CURLSSH_AUTH_TYPES Value");
2446             break;
2447         }
2448
2449         listIter = Field(listIter, 1);
2450     }
2451
2452     result = curl_easy_setopt(conn->connection,
2453                               CURLOPT_SSH_AUTH_TYPES,
2454                               authTypes);
2455
2456     if (result != CURLE_OK)
2457         raiseError(conn, result);
2458
2459     CAMLreturn0;
2460 }
2461 #endif
2462
2463 #if HAVE_DECL_CURLOPT_SSH_PUBLIC_KEYFILE
2464 SETOPT_STRING( SSH_PUBLIC_KEYFILE)
2465 #endif
2466
2467 #if HAVE_DECL_CURLOPT_SSH_PRIVATE_KEYFILE
2468 SETOPT_STRING( SSH_PRIVATE_KEYFILE)
2469 #endif
2470
2471 #if HAVE_DECL_CURLOPT_FTP_SSL_CCC
2472 static void handle_FTP_SSL_CCC(Connection *conn, value option)
2473 {
2474     CAMLparam1(option);
2475     CURLcode result = CURLE_OK;
2476
2477     switch (Long_val(option))
2478     {
2479     case 0: /* CURLFTPSSL_CCC_NONE */
2480         result = curl_easy_setopt(conn->connection,
2481                                   CURLOPT_FTP_SSL_CCC,
2482                                   CURLFTPSSL_CCC_NONE);
2483         break;
2484
2485     case 1: /* CURLFTPSSL_CCC_PASSIVE */
2486         result = curl_easy_setopt(conn->connection,
2487                                   CURLOPT_FTP_SSL_CCC,
2488                                   CURLFTPSSL_CCC_PASSIVE);
2489         break;
2490
2491     case 2: /* CURLFTPSSL_CCC_ACTIVE */
2492         result = curl_easy_setopt(conn->connection,
2493                                   CURLOPT_FTP_SSL_CCC,
2494                                   CURLFTPSSL_CCC_ACTIVE);
2495         break;
2496
2497     default:
2498         failwith("Invalid FTPSSL_CCC value");
2499         break;
2500     }
2501
2502     if (result != CURLE_OK)
2503         raiseError(conn, result);
2504
2505     CAMLreturn0;
2506 }
2507 #endif
2508
2509 #if HAVE_DECL_CURLOPT_TIMEOUT_MS
2510 SETOPT_LONG( TIMEOUT_MS)
2511 #endif
2512
2513 #if HAVE_DECL_CURLOPT_CONNECTTIMEOUT_MS
2514 SETOPT_LONG( CONNECTTIMEOUT_MS)
2515 #endif
2516
2517 #if HAVE_DECL_CURLOPT_HTTP_TRANSFER_DECODING
2518 SETOPT_BOOL( HTTP_TRANSFER_DECODING)
2519 #endif
2520
2521 #if HAVE_DECL_CURLOPT_HTTP_CONTENT_DECODING
2522 SETOPT_BOOL( HTTP_CONTENT_DECODING)
2523 #endif
2524
2525 #if HAVE_DECL_CURLOPT_NEW_FILE_PERMS
2526 SETOPT_LONG( NEW_FILE_PERMS)
2527 #endif
2528
2529 #if HAVE_DECL_CURLOPT_NEW_DIRECTORY_PERMS
2530 SETOPT_LONG( NEW_DIRECTORY_PERMS)
2531 #endif
2532
2533 #if HAVE_DECL_CURLOPT_POST301
2534 SETOPT_BOOL( POST301)
2535 #endif
2536
2537 #if HAVE_DECL_CURLOPT_SSH_HOST_PUBLIC_KEY_MD5
2538 SETOPT_STRING( SSH_HOST_PUBLIC_KEY_MD5)
2539 #endif
2540
2541 #if HAVE_DECL_CURLOPT_COPYPOSTFIELDS
2542 SETOPT_STRING( COPYPOSTFIELDS)
2543 #endif
2544
2545 #if HAVE_DECL_CURLOPT_PROXY_TRANSFER_MODE
2546 SETOPT_BOOL( PROXY_TRANSFER_MODE)
2547 #endif
2548
2549 #if HAVE_DECL_CURLOPT_AUTOREFERER
2550 SETOPT_BOOL( AUTOREFERER)
2551 #endif
2552
2553 #if HAVE_DECL_CURLOPT_PROXYTYPE
2554 static void handle_PROXYTYPE(Connection *conn, value option)
2555 {
2556     CAMLparam1(option);
2557     CURLcode result = CURLE_OK;
2558     long proxy_type;
2559
2560     switch (Long_val(option))
2561     {
2562       case 0: proxy_type = CURLPROXY_HTTP; break;
2563       case 1: proxy_type = CURLPROXY_HTTP_1_0; break;
2564       case 2: proxy_type = CURLPROXY_SOCKS4; break;
2565       case 3: proxy_type = CURLPROXY_SOCKS5; break;
2566       case 4: proxy_type = CURLPROXY_SOCKS4A; break;
2567       case 5: proxy_type = CURLPROXY_SOCKS5_HOSTNAME; break;
2568       default:
2569         failwith("Invalid curl proxy type");
2570     }
2571
2572     result = curl_easy_setopt(conn->connection,
2573                               CURLOPT_PROXYTYPE,
2574                               proxy_type);
2575
2576     if (result != CURLE_OK)
2577         raiseError(conn, result);
2578
2579     CAMLreturn0;
2580 }
2581 #endif
2582
2583 #if HAVE_DECL_CURLOPT_PROTOCOLS || HAVE_DECL_CURLOPT_REDIR_PROTOCOLS
2584
2585 long protoMap[] =
2586 {
2587   CURLPROTO_ALL,
2588   CURLPROTO_HTTP, CURLPROTO_HTTPS, CURLPROTO_FTP, CURLPROTO_FTPS, CURLPROTO_SCP, CURLPROTO_SFTP,
2589   CURLPROTO_TELNET, CURLPROTO_LDAP, CURLPROTO_LDAPS, CURLPROTO_DICT, CURLPROTO_FILE, CURLPROTO_TFTP,
2590 /* factor out with autoconf? */
2591 #if defined(CURLPROTO_IMAP)
2592   CURLPROTO_IMAP,
2593 #else
2594   0,
2595 #endif
2596 #if defined(CURLPROTO_IMAPS)
2597   CURLPROTO_IMAPS,
2598 #else
2599   0,
2600 #endif
2601 #if defined(CURLPROTO_POP3)
2602   CURLPROTO_POP3,
2603 #else
2604   0,
2605 #endif
2606 #if defined(CURLPROTO_POP3S)
2607   CURLPROTO_POP3S,
2608 #else
2609   0,
2610 #endif
2611 #if defined(CURLPROTO_SMTP)
2612   CURLPROTO_SMTP,
2613 #else
2614   0,
2615 #endif
2616 #if defined(CURLPROTO_SMTPS)
2617   CURLPROTO_SMTPS,
2618 #else
2619   0,
2620 #endif
2621 #if defined(CURLPROTO_RTSP)
2622   CURLPROTO_RTSP,
2623 #else
2624   0,
2625 #endif
2626 #if defined(CURLPROTO_RTMP)
2627   CURLPROTO_RTMP,
2628 #else
2629   0,
2630 #endif
2631 #if defined(CURLPROTO_RTMPT)
2632   CURLPROTO_RTMPT,
2633 #else
2634   0,
2635 #endif
2636 #if defined(CURLPROTO_RTMPE)
2637   CURLPROTO_RTMPE,
2638 #else
2639   0,
2640 #endif
2641 #if defined(CURLPROTO_RTMPTE)
2642   CURLPROTO_RTMPTE,
2643 #else
2644   0,
2645 #endif
2646 #if defined(CURLPROTO_RTMPS)
2647   CURLPROTO_RTMPS,
2648 #else
2649   0,
2650 #endif
2651 #if defined(CURLPROTO_RTMPTS)
2652   CURLPROTO_RTMPTS,
2653 #else
2654   0,
2655 #endif
2656 #if defined(CURLPROTO_GOPHER)
2657   CURLPROTO_GOPHER,
2658 #else
2659   0,
2660 #endif
2661 };
2662
2663 static void handle_PROTOCOLSOPTION(CURLoption curlopt, Connection *conn, value option)
2664 {
2665     CAMLparam1(option);
2666     CURLcode result = CURLE_OK;
2667     long protocols = 0;
2668     int index;
2669
2670     while (Val_emptylist != option)
2671     {
2672         index = Int_val(Field(option, 0));
2673         if ((index < 0) || ((size_t)index >= sizeof(protoMap) / sizeof(protoMap[0])))
2674           failwith("Invalid curl protocol");
2675
2676         protocols = protocols | protoMap[index];
2677
2678         option = Field(option, 1);
2679     }
2680
2681     result = curl_easy_setopt(conn->connection,
2682                               curlopt,
2683                               protocols);
2684
2685     if (result != CURLE_OK)
2686         raiseError(conn, result);
2687
2688     CAMLreturn0;
2689 }
2690 #endif
2691
2692 #if HAVE_DECL_CURLOPT_PROTOCOLS
2693 static void handle_PROTOCOLS(Connection *conn, value option)
2694 {
2695   handle_PROTOCOLSOPTION(CURLOPT_PROTOCOLS, conn, option);
2696 }
2697 #endif
2698
2699 #if HAVE_DECL_CURLOPT_REDIR_PROTOCOLS
2700 static void handle_REDIR_PROTOCOLS(Connection *conn, value option)
2701 {
2702   handle_PROTOCOLSOPTION(CURLOPT_REDIR_PROTOCOLS, conn, option);
2703 }
2704 #endif
2705
2706 #if HAVE_DECL_CURLOPT_RESOLVE
2707 SETOPT_SLIST( RESOLVE)
2708 #endif
2709
2710 #if HAVE_DECL_CURLOPT_DNS_SERVERS
2711 SETOPT_STRING( DNS_SERVERS)
2712 #endif
2713
2714 #if HAVE_DECL_CURLOPT_MAIL_FROM
2715 SETOPT_STRING( MAIL_FROM)
2716 #endif
2717
2718 #if HAVE_DECL_CURLOPT_MAIL_RCPT
2719 SETOPT_SLIST( MAIL_RCPT)
2720 #endif
2721
2722 static Connection *duplicateConnection(Connection *original)
2723 {
2724     Connection *connection;
2725     CURL* h;
2726
2727     caml_enter_blocking_section();
2728     h  = curl_easy_duphandle(original->connection);
2729     caml_leave_blocking_section();
2730
2731     connection = allocConnection(h);
2732
2733     Store_field(connection->ocamlValues, Ocaml_WRITEFUNCTION,
2734                 Field(original->ocamlValues, Ocaml_WRITEFUNCTION));
2735     Store_field(connection->ocamlValues, Ocaml_READFUNCTION,
2736                 Field(original->ocamlValues, Ocaml_READFUNCTION));
2737     Store_field(connection->ocamlValues, Ocaml_ERRORBUFFER,
2738                 Field(original->ocamlValues, Ocaml_ERRORBUFFER));
2739     Store_field(connection->ocamlValues, Ocaml_POSTFIELDS,
2740                 Field(original->ocamlValues, Ocaml_POSTFIELDS));
2741     Store_field(connection->ocamlValues, Ocaml_HTTPHEADER,
2742                 Field(original->ocamlValues, Ocaml_HTTPHEADER));
2743     Store_field(connection->ocamlValues, Ocaml_QUOTE,
2744                 Field(original->ocamlValues, Ocaml_QUOTE));
2745     Store_field(connection->ocamlValues, Ocaml_POSTQUOTE,
2746                 Field(original->ocamlValues, Ocaml_POSTQUOTE));
2747     Store_field(connection->ocamlValues, Ocaml_HEADERFUNCTION,
2748                 Field(original->ocamlValues, Ocaml_HEADERFUNCTION));
2749     Store_field(connection->ocamlValues, Ocaml_PROGRESSFUNCTION,
2750                 Field(original->ocamlValues, Ocaml_PROGRESSFUNCTION));
2751     Store_field(connection->ocamlValues, Ocaml_DEBUGFUNCTION,
2752                 Field(original->ocamlValues, Ocaml_DEBUGFUNCTION));
2753     Store_field(connection->ocamlValues, Ocaml_HTTP200ALIASES,
2754                 Field(original->ocamlValues, Ocaml_HTTP200ALIASES));
2755     Store_field(connection->ocamlValues, Ocaml_IOCTLFUNCTION,
2756                 Field(original->ocamlValues, Ocaml_IOCTLFUNCTION));
2757     Store_field(connection->ocamlValues, Ocaml_SEEKFUNCTION,
2758                 Field(original->ocamlValues, Ocaml_SEEKFUNCTION));
2759
2760     if (Field(original->ocamlValues, Ocaml_URL) != Val_unit)
2761         handle_URL(connection, Field(original->ocamlValues,
2762                                     Ocaml_URL));
2763     if (Field(original->ocamlValues, Ocaml_PROXY) != Val_unit)
2764         handle_PROXY(connection, Field(original->ocamlValues,
2765                                       Ocaml_PROXY));
2766     if (Field(original->ocamlValues, Ocaml_USERPWD) != Val_unit)
2767         handle_USERPWD(connection, Field(original->ocamlValues,
2768                                         Ocaml_USERPWD));
2769     if (Field(original->ocamlValues, Ocaml_PROXYUSERPWD) != Val_unit)
2770         handle_PROXYUSERPWD(connection, Field(original->ocamlValues,
2771                                              Ocaml_PROXYUSERPWD));
2772     if (Field(original->ocamlValues, Ocaml_RANGE) != Val_unit)
2773         handle_RANGE(connection, Field(original->ocamlValues,
2774                                       Ocaml_RANGE));
2775     if (Field(original->ocamlValues, Ocaml_ERRORBUFFER) != Val_unit)
2776         handle_ERRORBUFFER(connection, Field(original->ocamlValues,
2777                                             Ocaml_ERRORBUFFER));
2778     if (Field(original->ocamlValues, Ocaml_POSTFIELDS) != Val_unit)
2779         handle_POSTFIELDS(connection, Field(original->ocamlValues,
2780                                            Ocaml_POSTFIELDS));
2781     if (Field(original->ocamlValues, Ocaml_REFERER) != Val_unit)
2782         handle_REFERER(connection, Field(original->ocamlValues,
2783                                         Ocaml_REFERER));
2784     if (Field(original->ocamlValues, Ocaml_USERAGENT) != Val_unit)
2785         handle_USERAGENT(connection, Field(original->ocamlValues,
2786                                           Ocaml_USERAGENT));
2787     if (Field(original->ocamlValues, Ocaml_FTPPORT) != Val_unit)
2788         handle_FTPPORT(connection, Field(original->ocamlValues,
2789                                         Ocaml_FTPPORT));
2790     if (Field(original->ocamlValues, Ocaml_COOKIE) != Val_unit)
2791         handle_COOKIE(connection, Field(original->ocamlValues,
2792                                        Ocaml_COOKIE));
2793     if (Field(original->ocamlValues, Ocaml_HTTPHEADER) != Val_unit)
2794         handle_HTTPHEADER(connection, Field(original->ocamlValues,
2795                                            Ocaml_HTTPHEADER));
2796     if (Field(original->ocamlValues, Ocaml_HTTPPOST) != Val_unit)
2797         handle_HTTPPOST(connection, Field(original->ocamlValues,
2798                                          Ocaml_HTTPPOST));
2799     if (Field(original->ocamlValues, Ocaml_SSLCERT) != Val_unit)
2800         handle_SSLCERT(connection, Field(original->ocamlValues,
2801                                         Ocaml_SSLCERT));
2802     if (Field(original->ocamlValues, Ocaml_SSLCERTTYPE) != Val_unit)
2803         handle_SSLCERTTYPE(connection, Field(original->ocamlValues,
2804                                             Ocaml_SSLCERTTYPE));
2805     if (Field(original->ocamlValues, Ocaml_SSLCERTPASSWD) != Val_unit)
2806         handle_SSLCERTPASSWD(connection, Field(original->ocamlValues,
2807                                               Ocaml_SSLCERTPASSWD));
2808     if (Field(original->ocamlValues, Ocaml_SSLKEY) != Val_unit)
2809         handle_SSLKEY(connection, Field(original->ocamlValues,
2810                                        Ocaml_SSLKEY));
2811     if (Field(original->ocamlValues, Ocaml_SSLKEYTYPE) != Val_unit)
2812         handle_SSLKEYTYPE(connection, Field(original->ocamlValues,
2813                                            Ocaml_SSLKEYTYPE));
2814     if (Field(original->ocamlValues, Ocaml_SSLKEYPASSWD) != Val_unit)
2815         handle_SSLKEYPASSWD(connection, Field(original->ocamlValues,
2816                                              Ocaml_SSLKEYPASSWD));
2817     if (Field(original->ocamlValues, Ocaml_SSLENGINE) != Val_unit)
2818         handle_SSLENGINE(connection, Field(original->ocamlValues,
2819                                           Ocaml_SSLENGINE));
2820     if (Field(original->ocamlValues, Ocaml_QUOTE) != Val_unit)
2821         handle_QUOTE(connection, Field(original->ocamlValues,
2822                                       Ocaml_QUOTE));
2823     if (Field(original->ocamlValues, Ocaml_POSTQUOTE) != Val_unit)
2824         handle_POSTQUOTE(connection, Field(original->ocamlValues,
2825                                           Ocaml_POSTQUOTE));
2826     if (Field(original->ocamlValues, Ocaml_COOKIEFILE) != Val_unit)
2827         handle_COOKIEFILE(connection, Field(original->ocamlValues,
2828                                            Ocaml_COOKIEFILE));
2829     if (Field(original->ocamlValues, Ocaml_CUSTOMREQUEST) != Val_unit)
2830         handle_CUSTOMREQUEST(connection, Field(original->ocamlValues,
2831                                               Ocaml_CUSTOMREQUEST));
2832     if (Field(original->ocamlValues, Ocaml_INTERFACE) != Val_unit)
2833         handle_INTERFACE(connection, Field(original->ocamlValues,
2834                                           Ocaml_INTERFACE));
2835     if (Field(original->ocamlValues, Ocaml_CAINFO) != Val_unit)
2836         handle_CAINFO(connection, Field(original->ocamlValues,
2837                                        Ocaml_CAINFO));
2838     if (Field(original->ocamlValues, Ocaml_CAPATH) != Val_unit)
2839         handle_CAPATH(connection, Field(original->ocamlValues,
2840                                        Ocaml_CAPATH));
2841     if (Field(original->ocamlValues, Ocaml_RANDOM_FILE) != Val_unit)
2842         handle_RANDOM_FILE(connection, Field(original->ocamlValues,
2843                                            Ocaml_RANDOM_FILE));
2844     if (Field(original->ocamlValues, Ocaml_EGDSOCKET) != Val_unit)
2845         handle_EGDSOCKET(connection, Field(original->ocamlValues,
2846                                           Ocaml_EGDSOCKET));
2847     if (Field(original->ocamlValues, Ocaml_COOKIEJAR) != Val_unit)
2848         handle_COOKIEJAR(connection, Field(original->ocamlValues,
2849                                           Ocaml_COOKIEJAR));
2850     if (Field(original->ocamlValues, Ocaml_SSL_CIPHER_LIST) != Val_unit)
2851         handle_SSL_CIPHER_LIST(connection, Field(original->ocamlValues,
2852                                               Ocaml_SSL_CIPHER_LIST));
2853     if (Field(original->ocamlValues, Ocaml_PRIVATE) != Val_unit)
2854         handle_PRIVATE(connection, Field(original->ocamlValues,
2855                                         Ocaml_PRIVATE));
2856     if (Field(original->ocamlValues, Ocaml_HTTP200ALIASES) != Val_unit)
2857         handle_HTTP200ALIASES(connection, Field(original->ocamlValues,
2858                                                Ocaml_HTTP200ALIASES));
2859     if (Field(original->ocamlValues, Ocaml_NETRC_FILE) != Val_unit)
2860         handle_NETRC_FILE(connection, Field(original->ocamlValues,
2861                                           Ocaml_NETRC_FILE));
2862     if (Field(original->ocamlValues, Ocaml_FTP_ACCOUNT) != Val_unit)
2863         handle_FTP_ACCOUNT(connection, Field(original->ocamlValues,
2864                                            Ocaml_FTP_ACCOUNT));
2865     if (Field(original->ocamlValues, Ocaml_COOKIELIST) != Val_unit)
2866         handle_COOKIELIST(connection, Field(original->ocamlValues,
2867                                            Ocaml_COOKIELIST));
2868     if (Field(original->ocamlValues, Ocaml_FTP_ALTERNATIVE_TO_USER) != Val_unit)
2869         handle_FTP_ALTERNATIVE_TO_USER(connection,
2870                                    Field(original->ocamlValues,
2871                                          Ocaml_FTP_ALTERNATIVE_TO_USER));
2872     if (Field(original->ocamlValues, Ocaml_SSH_PUBLIC_KEYFILE) != Val_unit)
2873         handle_SSH_PUBLIC_KEYFILE(connection,
2874                                Field(original->ocamlValues,
2875                                      Ocaml_SSH_PUBLIC_KEYFILE));
2876     if (Field(original->ocamlValues, Ocaml_SSH_PRIVATE_KEYFILE) != Val_unit)
2877         handle_SSH_PRIVATE_KEYFILE(connection,
2878                                 Field(original->ocamlValues,
2879                                       Ocaml_SSH_PRIVATE_KEYFILE));
2880     if (Field(original->ocamlValues, Ocaml_COPYPOSTFIELDS) != Val_unit)
2881         handle_COPYPOSTFIELDS(connection,
2882                              Field(original->ocamlValues,
2883                                    Ocaml_COPYPOSTFIELDS));
2884     if (Field(original->ocamlValues, Ocaml_DNS_SERVERS) != Val_unit)
2885         handle_DNS_SERVERS(connection,
2886                          Field(original->ocamlValues,
2887                                Ocaml_DNS_SERVERS));
2888     if (Field(original->ocamlValues, Ocaml_MAIL_FROM) != Val_unit)
2889         handle_MAIL_FROM(connection,
2890                        Field(original->ocamlValues,
2891                              Ocaml_MAIL_FROM));
2892     if (Field(original->ocamlValues, Ocaml_MAIL_RCPT) != Val_unit)
2893         handle_MAIL_RCPT(connection,
2894                        Field(original->ocamlValues,
2895                              Ocaml_MAIL_RCPT));
2896
2897     return connection;
2898 }
2899
2900 /**
2901  **  curl_easy_setopt helper function
2902  **/
2903
2904 #define MAP(name) { handle_ ## name, "CURLOPT_"#name /*, CURLOPT_##name */ }
2905 #define MAP_NO(name) { NULL, "CURLOPT_"#name /*, CURLOPT_##name */ }
2906
2907 CURLOptionMapping implementedOptionMap[] =
2908 {
2909   MAP(WRITEFUNCTION),
2910   MAP(READFUNCTION),
2911   MAP(INFILESIZE),
2912   MAP(URL),
2913   MAP(PROXY),
2914   MAP(PROXYPORT),
2915   MAP(HTTPPROXYTUNNEL),
2916   MAP(VERBOSE),
2917   MAP(HEADER),
2918   MAP(NOPROGRESS),
2919 #if HAVE_DECL_CURLOPT_NOSIGNAL
2920   MAP(NOSIGNAL),
2921 #else
2922   MAP_NO(NOSIGNAL),
2923 #endif
2924   MAP(NOBODY),
2925   MAP(FAILONERROR),
2926   MAP(UPLOAD),
2927   MAP(POST),
2928   MAP(FTPLISTONLY),
2929   MAP(FTPAPPEND),
2930   MAP(NETRC),
2931 #if HAVE_DECL_CURLOPT_ENCODING
2932   MAP(ENCODING),
2933 #else
2934   MAP_NO(ENCODING),
2935 #endif
2936   MAP(FOLLOWLOCATION),
2937   MAP(TRANSFERTEXT),
2938   MAP(PUT),
2939   MAP(USERPWD),
2940   MAP(PROXYUSERPWD),
2941   MAP(RANGE),
2942   MAP(ERRORBUFFER),
2943   MAP(TIMEOUT),
2944   MAP(POSTFIELDS),
2945   MAP(POSTFIELDSIZE),
2946   MAP(REFERER),
2947   MAP(USERAGENT),
2948   MAP(FTPPORT),
2949   MAP(LOW_SPEED_LIMIT),
2950   MAP(LOW_SPEED_TIME),
2951   MAP(RESUME_FROM),
2952   MAP(COOKIE),
2953   MAP(HTTPHEADER),
2954   MAP(HTTPPOST),
2955   MAP(SSLCERT),
2956   MAP(SSLCERTTYPE),
2957   MAP(SSLCERTPASSWD),
2958   MAP(SSLKEY),
2959   MAP(SSLKEYTYPE),
2960   MAP(SSLKEYPASSWD),
2961   MAP(SSLENGINE),
2962   MAP(SSLENGINE_DEFAULT),
2963   MAP(CRLF),
2964   MAP(QUOTE),
2965   MAP(POSTQUOTE),
2966   MAP(HEADERFUNCTION),
2967   MAP(COOKIEFILE),
2968   MAP(SSLVERSION),
2969   MAP(TIMECONDITION),
2970   MAP(TIMEVALUE),
2971   MAP(CUSTOMREQUEST),
2972   MAP(INTERFACE),
2973   MAP(KRB4LEVEL),
2974   MAP(PROGRESSFUNCTION),
2975   MAP(SSL_VERIFYPEER),
2976   MAP(CAINFO),
2977   MAP(CAPATH),
2978   MAP(FILETIME),
2979   MAP(MAXREDIRS),
2980   MAP(MAXCONNECTS),
2981   MAP(CLOSEPOLICY),
2982   MAP(FRESH_CONNECT),
2983   MAP(FORBID_REUSE),
2984   MAP(RANDOM_FILE),
2985   MAP(EGDSOCKET),
2986   MAP(CONNECTTIMEOUT),
2987   MAP(HTTPGET),
2988   MAP(SSL_VERIFYHOST),
2989   MAP(COOKIEJAR),
2990   MAP(SSL_CIPHER_LIST),
2991   MAP(HTTP_VERSION),
2992   MAP(FTP_USE_EPSV),
2993   MAP(DNS_CACHE_TIMEOUT),
2994   MAP(DNS_USE_GLOBAL_CACHE),
2995   MAP(DEBUGFUNCTION),
2996 #if HAVE_DECL_CURLOPT_PRIVATE
2997   MAP(PRIVATE),
2998 #else
2999   MAP_NO(PRIVATE),
3000 #endif
3001 #if HAVE_DECL_CURLOPT_HTTP200ALIASES
3002   MAP(HTTP200ALIASES),
3003 #else
3004   MAP_NO(HTTP200ALIASES),
3005 #endif
3006 #if HAVE_DECL_CURLOPT_UNRESTRICTED_AUTH
3007   MAP(UNRESTRICTED_AUTH),
3008 #else
3009   MAP_NO(UNRESTRICTED_AUTH),
3010 #endif
3011 #if HAVE_DECL_CURLOPT_FTP_USE_EPRT
3012   MAP(FTP_USE_EPRT),
3013 #else
3014   MAP_NO(FTP_USE_EPRT),
3015 #endif
3016 #if HAVE_DECL_CURLOPT_HTTPAUTH
3017   MAP(HTTPAUTH),
3018 #else
3019   MAP_NO(HTTPAUTH),
3020 #endif
3021 #if HAVE_DECL_CURLOPT_FTP_CREATE_MISSING_DIRS
3022   MAP(FTP_CREATE_MISSING_DIRS),
3023 #else
3024   MAP_NO(FTP_CREATE_MISSING_DIRS),
3025 #endif
3026 #if HAVE_DECL_CURLOPT_PROXYAUTH
3027   MAP(PROXYAUTH),
3028 #else
3029   MAP_NO(PROXYAUTH),
3030 #endif
3031 #if HAVE_DECL_CURLOPT_FTP_RESPONSE_TIMEOUT
3032   MAP(FTP_RESPONSE_TIMEOUT),
3033 #else
3034   MAP_NO(FTP_RESPONSE_TIMEOUT),
3035 #endif
3036 #if HAVE_DECL_CURLOPT_IPRESOLVE
3037   MAP(IPRESOLVE),
3038 #else
3039   MAP_NO(IPRESOLVE),
3040 #endif
3041 #if HAVE_DECL_CURLOPT_MAXFILESIZE
3042   MAP(MAXFILESIZE),
3043 #else
3044   MAP_NO(MAXFILESIZE),
3045 #endif
3046 #if HAVE_DECL_CURLOPT_INFILESIZE_LARGE
3047   MAP(INFILESIZE_LARGE),
3048 #else
3049   MAP_NO(INFILESIZE_LARGE),
3050 #endif
3051 #if HAVE_DECL_CURLOPT_RESUME_FROM_LARGE
3052   MAP(RESUME_FROM_LARGE),
3053 #else
3054   MAP_NO(RESUME_FROM_LARGE),
3055 #endif
3056 #if HAVE_DECL_CURLOPT_MAXFILESIZE_LARGE
3057   MAP(MAXFILESIZE_LARGE),
3058 #else
3059   MAP_NO(MAXFILESIZE_LARGE),
3060 #endif
3061 #if HAVE_DECL_CURLOPT_NETRC_FILE
3062   MAP(NETRC_FILE),
3063 #else
3064   MAP_NO(NETRC_FILE),
3065 #endif
3066 #if HAVE_DECL_CURLOPT_FTP_SSL
3067   MAP(FTP_SSL),
3068 #else
3069   MAP_NO(FTP_SSL),
3070 #endif
3071 #if HAVE_DECL_CURLOPT_POSTFIELDSIZE_LARGE
3072   MAP(POSTFIELDSIZE_LARGE),
3073 #else
3074   MAP_NO(POSTFIELDSIZE_LARGE),
3075 #endif
3076 #if HAVE_DECL_CURLOPT_TCP_NODELAY
3077   MAP(TCP_NODELAY),
3078 #else
3079   MAP_NO(TCP_NODELAY),
3080 #endif
3081 #if HAVE_DECL_CURLOPT_FTPSSLAUTH
3082   MAP(FTPSSLAUTH),
3083 #else
3084   MAP_NO(FTPSSLAUTH),
3085 #endif
3086 #if HAVE_DECL_CURLOPT_IOCTLFUNCTION
3087   MAP(IOCTLFUNCTION),
3088 #else
3089   MAP_NO(IOCTLFUNCTION),
3090 #endif
3091 #if HAVE_DECL_CURLOPT_FTP_ACCOUNT
3092   MAP(FTP_ACCOUNT),
3093 #else
3094   MAP_NO(FTP_ACCOUNT),
3095 #endif
3096 #if HAVE_DECL_CURLOPT_COOKIELIST
3097   MAP(COOKIELIST),
3098 #else
3099   MAP_NO(COOKIELIST),
3100 #endif
3101 #if HAVE_DECL_CURLOPT_IGNORE_CONTENT_LENGTH
3102   MAP(IGNORE_CONTENT_LENGTH),
3103 #else
3104   MAP_NO(IGNORE_CONTENT_LENGTH),
3105 #endif
3106 #if HAVE_DECL_CURLOPT_FTP_SKIP_PASV_IP
3107   MAP(FTP_SKIP_PASV_IP),
3108 #else
3109   MAP_NO(FTP_SKIP_PASV_IP),
3110 #endif
3111 #if HAVE_DECL_CURLOPT_FTP_FILEMETHOD
3112   MAP(FTP_FILEMETHOD),
3113 #else
3114   MAP_NO(FTP_FILEMETHOD),
3115 #endif
3116 #if HAVE_DECL_CURLOPT_LOCALPORT
3117   MAP(LOCALPORT),
3118 #else
3119   MAP_NO(LOCALPORT),
3120 #endif
3121 #if HAVE_DECL_CURLOPT_LOCALPORTRANGE
3122   MAP(LOCALPORTRANGE),
3123 #else
3124   MAP_NO(LOCALPORTRANGE),
3125 #endif
3126 #if HAVE_DECL_CURLOPT_CONNECT_ONLY
3127   MAP(CONNECT_ONLY),
3128 #else
3129   MAP_NO(CONNECT_ONLY),
3130 #endif
3131 #if HAVE_DECL_CURLOPT_MAX_SEND_SPEED_LARGE
3132   MAP(MAX_SEND_SPEED_LARGE),
3133 #else
3134   MAP_NO(MAX_SEND_SPEED_LARGE),
3135 #endif
3136 #if HAVE_DECL_CURLOPT_MAX_RECV_SPEED_LARGE
3137   MAP(MAX_RECV_SPEED_LARGE),
3138 #else
3139   MAP_NO(MAX_RECV_SPEED_LARGE),
3140 #endif
3141 #if HAVE_DECL_CURLOPT_FTP_ALTERNATIVE_TO_USER
3142   MAP(FTP_ALTERNATIVE_TO_USER),
3143 #else
3144   MAP_NO(FTP_ALTERNATIVE_TO_USER),
3145 #endif
3146 #if HAVE_DECL_CURLOPT_SSL_SESSIONID_CACHE
3147   MAP(SSL_SESSIONID_CACHE),
3148 #else
3149   MAP_NO(SSL_SESSIONID_CACHE),
3150 #endif
3151 #if HAVE_DECL_CURLOPT_SSH_AUTH_TYPES
3152   MAP(SSH_AUTH_TYPES),
3153 #else
3154   MAP_NO(SSH_AUTH_TYPES),
3155 #endif
3156 #if HAVE_DECL_CURLOPT_SSH_PUBLIC_KEYFILE
3157   MAP(SSH_PUBLIC_KEYFILE),
3158 #else
3159   MAP_NO(SSH_PUBLIC_KEYFILE),
3160 #endif
3161 #if HAVE_DECL_CURLOPT_SSH_PRIVATE_KEYFILE
3162   MAP(SSH_PRIVATE_KEYFILE),
3163 #else
3164   MAP_NO(SSH_PRIVATE_KEYFILE),
3165 #endif
3166 #if HAVE_DECL_CURLOPT_FTP_SSL_CCC
3167   MAP(FTP_SSL_CCC),
3168 #else
3169   MAP_NO(FTP_SSL_CCC),
3170 #endif
3171 #if HAVE_DECL_CURLOPT_TIMEOUT_MS
3172   MAP(TIMEOUT_MS),
3173 #else
3174   MAP_NO(TIMEOUT_MS),
3175 #endif
3176 #if HAVE_DECL_CURLOPT_CONNECTTIMEOUT_MS
3177   MAP(CONNECTTIMEOUT_MS),
3178 #else
3179   MAP_NO(CONNECTTIMEOUT_MS),
3180 #endif
3181 #if HAVE_DECL_CURLOPT_HTTP_TRANSFER_DECODING
3182   MAP(HTTP_TRANSFER_DECODING),
3183 #else
3184   MAP_NO(HTTP_TRANSFER_DECODING),
3185 #endif
3186 #if HAVE_DECL_CURLOPT_HTTP_CONTENT_DECODING
3187   MAP(HTTP_CONTENT_DECODING),
3188 #else
3189   MAP_NO(HTTP_CONTENT_DECODING),
3190 #endif
3191 #if HAVE_DECL_CURLOPT_NEW_FILE_PERMS
3192   MAP(NEW_FILE_PERMS),
3193 #else
3194   MAP_NO(NEW_FILE_PERMS),
3195 #endif
3196 #if HAVE_DECL_CURLOPT_NEW_DIRECTORY_PERMS
3197   MAP(NEW_DIRECTORY_PERMS),
3198 #else
3199   MAP_NO(NEW_DIRECTORY_PERMS),
3200 #endif
3201 #if HAVE_DECL_CURLOPT_POST301
3202   MAP(POST301),
3203 #else
3204   MAP_NO(POST301),
3205 #endif
3206 #if HAVE_DECL_CURLOPT_SSH_HOST_PUBLIC_KEY_MD5
3207   MAP(SSH_HOST_PUBLIC_KEY_MD5),
3208 #else
3209   MAP_NO(SSH_HOST_PUBLIC_KEY_MD5),
3210 #endif
3211 #if HAVE_DECL_CURLOPT_COPYPOSTFIELDS
3212   MAP(COPYPOSTFIELDS),
3213 #else
3214   MAP_NO(COPYPOSTFIELDS),
3215 #endif
3216 #if HAVE_DECL_CURLOPT_PROXY_TRANSFER_MODE
3217   MAP(PROXY_TRANSFER_MODE),
3218 #else
3219   MAP_NO(PROXY_TRANSFER_MODE),
3220 #endif
3221 #if HAVE_DECL_CURLOPT_SEEKFUNCTION
3222   MAP(SEEKFUNCTION),
3223 #else
3224   MAP_NO(SEEKFUNCTION),
3225 #endif
3226 #if HAVE_DECL_CURLOPT_AUTOREFERER
3227   MAP(AUTOREFERER),
3228 #else
3229   MAP_NO(AUTOREFERER),
3230 #endif
3231 #if HAVE_DECL_CURLOPT_OPENSOCKETFUNCTION
3232   MAP(OPENSOCKETFUNCTION),
3233 #else
3234   MAP_NO(OPENSOCKETFUNCTION),
3235 #endif
3236 #if HAVE_DECL_CURLOPT_PROXYTYPE
3237   MAP(PROXYTYPE),
3238 #else
3239   MAP_NO(PROXYTYPE),
3240 #endif
3241 #if HAVE_DECL_CURLOPT_PROTOCOLS
3242   MAP(PROTOCOLS),
3243 #else
3244   MAP_NO(PROTOCOLS),
3245 #endif
3246 #if HAVE_DECL_CURLOPT_REDIR_PROTOCOLS
3247   MAP(REDIR_PROTOCOLS),
3248 #else
3249   MAP_NO(REDIR_PROTOCOLS),
3250 #endif
3251 #if HAVE_DECL_CURLOPT_RESOLVE
3252   MAP(RESOLVE),
3253 #else
3254   MAP_NO(RESOLVE),
3255 #endif
3256 #if HAVE_DECL_CURLOPT_DNS_SERVERS
3257   MAP(DNS_SERVERS),
3258 #else
3259   MAP_NO(DNS_SERVERS),
3260 #endif
3261 #if HAVE_DECL_CURLOPT_MAIL_FROM
3262   MAP(MAIL_FROM),
3263 #else
3264   MAP_NO(MAIL_FROM),
3265 #endif
3266 #if HAVE_DECL_CURLOPT_MAIL_RCPT
3267   MAP(MAIL_RCPT),
3268 #else
3269   MAP_NO(MAIL_RCPT),
3270 #endif
3271 };
3272
3273 CAMLprim value helper_curl_easy_setopt(value conn, value option)
3274 {
3275     CAMLparam2(conn, option);
3276     CAMLlocal1(data);
3277     Connection *connection = Connection_val(conn);
3278     CURLOptionMapping* thisOption = NULL;
3279     static value* exception = NULL;
3280
3281     checkConnection(connection);
3282
3283     if (!Is_block(option))
3284         failwith("Not a block");
3285
3286     if (Wosize_val(option) < 1)
3287         failwith("Insufficient data in block");
3288
3289     data = Field(option, 0);
3290
3291     if (Tag_val(option) < sizeof(implementedOptionMap)/sizeof(CURLOptionMapping))
3292     {
3293       thisOption = &implementedOptionMap[Tag_val(option)];
3294       if (thisOption->optionHandler)
3295         thisOption->optionHandler(connection, data);
3296       else
3297       {
3298         if (NULL == exception)
3299         {
3300           exception = caml_named_value("Curl.NotImplemented");
3301           if (NULL == exception) caml_invalid_argument("Curl.NotImplemented");
3302         }
3303
3304         caml_raise_with_string(*exception, thisOption->name);
3305       }
3306     }
3307     else
3308       failwith("Invalid CURLOPT Option");
3309
3310     CAMLreturn(Val_unit);
3311 }
3312
3313 /**
3314  **  curl_easy_perform helper function
3315  **/
3316
3317 CAMLprim value helper_curl_easy_perform(value conn)
3318 {
3319     CAMLparam1(conn);
3320     CURLcode result = CURLE_OK;
3321     Connection *connection = Connection_val(conn);
3322
3323     checkConnection(connection);
3324
3325     enter_blocking_section();
3326     result = curl_easy_perform(connection->connection);
3327     leave_blocking_section();
3328
3329     if (result != CURLE_OK)
3330         raiseError(connection, result);
3331
3332     CAMLreturn(Val_unit);
3333 }
3334
3335 /**
3336  **  curl_easy_cleanup helper function
3337  **/
3338
3339 CAMLprim value helper_curl_easy_cleanup(value conn)
3340 {
3341     CAMLparam1(conn);
3342     Connection *connection = Connection_val(conn);
3343
3344     checkConnection(connection);
3345
3346     removeConnection(connection, 0);
3347
3348     CAMLreturn(Val_unit);
3349 }
3350
3351 /**
3352  **  curl_easy_duphandle helper function
3353  **/
3354
3355 CAMLprim value helper_curl_easy_duphandle(value conn)
3356 {
3357     CAMLparam1(conn);
3358     CAMLlocal1(result);
3359     Connection *connection = Connection_val(conn);
3360
3361     checkConnection(connection);
3362
3363     result = caml_curl_alloc(duplicateConnection(connection));
3364
3365     CAMLreturn(result);
3366 }
3367
3368 /**
3369  **  curl_easy_getinfo helper function
3370  **/
3371
3372 enum GetInfoResultType {
3373     StringValue, LongValue, DoubleValue, StringListValue
3374 };
3375
3376 value convertStringList(struct curl_slist *slist)
3377 {
3378     CAMLparam0();
3379     CAMLlocal3(result, current, next);
3380     struct curl_slist *p = slist;
3381
3382     result = Val_int(0);
3383     current = Val_int(0);
3384     next = Val_int(0);
3385
3386     while (p != NULL)
3387     {
3388         next = alloc_tuple(2);
3389         Store_field(next, 0, copy_string(p->data));
3390         Store_field(next, 1, Val_int(0));
3391
3392         if (result == Val_int(0))
3393             result = next;
3394
3395         if (current != Val_int(0))
3396             Store_field(current, 1, next);
3397
3398         current = next;
3399
3400         p = p->next;
3401     }
3402
3403     curl_slist_free_all(slist);
3404
3405     CAMLreturn(result);
3406 }
3407
3408 CAMLprim value helper_curl_easy_getinfo(value conn, value option)
3409 {
3410     CAMLparam2(conn, option);
3411     CAMLlocal1(result);
3412     CURLcode curlResult;
3413     Connection *connection = Connection_val(conn);
3414     enum GetInfoResultType resultType;
3415     char *strValue = NULL;
3416     double doubleValue;
3417     long longValue;
3418     struct curl_slist *stringListValue = NULL;
3419
3420     checkConnection(connection);
3421
3422     switch(Long_val(option))
3423     {
3424 #if HAVE_DECL_CURLINFO_EFFECTIVE_URL
3425     case 0: /* CURLINFO_EFFECTIVE_URL */
3426         resultType = StringValue;
3427
3428         curlResult = curl_easy_getinfo(connection->connection,
3429                                        CURLINFO_EFFECTIVE_URL,
3430                                        &strValue);
3431         break;
3432 #else
3433 #pragma message("libcurl does not provide CURLINFO_EFFECTIVE_URL")
3434 #endif
3435
3436 #if HAVE_DECL_CURLINFO_RESPONSE_CODE || HAVE_DECL_CURLINFO_HTTP_CODE
3437     case 1: /* CURLINFO_HTTP_CODE */
3438     case 2: /* CURLINFO_RESPONSE_CODE */
3439 #if HAVE_DECL_CURLINFO_RESPONSE_CODE
3440         resultType = LongValue;
3441
3442         curlResult = curl_easy_getinfo(connection->connection,
3443                                        CURLINFO_RESPONSE_CODE,
3444                                        &longValue);
3445 #else
3446         resultType = LongValue;
3447
3448         curlResult = curl_easy_getinfo(connection->connection,
3449                                        CURLINFO_HTTP_CODE,
3450                                        &longValue);
3451 #endif
3452         break;
3453 #endif
3454
3455 #if HAVE_DECL_CURLINFO_TOTAL_TIME
3456     case 3: /* CURLINFO_TOTAL_TIME */
3457         resultType = DoubleValue;
3458
3459         curlResult = curl_easy_getinfo(connection->connection,
3460                                        CURLINFO_TOTAL_TIME,
3461                                        &doubleValue);
3462         break;
3463 #endif
3464
3465 #if HAVE_DECL_CURLINFO_NAMELOOKUP_TIME
3466     case 4: /* CURLINFO_NAMELOOKUP_TIME */
3467         resultType = DoubleValue;
3468
3469         curlResult = curl_easy_getinfo(connection->connection,
3470                                        CURLINFO_NAMELOOKUP_TIME,
3471                                        &doubleValue);
3472         break;
3473 #endif
3474
3475 #if HAVE_DECL_CURLINFO_CONNECT_TIME
3476     case 5: /* CURLINFO_CONNECT_TIME */
3477         resultType = DoubleValue;
3478
3479         curlResult = curl_easy_getinfo(connection->connection,
3480                                        CURLINFO_CONNECT_TIME,
3481                                        &doubleValue);
3482         break;
3483 #endif
3484
3485 #if HAVE_DECL_CURLINFO_PRETRANSFER_TIME
3486     case 6: /* CURLINFO_PRETRANSFER_TIME */
3487         resultType = DoubleValue;
3488
3489         curlResult = curl_easy_getinfo(connection->connection,
3490                                        CURLINFO_PRETRANSFER_TIME,
3491                                        &doubleValue);
3492         break;
3493 #endif
3494
3495 #if HAVE_DECL_CURLINFO_SIZE_UPLOAD
3496     case 7: /* CURLINFO_SIZE_UPLOAD */
3497         resultType = DoubleValue;
3498
3499         curlResult = curl_easy_getinfo(connection->connection,
3500                                        CURLINFO_SIZE_UPLOAD,
3501                                        &doubleValue);
3502         break;
3503 #endif
3504
3505 #if HAVE_DECL_CURLINFO_SIZE_DOWNLOAD
3506     case 8: /* CURLINFO_SIZE_DOWNLOAD */
3507         resultType = DoubleValue;
3508
3509         curlResult = curl_easy_getinfo(connection->connection,
3510                                        CURLINFO_SIZE_DOWNLOAD,
3511                                        &doubleValue);
3512         break;
3513 #endif
3514
3515 #if HAVE_DECL_CURLINFO_SPEED_DOWNLOAD
3516     case 9: /* CURLINFO_SPEED_DOWNLOAD */
3517         resultType = DoubleValue;
3518
3519         curlResult = curl_easy_getinfo(connection->connection,
3520                                        CURLINFO_SPEED_DOWNLOAD,
3521                                        &doubleValue);
3522         break;
3523 #endif
3524
3525 #if HAVE_DECL_CURLINFO_SPEED_UPLOAD
3526     case 10: /* CURLINFO_SPEED_UPLOAD */
3527         resultType = DoubleValue;
3528
3529         curlResult = curl_easy_getinfo(connection->connection,
3530                                        CURLINFO_SPEED_UPLOAD,
3531                                        &doubleValue);
3532         break;
3533
3534 #endif
3535
3536 #if HAVE_DECL_CURLINFO_HEADER_SIZE
3537     case 11: /* CURLINFO_HEADER_SIZE */
3538         resultType = LongValue;
3539
3540         curlResult = curl_easy_getinfo(connection->connection,
3541                                        CURLINFO_HEADER_SIZE,
3542                                        &longValue);
3543         break;
3544 #endif
3545
3546 #if HAVE_DECL_CURLINFO_REQUEST_SIZE
3547     case 12: /* CURLINFO_REQUEST_SIZE */
3548         resultType = LongValue;
3549
3550         curlResult = curl_easy_getinfo(connection->connection,
3551                                        CURLINFO_REQUEST_SIZE,
3552                                        &longValue);
3553         break;
3554 #endif
3555
3556 #if HAVE_DECL_CURLINFO_SSL_VERIFYRESULT
3557     case 13: /* CURLINFO_SSL_VERIFYRESULT */
3558         resultType = LongValue;
3559
3560         curlResult = curl_easy_getinfo(connection->connection,
3561                                        CURLINFO_SSL_VERIFYRESULT,
3562                                        &longValue);
3563         break;
3564 #endif
3565
3566 #if HAVE_DECL_CURLINFO_FILETIME
3567     case 14: /* CURLINFO_FILETIME */
3568         resultType = DoubleValue;
3569
3570         curlResult = curl_easy_getinfo(connection->connection,
3571                                        CURLINFO_FILETIME,
3572                                        &longValue);
3573
3574         doubleValue = longValue;
3575         break;
3576 #endif
3577
3578 #if HAVE_DECL_CURLINFO_CONTENT_LENGTH_DOWNLOAD
3579     case 15: /* CURLINFO_CONTENT_LENGTH_DOWNLOAD */
3580         resultType = DoubleValue;
3581
3582         curlResult = curl_easy_getinfo(connection->connection,
3583                                        CURLINFO_CONTENT_LENGTH_DOWNLOAD,
3584                                        &doubleValue);
3585         break;
3586 #endif
3587
3588 #if HAVE_DECL_CURLINFO_CONTENT_LENGTH_UPLOAD
3589     case 16: /* CURLINFO_CONTENT_LENGTH_UPLOAD */
3590         resultType = DoubleValue;
3591
3592         curlResult = curl_easy_getinfo(connection->connection,
3593                                        CURLINFO_CONTENT_LENGTH_UPLOAD,
3594                                        &doubleValue);
3595         break;
3596 #endif
3597
3598 #if HAVE_DECL_CURLINFO_STARTTRANSFER_TIME
3599     case 17: /* CURLINFO_STARTTRANSFER_TIME */
3600         resultType = DoubleValue;
3601
3602         curlResult = curl_easy_getinfo(connection->connection,
3603                                        CURLINFO_STARTTRANSFER_TIME,
3604                                        &doubleValue);
3605         break;
3606 #endif
3607
3608 #if HAVE_DECL_CURLINFO_CONTENT_TYPE
3609     case 18: /* CURLINFO_CONTENT_TYPE */
3610         resultType = StringValue;
3611
3612         curlResult = curl_easy_getinfo(connection->connection,
3613                                        CURLINFO_CONTENT_TYPE,
3614                                        &strValue);
3615         break;
3616 #endif
3617
3618 #if HAVE_DECL_CURLINFO_REDIRECT_TIME
3619     case 19: /* CURLINFO_REDIRECT_TIME */
3620         resultType = DoubleValue;
3621
3622         curlResult = curl_easy_getinfo(connection->connection,
3623                                        CURLINFO_REDIRECT_TIME,
3624                                        &doubleValue);
3625         break;
3626 #endif
3627
3628 #if HAVE_DECL_CURLINFO_REDIRECT_COUNT
3629     case 20: /* CURLINFO_REDIRECT_COUNT */
3630         resultType = LongValue;
3631
3632         curlResult = curl_easy_getinfo(connection->connection,
3633                                        CURLINFO_REDIRECT_COUNT,
3634                                        &longValue);
3635         break;
3636 #endif
3637
3638 #if HAVE_DECL_CURLINFO_PRIVATE
3639     case 21: /* CURLINFO_PRIVATE */
3640         resultType = StringValue;
3641
3642         curlResult = curl_easy_getinfo(connection->connection,
3643                                        CURLINFO_PRIVATE,
3644                                        &strValue);
3645         break;
3646 #endif
3647
3648 #if HAVE_DECL_CURLINFO_HTTP_CONNECTCODE
3649     case 22: /* CURLINFO_HTTP_CONNECTCODE */
3650         resultType = LongValue;
3651
3652         curlResult = curl_easy_getinfo(connection->connection,
3653                                        CURLINFO_HTTP_CONNECTCODE,
3654                                        &longValue);
3655         break;
3656 #endif
3657
3658 #if HAVE_DECL_CURLINFO_HTTPAUTH_AVAIL
3659     case 23: /* CURLINFO_HTTPAUTH_AVAIL */
3660         resultType = LongValue;
3661
3662         curlResult = curl_easy_getinfo(connection->connection,
3663                                        CURLINFO_HTTPAUTH_AVAIL,
3664                                        &longValue);
3665         break;
3666 #endif
3667
3668 #if HAVE_DECL_CURLINFO_PROXYAUTH_AVAIL
3669     case 24: /* CURLINFO_PROXYAUTH_AVAIL */
3670         resultType = LongValue;
3671
3672         curlResult = curl_easy_getinfo(connection->connection,
3673                                        CURLINFO_PROXYAUTH_AVAIL,
3674                                        &longValue);
3675         break;
3676 #endif
3677
3678 #if HAVE_DECL_CURLINFO_OS_ERRNO
3679     case 25: /* CURLINFO_OS_ERRNO */
3680         resultType = LongValue;
3681
3682         curlResult = curl_easy_getinfo(connection->connection,
3683                                        CURLINFO_OS_ERRNO,
3684                                        &longValue);
3685         break;
3686 #endif
3687
3688 #if HAVE_DECL_CURLINFO_NUM_CONNECTS
3689     case 26: /* CURLINFO_NUM_CONNECTS */
3690         resultType = LongValue;
3691
3692         curlResult = curl_easy_getinfo(connection->connection,
3693                                        CURLINFO_NUM_CONNECTS,
3694                                        &longValue);
3695         break;
3696 #endif
3697
3698 #if HAVE_DECL_CURLINFO_SSL_ENGINES
3699     case 27: /* CURLINFO_SSL_ENGINES */
3700         resultType = StringListValue;
3701
3702         curlResult = curl_easy_getinfo(connection->connection,
3703                                        CURLINFO_SSL_ENGINES,
3704                                        &stringListValue);
3705         break;
3706 #endif
3707
3708 #if HAVE_DECL_CURLINFO_COOKIELIST
3709     case 28: /* CURLINFO_COOKIELIST */
3710         resultType = StringListValue;
3711
3712         curlResult = curl_easy_getinfo(connection->connection,
3713                                        CURLINFO_COOKIELIST,
3714                                        &stringListValue);
3715         break;
3716 #endif
3717
3718 #if HAVE_DECL_CURLINFO_LASTSOCKET
3719     case 29: /* CURLINFO_LASTSOCKET */
3720         resultType = LongValue;
3721
3722         curlResult = curl_easy_getinfo(connection->connection,
3723                                        CURLINFO_LASTSOCKET,
3724                                        &longValue);
3725         break;
3726 #endif
3727
3728 #if HAVE_DECL_CURLINFO_FTP_ENTRY_PATH
3729     case 30: /* CURLINFO_FTP_ENTRY_PATH */
3730         resultType = StringValue;
3731
3732         curlResult = curl_easy_getinfo(connection->connection,
3733                                        CURLINFO_FTP_ENTRY_PATH,
3734                                        &strValue);
3735         break;
3736 #endif
3737
3738 #if HAVE_DECL_CURLINFO_REDIRECT_URL
3739     case 31: /* CURLINFO_REDIRECT_URL */
3740         resultType = StringValue;
3741
3742         curlResult = curl_easy_getinfo(connection->connection,
3743                                        CURLINFO_REDIRECT_URL,
3744                                        &strValue);
3745         break;
3746 #else
3747 #pragma message("libcurl does not provide CURLINFO_REDIRECT_URL")
3748 #endif
3749
3750 #if HAVE_DECL_CURLINFO_PRIMARY_IP
3751     case 32: /* CURLINFO_PRIMARY_IP */
3752         resultType = StringValue;
3753
3754         curlResult = curl_easy_getinfo(connection->connection,
3755                                        CURLINFO_PRIMARY_IP,
3756                                        &strValue);
3757         break;
3758 #else
3759 #pragma message("libcurl does not provide CURLINFO_PRIMARY_IP")
3760 #endif
3761
3762 #if HAVE_DECL_CURLINFO_LOCAL_IP
3763     case 33: /* CURLINFO_LOCAL_IP */
3764         resultType = StringValue;
3765
3766         curlResult = curl_easy_getinfo(connection->connection,
3767                                        CURLINFO_LOCAL_IP,
3768                                        &strValue);
3769         break;
3770 #else
3771 #pragma message("libcurl does not provide CURLINFO_LOCAL_IP")
3772 #endif
3773
3774 #if HAVE_DECL_CURLINFO_LOCAL_PORT
3775     case 34: /* CURLINFO_LOCAL_PORT */
3776         resultType = LongValue;
3777
3778         curlResult = curl_easy_getinfo(connection->connection,
3779                                        CURLINFO_LOCAL_PORT,
3780                                        &longValue);
3781         break;
3782 #else
3783 #pragma message("libcurl does not provide CURLINFO_LOCAL_PORT")
3784 #endif
3785
3786 #if HAVE_DECL_CURLINFO_CONDITION_UNMET
3787     case 35: /* CURLINFO_CONDITION_UNMET */
3788         resultType = LongValue;
3789
3790         curlResult = curl_easy_getinfo(connection->connection,
3791                                        CURLINFO_CONDITION_UNMET,
3792                                        &longValue);
3793         break;
3794 #else
3795 #pragma message("libcurl does not provide CURLINFO_CONDITION_UNMET")
3796 #endif
3797
3798     default:
3799         failwith("Invalid CURLINFO Option");
3800         break;
3801     }
3802
3803     if (curlResult != CURLE_OK)
3804         raiseError(connection, curlResult);
3805
3806     switch (resultType)
3807     {
3808     case StringValue:
3809         result = alloc(1, StringValue);
3810         Store_field(result, 0, copy_string(strValue?strValue:""));
3811         break;
3812
3813     case LongValue:
3814         result = alloc(1, LongValue);
3815         Store_field(result, 0, Val_long(longValue));
3816         break;
3817
3818     case DoubleValue:
3819         result = alloc(1, DoubleValue);
3820         Store_field(result, 0, copy_double(doubleValue));
3821         break;
3822
3823     case StringListValue:
3824         result = alloc(1, StringListValue);
3825         Store_field(result, 0, convertStringList(stringListValue));
3826         break;
3827     }
3828
3829     CAMLreturn(result);
3830 }
3831
3832 /**
3833  **  curl_escape helper function
3834  **/
3835
3836 CAMLprim value helper_curl_escape(value str)
3837 {
3838     CAMLparam1(str);
3839     CAMLlocal1(result);
3840     char *curlResult;
3841
3842     curlResult = curl_escape(String_val(str), string_length(str));
3843     result = copy_string(curlResult);
3844     free(curlResult);
3845
3846     CAMLreturn(result);
3847 }
3848
3849 /**
3850  **  curl_unescape helper function
3851  **/
3852
3853 CAMLprim value helper_curl_unescape(value str)
3854 {
3855     CAMLparam1(str);
3856     CAMLlocal1(result);
3857     char *curlResult;
3858
3859     curlResult = curl_unescape(String_val(str), string_length(str));
3860     result = copy_string(curlResult);
3861     free(curlResult);
3862
3863     CAMLreturn(result);
3864 }
3865
3866 /**
3867  **  curl_getdate helper function
3868  **/
3869
3870 CAMLprim value helper_curl_getdate(value str, value now)
3871 {
3872     CAMLparam2(str, now);
3873     CAMLlocal1(result);
3874     time_t curlResult;
3875     time_t curlNow;
3876
3877     curlNow = (time_t)Double_val(now);
3878     curlResult = curl_getdate(String_val(str), &curlNow);
3879     result = copy_double((double)curlResult);
3880
3881     CAMLreturn(result);
3882 }
3883
3884 /**
3885  **  curl_version helper function
3886  **/
3887
3888 CAMLprim value helper_curl_version(void)
3889 {
3890     CAMLparam0();
3891     CAMLlocal1(result);
3892     char *str;
3893
3894     str = curl_version();
3895     result = copy_string(str);
3896
3897     CAMLreturn(result);
3898 }
3899
3900 struct CURLVersionBitsMapping
3901 {
3902     int code;
3903     char *name;
3904 };
3905
3906 struct CURLVersionBitsMapping versionBitsMap[] =
3907 {
3908     {CURL_VERSION_IPV6, "ipv6"},
3909     {CURL_VERSION_KERBEROS4, "kerberos4"},
3910     {CURL_VERSION_SSL, "ssl"},
3911     {CURL_VERSION_LIBZ, "libz"},
3912     {CURL_VERSION_NTLM, "ntlm"},
3913     {CURL_VERSION_GSSNEGOTIATE, "gssnegotiate"},
3914     {CURL_VERSION_DEBUG, "debug"},
3915     {CURL_VERSION_CURLDEBUG, "curldebug"},
3916     {CURL_VERSION_ASYNCHDNS, "asynchdns"},
3917     {CURL_VERSION_SPNEGO, "spnego"},
3918     {CURL_VERSION_LARGEFILE, "largefile"},
3919     {CURL_VERSION_IDN, "idn"},
3920     {CURL_VERSION_SSPI, "sspi"},
3921     {CURL_VERSION_CONV, "conv"},
3922 #if HAVE_DECL_CURL_VERSION_TLSAUTH_SRP
3923     {CURL_VERSION_TLSAUTH_SRP, "srp"},
3924 #endif
3925 #if HAVE_DECL_CURL_VERSION_NTLM_WB
3926     {CURL_VERSION_NTLM_WB, "wb"},
3927 #endif
3928 };
3929
3930 CAMLprim value caml_curl_version_info(value unit)
3931 {
3932   CAMLparam1(unit);
3933   CAMLlocal4(v, vlist, vnum, vfeatures);
3934   const char* const* p = NULL;
3935   size_t i = 0;
3936
3937   curl_version_info_data* data = curl_version_info(CURLVERSION_NOW);
3938   if (NULL == data) caml_failwith("curl_version_info");
3939
3940   vlist = Val_emptylist;
3941   for (p = data->protocols; NULL != *p; p++)
3942   {
3943     vlist = Val_cons(vlist, caml_copy_string(*p));
3944   }
3945
3946   vfeatures = Val_emptylist;
3947   for (i = 0; i < sizeof(versionBitsMap)/sizeof(versionBitsMap[0]); i++)
3948   {
3949     if (0 != (versionBitsMap[i].code & data->features))
3950       vfeatures = Val_cons(vfeatures, caml_copy_string(versionBitsMap[i].name));
3951   }
3952
3953   vnum = caml_alloc_tuple(3);
3954   Store_field(vnum,0,Val_int(0xFF & (data->version_num >> 16)));
3955   Store_field(vnum,1,Val_int(0xFF & (data->version_num >> 8)));
3956   Store_field(vnum,2,Val_int(0xFF & (data->version_num)));
3957
3958   v = caml_alloc_tuple(12);
3959   Store_field(v,0,caml_copy_string(data->version));
3960   Store_field(v,1,vnum);
3961   Store_field(v,2,caml_copy_string(data->host));
3962   Store_field(v,3,vfeatures);
3963   Store_field(v,4,data->ssl_version ? Val_some(caml_copy_string(data->ssl_version)) : Val_none);
3964   Store_field(v,5,data->libz_version ? Val_some(caml_copy_string(data->libz_version)) : Val_none);
3965   Store_field(v,6,vlist);
3966   Store_field(v,7,caml_copy_string((data->age >= 1 && data->ares) ? data->ares : ""));
3967   Store_field(v,8,Val_int((data->age >= 1) ? data->ares_num : 0));
3968   Store_field(v,9,caml_copy_string((data->age >= 2 && data->libidn) ? data->libidn : ""));
3969   Store_field(v,10,Val_int((data->age >= 3) ? data->iconv_ver_num : 0));
3970   Store_field(v,11,caml_copy_string((data->age >= 3 && data->libssh_version) ? data->libssh_version : ""));
3971
3972   CAMLreturn(v);
3973 }
3974
3975 CAMLprim value caml_curl_pause(value conn, value opts)
3976 {
3977   CAMLparam2(conn, opts);
3978   CAMLlocal4(v, vlist, vnum, vfeatures);
3979   Connection *connection = Connection_val(conn);
3980   int bitmask = 0;
3981   CURLcode result;
3982
3983   while (Val_emptylist != opts)
3984   {
3985     switch (Int_val(Field(opts,0)))
3986     {
3987       case 0: bitmask |= CURLPAUSE_SEND; break;
3988       case 1: bitmask |= CURLPAUSE_RECV; break;
3989       case 2: bitmask |= CURLPAUSE_ALL; break;
3990       default: caml_failwith("wrong pauseOption");
3991     }
3992     opts = Field(opts,1);
3993   }
3994
3995   result = curl_easy_pause(connection->connection,bitmask);
3996   if (result != CURLE_OK)
3997     raiseError(connection, result);
3998
3999   CAMLreturn(Val_unit);
4000 }
4001
4002 /*
4003  * Curl multi stack support
4004  *
4005  * Exported thin wrappers for libcurl are prefixed with caml_curl_multi_.
4006  * Other exported functions are prefixed with caml_curlm_, some of them
4007  * can/should be decomposed into smaller parts.
4008  */
4009
4010 struct ml_multi_handle
4011 {
4012   CURLM* handle;
4013   value values; /* callbacks */
4014 };
4015
4016 enum
4017 {
4018   curlmopt_socket_function,
4019   curlmopt_timer_function,
4020
4021   /* last, not used */
4022   multi_values_total
4023 };
4024
4025 typedef struct ml_multi_handle ml_multi_handle;
4026
4027 #define Multi_val(v) (*(ml_multi_handle**)Data_custom_val(v))
4028 #define CURLM_val(v) (Multi_val(v)->handle)
4029
4030 static struct custom_operations curl_multi_ops = {
4031   "ygrek.curl_multi",
4032   custom_finalize_default,
4033   custom_compare_default,
4034   custom_hash_default,
4035   custom_serialize_default,
4036   custom_deserialize_default,
4037 #if defined(custom_compare_ext_default)
4038   custom_compare_ext_default,
4039 #endif
4040 };
4041
4042 CAMLprim value caml_curl_multi_init(value unit)
4043 {
4044   CAMLparam1(unit);
4045   CAMLlocal1(v);
4046   ml_multi_handle* multi = (ml_multi_handle*)caml_stat_alloc(sizeof(ml_multi_handle));
4047   CURLM* h = curl_multi_init();
4048
4049   if (!h)
4050   {
4051     caml_stat_free(multi);
4052     failwith("caml_curl_multi_init");
4053   }
4054
4055   multi->handle = h;
4056   multi->values = caml_alloc(multi_values_total, 0);
4057   caml_register_generational_global_root(&multi->values);
4058
4059   v = caml_alloc_custom(&curl_multi_ops, sizeof(ml_multi_handle*), 0, 1);
4060   Multi_val(v) = multi;
4061
4062   CAMLreturn(v);
4063 }
4064
4065 CAMLprim value caml_curl_multi_cleanup(value handle)
4066 {
4067   CAMLparam1(handle);
4068   ml_multi_handle* h = Multi_val(handle);
4069
4070   if (NULL == h)
4071     CAMLreturn(Val_unit);
4072
4073   caml_remove_generational_global_root(&h->values);
4074
4075   if (CURLM_OK != curl_multi_cleanup(h->handle))
4076     failwith("caml_curl_multi_cleanup");
4077
4078   Multi_val(handle) = (ml_multi_handle*)NULL;
4079
4080   CAMLreturn(Val_unit);
4081 }
4082
4083 static CURL* curlm_remove_finished(CURLM* multi_handle, CURLcode* result)
4084 {
4085   int msgs_in_queue = 0;
4086
4087   while (1)
4088   {
4089     CURLMsg* msg = curl_multi_info_read(multi_handle, &msgs_in_queue);
4090     if (NULL == msg) return NULL;
4091     if (CURLMSG_DONE == msg->msg)
4092     {
4093       CURL* easy_handle = msg->easy_handle;
4094       if (result) *result = msg->data.result;
4095       if (CURLM_OK != curl_multi_remove_handle(multi_handle, easy_handle))
4096       {
4097         /*failwith("curlm_remove_finished");*/
4098       }
4099       return easy_handle;
4100     }
4101   }
4102 }
4103
4104 CAMLprim value caml_curlm_remove_finished(value v_multi)
4105 {
4106   CAMLparam1(v_multi);
4107   CAMLlocal2(v_easy, v_tuple);
4108   CURL* handle;
4109   CURLM* multi_handle;
4110   CURLcode result;
4111   Connection* conn = NULL;
4112
4113   multi_handle = CURLM_val(v_multi);
4114
4115   caml_enter_blocking_section();
4116   handle = curlm_remove_finished(multi_handle,&result);
4117   caml_leave_blocking_section();
4118
4119   if (NULL == handle)
4120   {
4121     CAMLreturn(Val_none);
4122   }
4123   else
4124   {
4125     conn = findConnection(handle);
4126     if (conn->curl_ERRORBUFFER != NULL)
4127     {
4128         Store_field(Field(conn->ocamlValues, Ocaml_ERRORBUFFER), 0, caml_copy_string(conn->curl_ERRORBUFFER));
4129     }
4130     conn->refcount--;
4131     /* NB: same handle, but different block */
4132     v_easy = caml_curl_alloc(conn);
4133     v_tuple = caml_alloc(2, 0);
4134     Store_field(v_tuple,0,v_easy);
4135     Store_field(v_tuple,1,Val_int(result)); /* CURLcode */
4136     CAMLreturn(Val_some(v_tuple));
4137   }
4138 }
4139
4140 static int curlm_wait_data(CURLM* multi_handle)
4141 {
4142         struct timeval timeout;
4143   CURLMcode ret;
4144
4145         fd_set fdread;
4146         fd_set fdwrite;
4147         fd_set fdexcep;
4148         int maxfd = -1;
4149
4150         FD_ZERO(&fdread);
4151         FD_ZERO(&fdwrite);
4152         FD_ZERO(&fdexcep);
4153
4154         /* set a suitable timeout */
4155         timeout.tv_sec = 1;
4156         timeout.tv_usec = 0;
4157
4158         /* get file descriptors from the transfers */
4159         ret = curl_multi_fdset(multi_handle, &fdread, &fdwrite, &fdexcep, &maxfd);
4160
4161         if (ret == CURLM_OK && maxfd >= 0)
4162         {
4163                 int rc = select(maxfd+1, &fdread, &fdwrite, &fdexcep, &timeout);
4164                 if (-1 != rc) return 0;
4165         }
4166         return 1;
4167 }
4168
4169 CAMLprim value caml_curlm_wait_data(value v_multi)
4170 {
4171   CAMLparam1(v_multi);
4172   int ret;
4173   CURLM* h = CURLM_val(v_multi);
4174
4175   caml_enter_blocking_section();
4176   ret = curlm_wait_data(h);
4177   caml_leave_blocking_section();
4178
4179   CAMLreturn(Val_bool(0 == ret));
4180 }
4181
4182 CAMLprim value caml_curl_multi_add_handle(value v_multi, value v_easy)
4183 {
4184   CAMLparam2(v_multi,v_easy);
4185   CURLM* multi = CURLM_val(v_multi);
4186   Connection* conn = Connection_val(v_easy);
4187
4188   /* prevent collection of OCaml value while the easy handle is used
4189    and may invoke callbacks registered on OCaml side */
4190   conn->refcount++;
4191
4192   /* may invoke callbacks so need to be consistent with locks */
4193   caml_enter_blocking_section();
4194   if (CURLM_OK != curl_multi_add_handle(multi, conn->connection))
4195   {
4196     conn->refcount--; /* not added, revert */
4197     caml_leave_blocking_section();
4198     failwith("caml_curl_multi_add_handle");
4199   }
4200   caml_leave_blocking_section();
4201
4202   CAMLreturn(Val_unit);
4203 }
4204
4205 CAMLprim value caml_curl_multi_remove_handle(value v_multi, value v_easy)
4206 {
4207   CAMLparam2(v_multi,v_easy);
4208   CURLM* multi = CURLM_val(v_multi);
4209   Connection* conn = Connection_val(v_easy);
4210
4211   /* may invoke callbacks so need to be consistent with locks */
4212   caml_enter_blocking_section();
4213   if (CURLM_OK != curl_multi_remove_handle(multi, conn->connection))
4214   {
4215     caml_leave_blocking_section();
4216     failwith("caml_curl_multi_remove_handle");
4217   }
4218   conn->refcount--;
4219   caml_leave_blocking_section();
4220
4221   CAMLreturn(Val_unit);
4222 }
4223
4224 CAMLprim value caml_curl_multi_perform_all(value v_multi)
4225 {
4226   CAMLparam1(v_multi);
4227   int still_running = 0;
4228   CURLM* h = CURLM_val(v_multi);
4229
4230   caml_enter_blocking_section();
4231   while (CURLM_CALL_MULTI_PERFORM == curl_multi_perform(h, &still_running));
4232   caml_leave_blocking_section();
4233
4234   CAMLreturn(Val_int(still_running));
4235 }
4236
4237 CAMLprim value helper_curl_easy_strerror(value v_code)
4238 {
4239   CAMLparam1(v_code);
4240   CAMLreturn(caml_copy_string(curl_easy_strerror(Int_val(v_code))));
4241 }
4242
4243 /*
4244  * Wrappers for the curl_multi_socket_action infrastructure
4245  * Based on curl hiperfifo.c example
4246  */
4247
4248 #ifdef _WIN32
4249 #ifndef Val_socket
4250 #define Val_socket(v) win_alloc_socket(v)
4251 #endif
4252 #ifndef Socket_val
4253 #error Socket_val not defined in unixsupport.h
4254 #endif
4255 #else /* _WIN32 */
4256 #ifndef Socket_val
4257 #define Socket_val(v) Long_val(v)
4258 #endif
4259 #ifndef Val_socket
4260 #define Val_socket(v) Val_int(v)
4261 #endif
4262 #endif  /* _WIN32 */
4263
4264 static void raise_multi_error(char const* msg)
4265 {
4266   static value* exception = NULL;
4267
4268   if (NULL == exception)
4269   {
4270     exception = caml_named_value("Curl.Multi.Error");
4271     if (NULL == exception) caml_invalid_argument("Curl.Multi.Error");
4272   }
4273
4274   caml_raise_with_string(*exception, msg);
4275 }
4276
4277 static void check_mcode(CURLMcode code)
4278 {
4279   char const *s = NULL;
4280   switch (code)
4281   {
4282     case CURLM_OK                  : return;
4283     case CURLM_CALL_MULTI_PERFORM  : s="CURLM_CALL_MULTI_PERFORM"; break;
4284     case CURLM_BAD_HANDLE          : s="CURLM_BAD_HANDLE";         break;
4285     case CURLM_BAD_EASY_HANDLE     : s="CURLM_BAD_EASY_HANDLE";    break;
4286     case CURLM_OUT_OF_MEMORY       : s="CURLM_OUT_OF_MEMORY";      break;
4287     case CURLM_INTERNAL_ERROR      : s="CURLM_INTERNAL_ERROR";     break;
4288     case CURLM_UNKNOWN_OPTION      : s="CURLM_UNKNOWN_OPTION";     break;
4289     case CURLM_LAST                : s="CURLM_LAST";               break;
4290     case CURLM_BAD_SOCKET          : s="CURLM_BAD_SOCKET";         break;
4291     default                        : s="CURLM_unknown";            break;
4292   }
4293   raise_multi_error(s);
4294 }
4295
4296 CAMLprim value caml_curl_multi_socket_action(value v_multi, value v_fd, value v_kind)
4297 {
4298   CAMLparam3(v_multi, v_fd, v_kind);
4299   CURLM* h = CURLM_val(v_multi);
4300   int still_running = 0;
4301   CURLMcode rc = CURLM_OK;
4302   curl_socket_t socket;
4303   int kind = 0;
4304
4305   if (Val_none == v_fd)
4306   {
4307     socket = CURL_SOCKET_TIMEOUT;
4308   }
4309   else
4310   {
4311     socket = Socket_val(Field(v_fd, 0));
4312   }
4313
4314   switch (Int_val(v_kind))
4315   {
4316     case 0 : break;
4317     case 1 : kind |= CURL_CSELECT_IN; break;
4318     case 2 : kind |= CURL_CSELECT_OUT; break;
4319     case 3 : kind |= CURL_CSELECT_IN | CURL_CSELECT_OUT; break;
4320     default:
4321       raise_multi_error("caml_curl_multi_socket_action");
4322   }
4323
4324 /*  fprintf(stdout,"fd %u kind %u\n",socket, kind); fflush(stdout); */
4325
4326   caml_enter_blocking_section();
4327   do {
4328     rc = curl_multi_socket_action(h, socket, kind, &still_running);
4329   } while (rc == CURLM_CALL_MULTI_PERFORM);
4330   caml_leave_blocking_section();
4331
4332   check_mcode(rc);
4333
4334   CAMLreturn(Val_int(still_running));
4335 }
4336
4337 CAMLprim value caml_curl_multi_socket_all(value v_multi)
4338 {
4339   CAMLparam1(v_multi);
4340   int still_running = 0;
4341   CURLMcode rc = CURLM_OK;
4342   CURLM* h = CURLM_val(v_multi);
4343
4344   caml_enter_blocking_section();
4345   do {
4346     rc = curl_multi_socket_all(h, &still_running);
4347   } while (rc == CURLM_CALL_MULTI_PERFORM);
4348   caml_leave_blocking_section();
4349
4350   check_mcode(rc);
4351
4352   CAMLreturn(Val_int(still_running));
4353 }
4354
4355 static int curlm_sock_cb_nolock(CURL *e, curl_socket_t sock, int what, ml_multi_handle* multi, void *sockp)
4356 {
4357   CAMLparam0();
4358   CAMLlocal2(v_what,csock);
4359   (void)e;
4360   (void)sockp; /* not used */
4361
4362   /* v_what = Val_int(what); */
4363   switch (what)
4364   {
4365     case CURL_POLL_NONE   : v_what = Val_int(0); break;
4366     case CURL_POLL_IN     : v_what = Val_int(1); break;
4367     case CURL_POLL_OUT    : v_what = Val_int(2); break;
4368     case CURL_POLL_INOUT  : v_what = Val_int(3); break;
4369     case CURL_POLL_REMOVE : v_what = Val_int(4); break;
4370     default:
4371       fprintf(stderr, "curlm_sock_cb sock=%d what=%d\n", sock, what);
4372       fflush(stderr);
4373       raise_multi_error("curlm_sock_cb"); /* FIXME exception from callback */
4374   }
4375   csock=Val_socket(sock);
4376   caml_callback2(Field(multi->values,curlmopt_socket_function),
4377                  csock, v_what);
4378
4379   CAMLreturn(0);
4380 }
4381
4382 static int curlm_sock_cb(CURL *e, curl_socket_t sock, int what, void *cbp, void *sockp)
4383 {
4384   int ret;
4385   caml_leave_blocking_section();
4386   ret = curlm_sock_cb_nolock(e, sock, what, (ml_multi_handle*)cbp, sockp);
4387   caml_enter_blocking_section();
4388   return ret;
4389 }
4390
4391 CAMLprim value caml_curl_multi_socketfunction(value v_multi, value v_cb)
4392 {
4393   CAMLparam2(v_multi, v_cb);
4394   ml_multi_handle* multi = Multi_val(v_multi);
4395
4396   Store_field(multi->values, curlmopt_socket_function, v_cb);
4397
4398   curl_multi_setopt(multi->handle, CURLMOPT_SOCKETFUNCTION, curlm_sock_cb);
4399   curl_multi_setopt(multi->handle, CURLMOPT_SOCKETDATA, multi);
4400
4401   CAMLreturn(Val_unit);
4402 }
4403
4404 static void curlm_timer_cb_nolock(ml_multi_handle *multi, long timeout_ms)
4405 {
4406   CAMLparam0();
4407   caml_callback(Field(multi->values,curlmopt_timer_function), Val_long(timeout_ms));
4408   CAMLreturn0;
4409 }
4410
4411 static int curlm_timer_cb(CURLM *multi, long timeout_ms, void *userp)
4412 {
4413   (void)multi;
4414
4415   caml_leave_blocking_section();
4416   curlm_timer_cb_nolock((ml_multi_handle*)userp, timeout_ms);
4417   caml_enter_blocking_section();
4418   return 0;
4419 }
4420
4421 CAMLprim value caml_curl_multi_timerfunction(value v_multi, value v_cb)
4422 {
4423   CAMLparam2(v_multi, v_cb);
4424   ml_multi_handle* multi = Multi_val(v_multi);
4425
4426   Store_field(multi->values, curlmopt_timer_function, v_cb);
4427
4428   curl_multi_setopt(multi->handle, CURLMOPT_TIMERFUNCTION, curlm_timer_cb);
4429   curl_multi_setopt(multi->handle, CURLMOPT_TIMERDATA, multi);
4430
4431   CAMLreturn(Val_unit);
4432 }
4433
4434 CAMLprim value caml_curl_multi_timeout(value v_multi)
4435 {
4436   CAMLparam1(v_multi);
4437   long ms = 0;
4438   CURLMcode rc = CURLM_OK;
4439   ml_multi_handle* multi = Multi_val(v_multi);
4440
4441   rc = curl_multi_timeout(multi->handle, &ms);
4442
4443   check_mcode(rc);
4444
4445   CAMLreturn(Val_long(ms));
4446 }