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