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