-
Notifications
You must be signed in to change notification settings - Fork 177
/
Copy pathtransfer_io.ml
106 lines (95 loc) · 3.03 KB
/
transfer_io.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
(*
* Copyright (c) 2012 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
open Transfer
module Make(IO : S.IO) = struct
open IO
module Chunked = struct
let read ic =
(* Read chunk size *)
read_line ic >>= function
|Some chunk_size_hex -> begin
let chunk_size =
let hex =
(* chunk size is optionally delimited by ; *)
try String.sub chunk_size_hex 0 (String.rindex chunk_size_hex ';')
with _ -> chunk_size_hex in
try Some (int_of_string ("0x" ^ hex)) with _ -> None
in
match chunk_size with
|None | Some 0 -> return Done
|Some count -> begin
read_exactly ic count >>=
function
|None -> return Done
|Some buf ->
read_line ic >>= fun _ -> (* Junk the CRLF at end of chunk *)
return (Chunk buf)
end
end
|None -> return Done
let write oc buf =
let len = String.length buf in
write oc (Printf.sprintf "%x\r\n" len) >>= fun () ->
write oc buf >>= fun () ->
write oc "\r\n"
end
module Fixed = struct
let read ~len ic =
(* TODO functorise string to a bigbuffer *)
match len with
|0 -> return Done
|len ->
read_exactly ic len >>= function
|None -> return Done
|Some buf -> return (Final_chunk buf)
(* TODO enforce that the correct length is written? *)
let write oc buf =
write oc buf
end
module Unknown = struct
(* If we have no idea, then read one chunk and return it.
* TODO should this be a read with an explicit timeout? *)
let read ic =
read ic 16384 >>= fun buf -> return (Final_chunk buf)
let write oc buf =
write oc buf
end
let read =
function
| Chunked -> Chunked.read
| Fixed len -> Fixed.read ~len
| Unknown -> Unknown.read
let write =
function
| Chunked -> Chunked.write
| Fixed len -> Fixed.write
| Unknown -> Unknown.write
let to_string encoding ic =
let buf = Buffer.create 256 in
let rec loop () =
read encoding ic >>= function
|Chunk c ->
Buffer.add_string buf c;
loop ()
|Final_chunk c ->
Buffer.add_string buf c;
return (Buffer.contents buf)
|Done ->
return (Buffer.contents buf)
in
loop ()
end