Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 576 lines (522 sloc) 22.286 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (** HttpTools:
19
20 Just some support routines for handling HTTP requests and responses.
21
22 *)
23
24 #<Debugvar:HTTP_DEBUG>
25
26 let http = NetAddr.mk_protocol "HTTP"
27
28 module List = Base.List
29 module String = Base.String
30 module Char = Base.Char
31
32 let ug = String.unsafe_get
33 let us = String.unsafe_sub
34
35 (* Local profiling code
36 * To be deleted when no longer required *)
37 let rpt n f a =
38 let rec aux = function 0 -> () | n -> (f a; aux (pred n)) in
39 aux n
40
41 let timefn n f a =
42 let start = Unix.gettimeofday () in
43 rpt n f a;
44 Printf.printf "time: %f\n" ((Unix.gettimeofday()) -. start)
45
46 let verifyfn f pa px lst =
47 List.for_all
48 (fun (a,x) ->
49 let res = f a in
50 if res = x
51 then true
52 else
53 (Logger.debug "Failed: '%s'\nExpected: '%s'\nGot: '%s'"
54 (String.escaped (pa a)) (String.escaped (px x)) (String.escaped (px res));
55 false)) lst
56
57 (** Strip a header comment from a string.
58 Comments can be nested.
59 NOTE: only removes the final comment at the end of the line if it exists.
60 *)
61 let strcom str strlen =
62 let rec aux n p =
63 let ch = ug str p in
64 if p >= 0
65 then
66 if ch = '('
67 then if n <= 1 then p else aux (pred n) (pred p)
68 else if ch = ')' then aux (succ n) (pred p) else aux n (pred p)
69 else 0
70 in
71 let rec aux2 p =
72 let ch = ug str p in
73 if p >= 0
74 then
75 if Charf.is_spacef ch
76 then aux2 (pred p)
77 else
78 if ch = ')'
79 then aux 1 (pred p)
80 else (succ p)
81 else 0
82 in
83 let p = (aux2 (pred strlen)) in
84 us str 0 p,
85 if p = strlen then None else Some (us str p (strlen-p))
86
87 (** Remove leading and trailing spaces from a string.
88 *)
89 let rmldtrsp0 str strlen =
90 let rec aux p =
91 if p < strlen && Charf.is_spacef (ug str p)
92 then aux (succ p)
93 else p in
94 let rec aux2 p =
95 if p >= 0 && Charf.is_spacef (ug str p)
96 then if p <= 0 then 0 else aux2 (pred p)
97 else p in
98 let st = aux 0 and nd = aux2 (pred strlen) in
99 us str st ((nd-st)+1)
100
101 let rmldtrsp str = rmldtrsp0 str (String.length str)
102
103 let rmldtrsp2 (str1,str2) = (rmldtrsp str1, rmldtrsp str2)
104
105 let rmldtrspl sl = List.map rmldtrsp sl
106
107 (* Used by generated mkrp.ml code, provide string up to marker for
108 * parsing http headers. Note that if we can't find the marker
109 * we actually return the whole string (multiline?).
110 *)
111
112 let pos_mark ug mark mlen str strlen n =
113 if mlen <= 0
114 then Some (n,n)
115 else
116 let rec pc0 pos =
117 let rec at m =
118 if m >= mlen
119 then true
120 else
121 if (pos+m) >= strlen
122 then false
123 else
124 if (ug str (pos+m)) = (ug mark m)
125 then at (m+1)
126 else false
127 in
128 if pos >= strlen
129 then None
130 else
131 if at 0
132 then Some (pos, pos+mlen)
133 else pc0 (pos+1) in
134 pc0 n
135
136 let upto_mark_ ug mark mlen str strlen n =
137 if n >= strlen
138 then (n, 0, "")
139 else
140 if mlen >= strlen - n
141 then (strlen, strlen - n, us str n (strlen-n))
142 else
143 match pos_mark ug mark mlen str strlen n with
144 | Some (pos, p2) ->
145 let l = pos - n in
146 let l = min l ((strlen-l)+1) in
147 (p2, l, (us str n l))
148 | None ->
149 (strlen, strlen - n, us str n (strlen-n))
150
151 let upto_mark = upto_mark_ ug
152 let upto_mark_ci = upto_mark_ (fun str n -> Char.lowercase (ug str n))
153
154 (* Stream-based versions *)
155
156 let cmp b mark =
157 let blen = Buffer.length b in
158 let mlen = String.length mark in
159 if blen < mlen
160 then false
161 else
162 let p = ref (blen - mlen) in
163 let m = ref 0 in
164 while !m < mlen && Buffer.nth b (!p) = String.unsafe_get mark (!m) do incr p; incr m done;
165 !m = mlen
166
167 let upto_mark_stream get from mark =
168 let rec aux b =
169 if cmp b mark
170 then Buffer.sub b 0 (Buffer.length b - String.length mark)
171 else
172 try
173 Buffer.add_char b (get from);
174 aux b
175 with End_of_file -> Buffer.contents b
176 in
177 aux (Buffer.create 1024)
178
179 let rec get_char_cps read (str_ref, pos_ref, conn) cont2 =
180 (*#<If>Logger.debug "HttpTools.get_char_cps: pos=%d str='%s'" (!pos_ref) (String.escaped (!str_ref))#<End>;*)
181 let str, pos = !str_ref, !pos_ref in
182 if pos >= String.length str
183 then
184 let k (_, str) =
185 (*#<If>Logger.debug "HttpTools.get_char_cps: read '%s'" (String.escaped str)#<End>;*)
186 str_ref := str; pos_ref := 0;
187 get_char_cps read (str_ref, pos_ref, conn) cont2
188 in
189 read conn k
190 else
191 cont2 (incr pos_ref; str.[pos])
192
193 let upto_mark_stream_cps ?(inclusive=true) buf get from mark cont =
194 (*#<If>Logger.debug "upto_mark_stream_cps: mark='%s'" (String.escaped mark)#<End>;*)
195 let rec aux b =
196 if cmp b mark
197 then
198 let str =
199 if inclusive
200 then Buffer.contents b
201 else Buffer.sub b 0 ((Buffer.length b) - (String.length mark)) in
202 (*#<If>Logger.debug "HttpTools.upto_mark_stream_cps: returning '%s'" (String.escaped str)#<End>;*)
203 cont str
204 else
205 try get from (fun c -> Buffer.add_char b c; aux b);
206 with End_of_file -> cont (Buffer.contents b)
207 in
208 Buffer.clear buf;
209 aux buf
210
211 let upto_stream_cps ?(inclusive=true) buf read (str_ref, pos_ref, conn) mark cont =
212 (*#<If>Logger.debug "upto_stream_cps: mark='%s'" (String.escaped mark)#<End>;*)
213 (*#<If>Logger.debug "upto_stream_cps: pos=%d str='%s'" (!pos_ref) (String.escaped (!str_ref))#<End>;*)
214 try
215 upto_mark_stream_cps ~inclusive buf (get_char_cps read) (str_ref, pos_ref, conn) mark cont
216 with exn ->
217 (*#<If>Logger.debug "upto_stream_cps: exn='%s'" (Printexc.to_string exn)#<End>;*)
218 raise exn
219
220 let read_upto_stream_cps ?(inclusive=true) buf (str_ref, pos_ref, conn) mark sched ?err_cont ?timeout cont =
221 let read = Scheduler.read sched ?err_cont ?timeout in
222 upto_stream_cps ~inclusive buf read (str_ref, pos_ref, conn) mark cont
223
224 let fixed_stream_cps buf read (str_ref, pos_ref, conn) count cont =
225 let rec aux b cnt =
226 if cnt >= count
227 then
228 let str = Buffer.contents b in
229 (*#<If>Logger.debug "HttpTools.fixed_stream_cps: returning '%s'" (String.escaped str)#<End>;*)
230 cont str
231 else
232 let strlen = String.length (!str_ref) in
233 if !pos_ref >= strlen
234 then
235 let aux2 (_, s) =
236 (*#<If>Logger.debug "HttpTools.fixed_stream_cps: read '%s'" (String.escaped s)#<End>;*)
237 let len = String.length s in
238 if cnt + len < count
239 then (Buffer.add_string b s;
240 str_ref := ""; pos_ref := 0;
241 aux b (cnt + len))
242 else (Buffer.add_string b (String.unsafe_sub s 0 (count - cnt));
243 str_ref := String.unsafe_sub s (count - cnt) (len - (count - cnt));
244 pos_ref := 0;
245 aux b count)
246 in
247 (try read conn aux2
248 with End_of_file ->
249 if Buffer.length b > 0
250 then
251 let str = Buffer.contents b in
252 (*#<If>Logger.debug "HttpTools.fixed_stream_cps: returning '%s'" (String.escaped str)#<End>;*)
253 cont str
254 else raise End_of_file)
255 else
256 let len = strlen - (!pos_ref) in
257 if cnt + len < count
258 then (Buffer.add_string b (String.unsafe_sub (!str_ref) (!pos_ref) len);
259 str_ref := ""; pos_ref := 0;
260 aux b (cnt + len))
261 else (Buffer.add_string b (String.unsafe_sub (!str_ref) (!pos_ref) (count - cnt));
262 pos_ref := (!pos_ref) + (count - cnt);
263 aux b count)
264 in
265 Buffer.clear buf;
266 aux buf 0
267
268 let read_fixed_stream_cps buf (str_ref, pos_ref, conn) count sched ?err_cont ?timeout cont =
269 let read = Scheduler.read sched ?err_cont ?timeout in
270 fixed_stream_cps buf read (str_ref, pos_ref, conn) count cont
271
272 let buf_clean (b,pos) =
273 #<If$minlevel 10>Logger.debug "buf_clean: blen=%d pos=%d" (Buffer.length b) (!pos)#<End>;
274 let blen = Buffer.length b in
275 if !pos >= blen
276 then (#<If$minlevel 2>Logger.debug "buf_clean: clear"#<End>; Buffer.clear b; pos := 0)
277 else
278 let tq x = (x lsr 1) + (x lsr 2) in
279 if blen >= 1024 && !pos >= (tq blen)
280 then
281 let str = Buffer.sub b !pos (blen-(!pos)) in
282 Buffer.clear b;
283 Buffer.add_string b str;
284 #<If$minlevel 2>Logger.debug "buf_clean: remove %d shift %d" (blen - Buffer.length b) (String.length str)#<End>;
285 pos := 0
286
287 let cmp2 b pos mark =
288 let mlen = String.length mark in
289 if pos < mlen - 1
290 then false
291 else
292 let p = ref pos in
293 let m = ref (mlen - 1) in
294 while !m >= 0 && Buffer.nth b (!p) = String.unsafe_get mark (!m) do decr p; decr m done;
295 !m < 0
296
297 exception CallbackAbort
298
299 (* We can't optionalize payload because ocaml_parser can't handle optional types. *)
300 let get_callback ?callback payload ?(blocksize=4096) ?err_cont start pos buf () =
301 let cb_start = ref (!pos) in
302 match callback with
303 | Some cb ->
304 (fun () ->
305 if !pos - !cb_start > blocksize
306 then (cb_start := !pos;
307 if cb payload (!pos - start) buf
308 then true
309 else ((match err_cont with
310 | Some err_fn -> err_fn CallbackAbort
311 | None -> raise CallbackAbort);
312 false))
313 else true)
314 | None ->
315 (fun () -> true)
316
317 let upto_mark_stream_cps2 ?(inclusive=true) sched conn (buf,pos) mark
318 ?callback payload ?blocksize ?err_cont ?timeout cont =
319 #<If>Logger.debug "upto_mark_stream_cps2(%d): mark='%s'" conn.Scheduler.conn_id (String.escaped mark)#<End>;
320 buf_clean (buf,pos);
321 let start = (!pos) in
322 let mlen = String.length mark in
323 let ch = String.unsafe_get mark (mlen - 1) in
324 #<If$minlevel 2>Logger.debug "upto_mark_stream_cps2: start=%d buflen=%d" start (Buffer.length buf)#<End>;
325 let call_callback = get_callback ?callback payload ?blocksize ?err_cont start pos buf () in
326 let rec aux () =
327 (*#<If$minlevel 10>Logger.debug "upto_mark_stream_cps2: pos=%d buflen=%d" (!pos) (Buffer.length buf)#<End>;*)
328 if (!pos) >= Buffer.length buf
329 then
330 try
331 Scheduler.read_more2 ?err_cont ?timeout sched conn buf
332 (fun (n,_buf) ->
333 (*#<If$minlevel 10>match oc_opt with
334 | Some oc -> (output_string oc (Buffer.sub _buf !pos n); Pervasives.flush oc)
335 | None -> ()#<End>;*)
336 #<If$minlevel 2>
337 Logger.debug "upto_mark_stream_cps2(%d): read %d" conn.Scheduler.conn_id n;
338 let s = Buffer.sub _buf !pos n in
339 Logger.debug "upto_mark_stream_cps2: buf='%s'..'%s'"
340 (String.escaped (String.limit 128 s))
341 (if String.length s < 128 then "" else (String.escaped (String.sub s (String.length s - 128) 128)))
342 #<End>;
343 if n <= 0 then raise End_of_file else aux ())
344 with
345 | End_of_file -> (Logger.debug "upto_mark_stream_cps2(%d): End_of_file Remaining='%s'"
346 conn.Scheduler.conn_id (String.limit 128 (Buffer.sub buf start ((!pos)-start)));
347 cont (buf,start,(!pos)-start))
348 | exn -> (Logger.debug "upto_mark_stream_cps2(%d): exn=%s Remaining='%s'"
349 conn.Scheduler.conn_id (Printexc.to_string exn)
350 (String.limit 128 (Buffer.sub buf start ((!pos)-start)));
351 raise exn)
352 else
353 (let blen = Buffer.length buf in
354 (*let posstart = !pos in*)
355 while (!pos) < blen && Buffer.nth buf (!pos) <> ch do incr pos done;
356 if call_callback ()
357 then
358 (*Logger.debug "skipped %d" (!pos - posstart);*)
359 if (!pos) >= blen
360 then aux ()
361 else
362 (if cmp2 buf (!pos) mark
363 then
364 (incr pos;
365 let res =
366 if inclusive
367 then (buf,start,(!pos)-start)
368 else (buf,start,(!pos)-start-(String.length mark)) in
369 #<If$minlevel 2>Logger.debug "HttpTools.upto_mark_stream_cps2(%d): returning pos=%d '%s'"
370 conn.Scheduler.conn_id
371 (!pos) (String.escaped (String.limit 80 (Buffer.sub buf start ((!pos)-start))))#<End>;
372 cont res)
373 else (incr pos; aux ()))
374 else ())
375 in
376 aux ()
377
378 let upto_mark_stream_cps3 ?inclusive sched conn (buf,pos) mark ?callback payload ?blocksize ?err_cont ?timeout cont =
379 upto_mark_stream_cps2 ?inclusive sched conn (buf,pos) mark ?callback payload ?blocksize ?err_cont ?timeout
380 (fun (buf,start,len) -> cont (Buffer.sub buf start len))
381
382 let fixed_stream_cps2 sched conn (buf,pos) count ?callback payload ?blocksize ?err_cont ?timeout cont =
383 let conn_id = conn.Scheduler.conn_id in
384 buf_clean (buf,pos);
385 let start = !pos in
386 let call_callback = get_callback ?callback payload ?blocksize ?err_cont start pos buf () in
387 pos := Buffer.length buf;
388 let rec aux () =
389 #<If$minlevel 2>Logger.debug "fixed_stream_cps2: conn_id:%d pos=%d start=%d count=%d buflen=%d"
390 conn_id !pos start count (Buffer.length buf)#<End>;
391 if call_callback ()
392 then begin
393 if !pos - start >= count
394 then
395 (if !pos - start > count then pos := start + count;
396 (*#<If>Logger.debug "HttpTools.fixed_stream_cps2: returning pos=%d '%s'"
397 !pos (String.escaped (Buffer.sub buf start count))#<End>;*)
398 cont (buf,start,count))
399 else
400 let err_cont = Option.default (fun exn -> Logger.debug "fixed_stream_cps2(A): conn_id=%d exn=%s"
401 conn_id (Printexc.to_string exn)) err_cont in
402 (#<If$minlevel 2>Logger.debug "fixed_stream_cps2(read_more2): pos=%d buflen=%d" !pos (Buffer.length buf)#<End>;
403 try Scheduler.read_more2 ?timeout sched conn buf
404 ~err_cont:(function
405 | End_of_file -> (Logger.debug "fixed_stream_cps2: got End_of_file";
406 cont (buf,start,(!pos)-start))
407 | exn -> (Logger.debug "fixed_stream_cps2(B): conn_id=%d exn=%s"
408 conn_id (Printexc.to_string exn);
409 err_cont exn))
410 (fun (n,_buf) ->
411 (*#<If$minlevel 10>match oc_opt with
412 | Some oc -> (output_string oc (Buffer.sub buf !pos n); Pervasives.flush oc)
413 | None -> ()#<End>;*)
414 #<If$minlevel 2>Logger.debug "fixed_stream_cps2: conn_id=%d read %d" conn_id n;
415 (*Logger.debug "fixed_stream_cps2: buf='%s'" (String.escaped (Buffer.contents buf))*)
416 #<End>;
417 if n <= 0
418 then (Logger.debug "fixed_stream_cps2: raising End_of_file"; raise End_of_file)
419 else (pos := !pos + n; aux ()))
420 with exn -> (Logger.debug "fixed_stream_cps2(C): conn_id=%d exn=%s"
421 conn_id (Printexc.to_string exn); cont (buf,start,(!pos)-start)))
422 end
423 else ()
424 in
425 aux ()
426
427 let fixed_stream_cps3 sched conn (buf,pos) count ?callback payload ?blocksize ?err_cont ?timeout cont =
428 fixed_stream_cps2 sched conn (buf,pos) count ?callback payload ?blocksize ?err_cont ?timeout
429 (fun (buf,start,len) -> cont (Buffer.sub buf start len))
430
431 let putback2 str (b, p) =
432 #<If$minlevel 1>Logger.debug "HttpTools.putback2 %d to (buflen=%d,pos=%d)" (String.length str) (Buffer.length b) (!p)#<End>;
433 (*#<If$minlevel 2>Logger.debug "HttpTools.putback2 '%s' to '%s'" (String.escaped str) (String.escaped (!s))#<End>;*)
434 buf_clean (b, p);
435 let blen = Buffer.length b in
436 if !p = 0 && blen = 0
437 then Buffer.add_string b str
438 else
439 (* TODO: this is very inefficient, we need to hack into Buffer and
440 * write a Buffer.blit_in or Buffer.prepend
441 *)
442 let bufstr = Buffer.sub b !p (blen - !p) in
443 Buffer.clear b;
444 Buffer.add_string b str;
445 Buffer.add_string b bufstr;
446 p := 0
447
448 let buflst = ref ([]:Buffer.t list)
449 let bufcnt = ref 0
450
451 let collect_bufs needed =
452 let target = !bufcnt lsr 1 in
453 #<If$minlevel 10>Logger.debug "collect_bufs: needed=%d target=%d bufcnt=%d" needed target !bufcnt#<End>;
454 if target >= 2 && needed <= target
455 then
456 let rec aux () =
457 if !bufcnt > target
458 then (Buffer.reset (List.hd (!buflst));
459 buflst := List.tl (!buflst);
460 decr bufcnt;
461 aux ())
462 else
463 #<If$minlevel 2>Logger.debug "collect_bufs: reduced to %d" !bufcnt#<End>
464 in
465 aux ()
466
467 let get_buf ?(hint=4096) () =
468 match !buflst with
469 | [] -> (#<If$minlevel 2>Logger.debug "get_buf(%d): new" !bufcnt#<End>; Buffer.create hint)
470 | b::t -> (#<If$minlevel 2>Logger.debug "get_buf(%d): old" !bufcnt#<End>; buflst := t; decr bufcnt; Buffer.clear b; b)
471
472 let free_buf b =
473 if Buffer.length b <= (10*1024*1024)
474 then (#<If$minlevel 2>Logger.debug "free_buf(%d): return" !bufcnt#<End>; buflst := b::(!buflst); incr bufcnt)
475 else (#<If$minlevel 2>Logger.debug "free_buf(%d): reset" !bufcnt#<End>; Buffer.reset b)
476
477 let upto mark read conn cont = upto_mark_stream_cps (Buffer.create 1024) (get_char_cps read) conn mark cont
478
479 let putback str (s, p, _) =
480 (*#<If>Logger.debug "HttpTools.putback '%s' to '%s'" (String.escaped str) (String.escaped (!s))#<End>;*)
481 if !p = 0
482 then s := str^(!s)
483 else
484 if !p >= String.length (!s)
485 then (s := str; p := 0)
486 else
487 let strlen = String.length str in
488 if !p >= strlen
489 then (String.unsafe_blit str 0 (!s) ((!p)-strlen) strlen; p := (!p) - strlen)
490 else (String.unsafe_blit str (strlen - (!p)) (!s) 0 (!p);
491 s := (String.unsafe_sub str 0 (strlen-(!p)))^(!s);
492 p := 0)
493
494 let skip_ is_ s l n = let rec sl p = if p >= l then l else if is_ (ug s p) then sl (p+1) else p in sl n
495 let skip_sptab = skip_ Charf.is_sptabf
496 let skip_lws = skip_ Charf.is_spacef
497
498 (* field value can span multiple lines with newline + space *)
499 let upto_mark_lws_ ug mark mlen str strlen n =
500 let pos = skip_sptab str strlen n in
501 let pos0 = pos in
502 match pos_mark ug mark mlen str strlen pos with
503 | Some (pos_, pos) ->
504 let len0 = pos_ - pos0 in
505 let str0 = String.sub str pos0 len0 in
506 if pos >= strlen
507 then (strlen,len0,str0)
508 else if ug str pos <> ' ' && ug str pos <> '\t'
509 then (pos,len0,str0)
510 else
511 let rec uhc str1 len1 pos =
512 let pos = skip_sptab str strlen pos in
513 let pos0 = pos in
514 match pos_mark ug mark mlen str strlen pos with
515 | Some (pos_, pos) ->
516 let l = pos_ - pos0 in
517 let len1 = len1 + l + 1 in
518 let str1 = (String.sub str pos0 l)::str1 in
519 if pos >= strlen
520 then (strlen,len1,String.rev_sconcat " " str1)
521 else if ug str pos <> ' ' && ug str pos <> '\t'
522 then (pos,len1,String.rev_sconcat " " str1)
523 else uhc str1 len1 pos
524 | None ->
525 let l = strlen - pos0 in
526 let len1 = len1 + l + 1 in
527 let str1 = (String.sub str pos0 l)::str1 in
528 (strlen,len1,String.rev_sconcat " " str1)
529 in
530 uhc [str0] len0 pos
531 | None ->
532 (strlen, strlen - n, us str n (strlen-n))
533
534 let upto_mark_lws = upto_mark_lws_ ug
535 let upto_mark_lws_ci = upto_mark_lws_ (fun str n -> Char.lowercase (ug str n))
536
537 (* Had to move this in here because of dependencies. *)
538
539 let content_compress sched gzip deflate compression_level cache_response content content_len =
540 match content with
541 | Rcontent.ContentString str ->
542 (match Compression.compress_content sched gzip deflate compression_level cache_response str content_len with
543 compressed, str -> compressed, Rcontent.ContentString str)
544 | Rcontent.ContentBuffer buf ->
545 (match Compression.compress_content sched gzip deflate compression_level cache_response
546 (Buffer.contents buf) content_len with
547 compressed, str -> compressed, Rcontent.ContentString str)
548 | Rcontent.ContentFBuffer buf ->
549 (match Compression.compress_content sched gzip deflate compression_level cache_response
550 (FBuffer.contents buf) content_len with
551 compressed, str -> compressed, Rcontent.ContentString str)
552 | Rcontent.ContentFile (file,ic_opt,oc_opt,fstat_opt,unlinkable) ->
553 (match Compression.compress_file sched gzip deflate compression_level cache_response file fstat_opt content_len with
554 compressed, file, fstat_opt -> compressed, Rcontent.ContentFile (file,ic_opt,oc_opt,fstat_opt,unlinkable))
555 | Rcontent.ContentNone ->
556 (false, Rcontent.ContentNone)
557
558 let make_ssl_cert ssl_cert ssl_key ssl_pass =
559 if ssl_cert <> "" then
560 if ssl_key <> "" then
561 Some (SslAS.make_ssl_certificate ssl_cert ssl_key ssl_pass)
562 else begin
563 Logger.log "Error : ssl-cert option MUST be used with ssl-key option";
564 exit 1
565 end
566 else
567 None
568
569 let make_ssl_verify ssl_ca_file ssl_ca_path ssl_client_cert_path ssl_client_ca_file ssl_accept_fun ssl_always =
570 if ssl_ca_file <> "" || ssl_ca_path <> "" || ssl_client_cert_path <> "" then
571 Some (SslAS.make_ssl_verify_params ~client_ca_file:ssl_client_ca_file
572 ~accept_fun:ssl_accept_fun ~always:ssl_always
573 ssl_ca_file ssl_ca_path ssl_client_cert_path)
574 else
575 None
Something went wrong with that request. Please try again.