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