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