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