curl-helper.c

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