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