├── .gitignore ├── .ocamlformat ├── .ocp-indent ├── CHANGES.md ├── LICENCE ├── Makefile ├── README.md ├── TODO.md ├── bin ├── dune └── main.ml ├── debian-11.4.0-amd64-netinst.iso.torrent ├── dune-project └── lib ├── bencode.ml ├── bencode.mli ├── dune ├── meta.ml ├── meta.mli ├── peer.ml ├── peer.mli ├── sexp.ml ├── sexp.mli ├── torrent.ml ├── torrent.mli ├── tracker.ml └── tracker.mli /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nojb/ocaml-bt/a58282dea0c15394e5b336d12bd1c87a7f2803af/.ocamlformat -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=auto 2 | align_ops=false 3 | match_clause=4 4 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.3.0 (in progress) 2 | * Add DHT support 3 | 4 | 0.2 (2014-05-11) 5 | * Library: encryption support 6 | * Library: much improved peer & piece selection 7 | * Client: better stats reporting 8 | 9 | 0.1.2 (2014-04-19) 10 | * Initial public release. 11 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016-2022 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all 2 | all: 3 | dune build 4 | 5 | .PHONY: fmt 6 | fmt: 7 | dune fmt 8 | 9 | .PHONY: clean 10 | clean: 11 | dune clean 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-bt 2 | 3 | OCaml-BT is a small BitTorrent library and client written in OCaml. It uses Lwt for concurrency. 4 | 5 | This is a preliminary release. 6 | 7 | ## Installation 8 | 9 | The easiest way is to use [OPAM](http://opam.ocaml.org). 10 | ```sh 11 | opam install bt 12 | ``` 13 | 14 | Alternatively, clone from git and install manually: 15 | ```sh 16 | cd ~/tmp 17 | git clone https://github.com/nojb/ocaml-bt 18 | cd ocaml-bt 19 | make 20 | make install 21 | ``` 22 | 23 | Either way the end-result will be a OCaml library (findlib name: `bt`) and a executable `otorrent`. 24 | 25 | ### Usage 26 | 27 | Right now the only supported way to download torrents is via the use of magnet 28 | links, but other ways will hopefully be added soon. For example, the following 29 | will download the "Ubuntu 13.10 Desktop Live ISO amd64" torrent to your current 30 | working directory. 31 | 32 | ```sh 33 | otorrent "magnet:?xt=urn:btih:e3811b9539cacff680e418124272177c47477157&dn=Ubuntu+13.10+Desktop+Live+ISO+amd64&tr=udp%3A//tracker.openbittorrent.com%3A80&tr=udp%3A//tracker.publicbt.com%3A80&tr=udp%3A//tracker.istole.it%3A6969&tr=udp%3A//tracker.ccc.de%3A80&tr=udp%3A//open.demonii.com%3A1337" 34 | ``` 35 | 36 | ### TODO 37 | 38 | - DHT - DONE 39 | - uTP 40 | - Fast Resume 41 | - Encryption - DONE 42 | - PEX - DONE 43 | - LPD 44 | - UPnP 45 | - NAT-PMP 46 | - SOCKS 47 | 48 | ## Comments 49 | 50 | Comments, bug reports and feature requests are very welcome: n.oje.bar@gmail.com. 51 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - timeout peer transfers 2 | - timeout peers that do not transfer 3 | - utp 4 | - dht 5 | - upnp nat 6 | - pmp-nat 7 | - proxy 8 | - fast resume 9 | - multiple torrents 10 | - global blacklist 11 | - encryption 12 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names main) 3 | (libraries bt eio_main)) 4 | -------------------------------------------------------------------------------- /bin/main.ml: -------------------------------------------------------------------------------- 1 | open Bt 2 | 3 | let read_torrent_file ~dir path = 4 | let s = Eio.Path.load Eio.Path.(dir / path) in 5 | let t = 6 | match Bencode.decode s with 7 | | Some t -> t 8 | | None -> failwith (Printf.sprintf "Could not parse torrent file %S" path) 9 | in 10 | match Bencode.Decoder.query Meta.decoder t with 11 | | Some t -> t 12 | | None -> failwith (Printf.sprintf "Could not parse metainfo file %S" path) 13 | 14 | let random_string state n = 15 | String.init n (fun _ -> char_of_int (Random.State.int state 256)) 16 | 17 | let anon ~env ~rng path = 18 | let meta = 19 | let dir = Eio.Stdenv.fs env in 20 | read_torrent_file ~dir path 21 | in 22 | let info_hash = meta.Meta.info_hash in 23 | let peer_id = random_string rng 20 in 24 | let port = Random.State.int rng 10000 in 25 | let left = Meta.length meta in 26 | let net = Eio.Stdenv.net env in 27 | let resp = 28 | Tracker.announce ~net ~info_hash ~peer_id ~port ~uploaded:0 ~downloaded:0 29 | ~left meta.Meta.announce 30 | in 31 | let sexp = Tracker.Response.to_sexp resp in 32 | Format.printf "@[%a@]@." Sexp.print sexp; 33 | match resp with 34 | | Failure s -> failwith s 35 | | Ok { Tracker.Response.interval = _; peers; peers6 = _ } -> 36 | let clock = Eio.Stdenv.clock env in 37 | let cwd = Eio.Stdenv.cwd env in 38 | Torrent.download ~net ~clock ~cwd ~info_hash ~peer_id ~meta ~peers 39 | 40 | let anon path = 41 | let rng = Random.State.make_self_init () in 42 | Eio_main.run (fun env -> anon ~env ~rng path) 43 | 44 | let spec = [] 45 | 46 | let () = 47 | Logs.set_level ~all:true (Some Info); 48 | Logs.set_reporter (Logs.format_reporter ()); 49 | Arg.parse (Arg.align spec) anon "" 50 | -------------------------------------------------------------------------------- /debian-11.4.0-amd64-netinst.iso.torrent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nojb/ocaml-bt/a58282dea0c15394e5b336d12bd1c87a7f2803af/debian-11.4.0-amd64-netinst.iso.torrent -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | 3 | (name bt) 4 | -------------------------------------------------------------------------------- /lib/bencode.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | Int of int 3 | | String of string 4 | | List of t list 5 | | Dict of (string * t) list 6 | 7 | let rec to_sexp t = 8 | let open Sexp.Encoder in 9 | match t with 10 | | Int n -> int n 11 | | String s -> string s 12 | | List l -> list to_sexp l 13 | | Dict l -> list (pair string to_sexp) l 14 | 15 | (* TODO : check for leading zeros (invalid) *) 16 | 17 | let rec decode s i = 18 | match s.[i] with 19 | | 'i' -> 20 | let rec loop accu i = 21 | if i = String.length s then raise Exit; 22 | match s.[i] with 23 | | 'e' -> (Int accu, i + 1) 24 | | '0' .. '9' as c -> 25 | loop ((10 * accu) + (Char.code c - Char.code '0')) (i + 1) 26 | | _ -> raise Exit 27 | in 28 | loop 0 (i + 1) 29 | | 'l' -> 30 | let rec loop accu i = 31 | if i = String.length s then raise Exit; 32 | match s.[i] with 33 | | 'e' -> (List (List.rev accu), i + 1) 34 | | _ -> 35 | let x, i = decode s i in 36 | loop (x :: accu) i 37 | in 38 | loop [] (i + 1) 39 | | '0' .. '9' -> 40 | let rec loop accu i = 41 | if i = String.length s then raise Exit; 42 | match s.[i] with 43 | | '0' .. '9' as c -> 44 | loop ((10 * accu) + Char.code c - Char.code '0') (i + 1) 45 | | ':' -> (String (String.sub s (i + 1) accu), i + 1 + accu) 46 | | _ -> raise Exit 47 | in 48 | loop 0 i 49 | | 'd' -> 50 | let rec loop accu i = 51 | if i = String.length s then raise Exit; 52 | match s.[i] with 53 | | 'e' -> (Dict (List.rev accu), i + 1) 54 | | _ -> ( 55 | match decode s i with 56 | | String k, i -> 57 | let v, i = decode s i in 58 | loop ((k, v) :: accu) i 59 | | _ -> raise Exit) 60 | in 61 | loop [] (i + 1) 62 | | _ -> raise Exit 63 | 64 | let decode s = 65 | match decode s 0 with 66 | | x, i -> if i = String.length s then Some x else None 67 | | exception Exit -> None 68 | 69 | let rec encode buf = function 70 | | Int n -> 71 | Buffer.add_char buf 'i'; 72 | Buffer.add_string buf (string_of_int n); 73 | Buffer.add_char buf 'e' 74 | | String s -> 75 | Buffer.add_string buf (string_of_int (String.length s)); 76 | Buffer.add_char buf ':'; 77 | Buffer.add_string buf s 78 | | List l -> 79 | Buffer.add_char buf 'l'; 80 | List.iter (encode buf) l; 81 | Buffer.add_char buf 'e' 82 | | Dict l -> 83 | Buffer.add_char buf 'd'; 84 | List.iter 85 | (fun (k, v) -> 86 | Buffer.add_string buf (string_of_int (String.length k)); 87 | Buffer.add_char buf ':'; 88 | Buffer.add_string buf k; 89 | encode buf v) 90 | l; 91 | Buffer.add_char buf 'e' 92 | 93 | let encode t = 94 | let buf = Buffer.create 17 in 95 | encode buf t; 96 | Buffer.contents buf 97 | 98 | module Decoder = struct 99 | type bencode = t 100 | type 'a t = bencode -> 'a 101 | 102 | let int = function Int n -> n | _ -> raise Exit 103 | let string = function String s -> s | _ -> raise Exit 104 | let list p = function List l -> List.map p l | _ -> raise Exit 105 | 106 | let member s p = function 107 | | Dict l -> ( 108 | match List.assoc s l with x -> p x | exception Not_found -> raise Exit) 109 | | _ -> raise Exit 110 | 111 | let if_member s p q = function 112 | | Dict l as x -> ( 113 | match List.assoc s l with x -> p x | exception Not_found -> q x) 114 | | _ -> raise Exit 115 | 116 | let if_list p q = function List l -> List.map p l | _ as x -> q x 117 | let value t = t 118 | let query p t = match p t with x -> Some x | exception Exit -> None 119 | 120 | module O = struct 121 | let ( let+ ) p f t = f (p t) 122 | let ( and+ ) p q t = (p t, q t) 123 | end 124 | end 125 | -------------------------------------------------------------------------------- /lib/bencode.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | Int of int 3 | | String of string 4 | | List of t list 5 | | Dict of (string * t) list 6 | 7 | val to_sexp : t Sexp.Encoder.t 8 | val decode : string -> t option 9 | val encode : t -> string 10 | 11 | module Decoder : sig 12 | type bencode 13 | type 'a t 14 | 15 | val int : int t 16 | val string : string t 17 | val list : 'a t -> 'a list t 18 | val member : string -> 'a t -> 'a t 19 | val if_member : string -> 'a t -> 'a t -> 'a t 20 | val if_list : 'a t -> 'a list t -> 'a list t 21 | val value : bencode t 22 | val query : 'a t -> bencode -> 'a option 23 | 24 | module O : sig 25 | val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t 26 | val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t 27 | end 28 | end 29 | with type bencode := t 30 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name bt) 3 | (libraries eio eio.unix sha logs)) 4 | -------------------------------------------------------------------------------- /lib/meta.ml: -------------------------------------------------------------------------------- 1 | type file = { length : int; path : string } 2 | 3 | type t = { 4 | announce : string; 5 | comment : string; 6 | files : file list; 7 | piece_length : int; 8 | pieces : string array; 9 | info_hash : string; 10 | } 11 | 12 | let to_sexp t = 13 | let open Sexp.Encoder in 14 | let file t = record [ ("length", int t.length); ("path", string t.path) ] in 15 | record 16 | [ 17 | ("announce", string t.announce); 18 | ("comment", string t.comment); 19 | ("files", list file t.files); 20 | ("piece_length", int t.piece_length); 21 | ("pieces", array string t.pieces); 22 | ("info_hash", string t.info_hash); 23 | ] 24 | 25 | let decoder = 26 | let open Bencode.Decoder in 27 | let open Bencode.Decoder.O in 28 | let+ announce = member "announce" string 29 | and+ comment = member "comment" string 30 | and+ name = member "info" (member "name" string) 31 | and+ files = 32 | let file = 33 | let+ length = member "length" int 34 | and+ path = member "path" (list string) in 35 | (length, path) 36 | in 37 | member "info" 38 | (if_member "length" 39 | (let+ length = int in 40 | `Single length) 41 | (let+ files = member "files" (list file) in 42 | `Multiple files)) 43 | and+ piece_length = member "info" (member "piece length" int) 44 | and+ pieces = member "info" (member "pieces" string) 45 | and+ info_hash = 46 | member "info" 47 | (let+ v = value in 48 | Sha1.to_bin (Sha1.string (Bencode.encode v))) 49 | in 50 | let pieces = 51 | let hash_size = 20 in 52 | assert (String.length pieces mod hash_size = 0); 53 | Array.init 54 | (String.length pieces / hash_size) 55 | (fun i -> String.sub pieces (i * hash_size) hash_size) 56 | in 57 | let files = 58 | match files with 59 | | `Single length -> [ { length; path = name } ] 60 | | `Multiple files -> 61 | List.map 62 | (fun (length, path) -> 63 | { length; path = String.concat "/" (name :: path) }) 64 | files 65 | in 66 | { announce; comment; files; piece_length; pieces; info_hash } 67 | 68 | let length t = 69 | List.fold_left (fun accu { length; _ } -> accu + length) 0 t.files 70 | 71 | let piece_length t i = min t.piece_length (length t - (t.piece_length * i)) 72 | let piece_offset t i = i * t.piece_length 73 | -------------------------------------------------------------------------------- /lib/meta.mli: -------------------------------------------------------------------------------- 1 | type file = { length : int; path : string } 2 | 3 | type t = { 4 | announce : string; 5 | comment : string; 6 | files : file list; 7 | piece_length : int; 8 | pieces : string array; 9 | info_hash : string; 10 | } 11 | 12 | val to_sexp : t Sexp.Encoder.t 13 | val decoder : t Bencode.Decoder.t 14 | val length : t -> int 15 | val piece_length : t -> int -> int 16 | val piece_offset : t -> int -> int 17 | -------------------------------------------------------------------------------- /lib/peer.ml: -------------------------------------------------------------------------------- 1 | module Handshake = struct 2 | type t = { pstr : string; info_hash : string; peer_id : string } 3 | 4 | let to_sexp t = 5 | let open Sexp.Encoder in 6 | record 7 | [ 8 | ("pstr", string t.pstr); 9 | ("info_hash", string t.info_hash); 10 | ("peer_id", string t.peer_id); 11 | ] 12 | 13 | let create ~info_hash ~peer_id = 14 | { pstr = "BitTorrent protocol"; info_hash; peer_id } 15 | 16 | let parser = 17 | let open Eio.Buf_read.Syntax in 18 | let* len = Eio.Buf_read.any_char in 19 | let len = Char.code len in 20 | let+ pstr = Eio.Buf_read.take len 21 | and+ () = Eio.Buf_read.skip 8 22 | and+ info_hash = Eio.Buf_read.take 20 23 | and+ peer_id = Eio.Buf_read.take 20 in 24 | { pstr; info_hash; peer_id } 25 | 26 | let write t buf = 27 | Eio.Buf_write.uint8 buf (String.length t.pstr); 28 | Eio.Buf_write.string buf t.pstr; 29 | Eio.Buf_write.string buf (String.make 8 '\000'); 30 | Eio.Buf_write.string buf t.info_hash; 31 | Eio.Buf_write.string buf t.peer_id 32 | end 33 | 34 | module Message = struct 35 | type t = 36 | | Keepalive 37 | | Choke 38 | | Unchoke 39 | | Interested 40 | | Not_interested 41 | | Have of int 42 | | Bitfield of string 43 | | Request of { i : int; ofs : int; len : int } 44 | | Piece of { i : int; ofs : int; data : string } 45 | | Cancel of { i : int; ofs : int; len : int } 46 | 47 | let to_sexp t = 48 | let open Sexp.Encoder in 49 | match t with 50 | | Keepalive -> variant "keepalive" [] 51 | | Choke -> variant "choke" [] 52 | | Unchoke -> variant "unchoke" [] 53 | | Interested -> variant "interested" [] 54 | | Not_interested -> variant "not_interested" [] 55 | | Have i -> variant "have" [ int i ] 56 | | Bitfield s -> variant "bitfield" [ string s ] 57 | | Request { i; ofs; len } -> variant "request" [ int i; int ofs; int len ] 58 | | Piece { i; ofs; data } -> variant "piece" [ int i; int ofs; string data ] 59 | | Cancel { i; ofs; len } -> variant "cancel" [ int i; int ofs; int len ] 60 | 61 | let get_int s ofs = 62 | match Int32.unsigned_to_int (String.get_int32_be s ofs) with 63 | | Some n -> n 64 | | None -> assert false 65 | 66 | let parser = 67 | let open Eio.Buf_read.Syntax in 68 | let* len = Eio.Buf_read.take 4 in 69 | let len = get_int len 0 in 70 | if len = 0 then Eio.Buf_read.return Keepalive 71 | else 72 | let+ msg = Eio.Buf_read.take len in 73 | match Char.code msg.[0] with 74 | | 0 -> Choke 75 | | 1 -> Unchoke 76 | | 2 -> Interested 77 | | 3 -> Not_interested 78 | | 4 -> Have (get_int msg 1) 79 | | 5 -> Bitfield (String.sub msg 1 (String.length msg - 1)) 80 | | 6 -> 81 | let i = get_int msg 1 in 82 | let ofs = get_int msg 5 in 83 | let len = get_int msg 9 in 84 | Request { i; ofs; len } 85 | | 7 -> 86 | let i = get_int msg 1 in 87 | let ofs = get_int msg 5 in 88 | let data = String.sub msg 9 (String.length msg - 9) in 89 | Piece { i; ofs; data } 90 | | 8 -> 91 | let i = get_int msg 1 in 92 | let ofs = get_int msg 5 in 93 | let len = get_int msg 9 in 94 | Cancel { i; ofs; len } 95 | | _ -> assert false 96 | 97 | let write t buf = 98 | match t with 99 | | Keepalive -> Eio.Buf_write.BE.uint32 buf 0l 100 | | Choke -> 101 | Eio.Buf_write.BE.uint32 buf 1l; 102 | Eio.Buf_write.uint8 buf 0 103 | | Unchoke -> 104 | Eio.Buf_write.BE.uint32 buf 1l; 105 | Eio.Buf_write.uint8 buf 1 106 | | Interested -> 107 | Eio.Buf_write.BE.uint32 buf 1l; 108 | Eio.Buf_write.uint8 buf 2 109 | | Not_interested -> 110 | Eio.Buf_write.BE.uint32 buf 1l; 111 | Eio.Buf_write.uint8 buf 3 112 | | Have i -> 113 | Eio.Buf_write.BE.uint32 buf 5l; 114 | Eio.Buf_write.uint8 buf 4; 115 | Eio.Buf_write.BE.uint32 buf (Int32.of_int i) 116 | | Bitfield bits -> 117 | Eio.Buf_write.BE.uint32 buf (Int32.of_int (1 + String.length bits)); 118 | Eio.Buf_write.uint8 buf 5; 119 | Eio.Buf_write.string buf bits 120 | | Request { i; ofs; len } -> 121 | Eio.Buf_write.BE.uint32 buf 13l; 122 | Eio.Buf_write.uint8 buf 6; 123 | Eio.Buf_write.BE.uint32 buf (Int32.of_int i); 124 | Eio.Buf_write.BE.uint32 buf (Int32.of_int ofs); 125 | Eio.Buf_write.BE.uint32 buf (Int32.of_int len) 126 | | Piece { i; ofs; data } -> 127 | Eio.Buf_write.BE.uint32 buf 13l; 128 | Eio.Buf_write.uint8 buf 7; 129 | Eio.Buf_write.BE.uint32 buf (Int32.of_int i); 130 | Eio.Buf_write.BE.uint32 buf (Int32.of_int ofs); 131 | Eio.Buf_write.string buf data 132 | | Cancel { i; ofs; len } -> 133 | Eio.Buf_write.BE.uint32 buf 13l; 134 | Eio.Buf_write.uint8 buf 8; 135 | Eio.Buf_write.BE.uint32 buf (Int32.of_int i); 136 | Eio.Buf_write.BE.uint32 buf (Int32.of_int ofs); 137 | Eio.Buf_write.BE.uint32 buf (Int32.of_int len) 138 | end 139 | 140 | type error = 141 | [ `Connect_failed of [ `Exn of exn | `Timeout ] 142 | | `Handshake_failed of 143 | [ `Exn of exn | `Msg of string | `Timeout | `Info_hash_mismatch ] 144 | | `Expected_bitfield 145 | | `Msg of string ] 146 | 147 | let string_of_error = function 148 | | `Connect_failed err -> 149 | let msg = 150 | match err with 151 | | `Exn exn -> Printexc.to_string exn 152 | | `Timeout -> "timeout" 153 | in 154 | Printf.sprintf "connect failed: %s" msg 155 | | `Handshake_failed err -> 156 | let msg = 157 | match err with 158 | | `Exn exn -> Printexc.to_string exn 159 | | `Msg msg -> msg 160 | | `Timeout -> "timeout" 161 | | `Info_hash_mismatch -> "info hash mismatch" 162 | in 163 | Printf.sprintf "handshake failed: %s" msg 164 | | `Expected_bitfield -> "did not receive bitfield" 165 | | `Msg msg -> Printf.sprintf "connection error: %s" msg 166 | 167 | let connect ~sw ~net ~clock addr port = 168 | let stream = `Tcp (Eio_unix.Ipaddr.of_unix addr, port) in 169 | Logs.debug (fun f -> f "Connecting to %s" (Unix.string_of_inet_addr addr)); 170 | match 171 | Eio.Time.with_timeout_exn clock 3.0 (fun () -> 172 | Eio.Net.connect ~sw net stream) 173 | with 174 | | flow -> 175 | Logs.debug (fun f -> 176 | f "Connected to %s%!" (Unix.string_of_inet_addr addr)); 177 | Ok (flow :> Eio.Net.stream_socket) 178 | | exception Eio.Time.Timeout -> Error (`Connect_failed `Timeout) 179 | | exception exn -> 180 | Logs.debug (fun f -> 181 | f "Connection to %s failed: %s%!" 182 | (Unix.string_of_inet_addr addr) 183 | (Printexc.to_string exn)); 184 | Error (`Connect_failed (`Exn exn)) 185 | 186 | let complete_handshake ~clock ~flow ~info_hash ~peer_id = 187 | let h = Handshake.create ~info_hash ~peer_id in 188 | match 189 | Eio.Time.with_timeout clock 3.0 @@ fun () -> 190 | Eio.Buf_write.with_flow flow (fun buf -> Handshake.write h buf); 191 | Eio.Buf_read.format_errors Handshake.parser 192 | (Eio.Buf_read.of_flow ~max_size:100000 flow) 193 | with 194 | | Ok r -> 195 | if r.info_hash <> info_hash then 196 | Error (`Handshake_failed `Info_hash_mismatch) 197 | else Ok r 198 | | Error err -> Error (`Handshake_failed err) 199 | | exception exn -> Error (`Handshake_failed (`Exn exn)) 200 | 201 | let receive_bitfield ~flow = 202 | match 203 | Eio.Buf_read.format_errors Message.parser 204 | (Eio.Buf_read.of_flow ~max_size:1_000_000 flow) 205 | with 206 | | Error err -> Error err 207 | | Ok (Bitfield bits) -> Ok bits 208 | | Ok _ -> Error `Expected_bitfield 209 | 210 | type t = { 211 | flow : Eio.Net.stream_socket; 212 | info_hash : string; 213 | peer_id : string; 214 | bitfield : bytes; 215 | mutable choked : bool; 216 | } 217 | 218 | let run ~net ~clock ~sw ~info_hash ~peer_id addr port = 219 | match connect ~sw ~net ~clock addr port with 220 | | Error _ as err -> err 221 | | Ok flow -> ( 222 | match complete_handshake ~clock ~flow ~info_hash ~peer_id with 223 | | Error _ as err -> err 224 | | Ok { Handshake.info_hash; peer_id; _ } -> ( 225 | match receive_bitfield ~flow with 226 | | Error _ as err -> err 227 | | Ok bitfield -> 228 | let bitfield = Bytes.of_string bitfield in 229 | Ok { flow; info_hash; peer_id; bitfield; choked = true })) 230 | 231 | let choked t = t.choked 232 | 233 | let has_piece t i = 234 | assert (i >= 0); 235 | let byte_num = i / 8 in 236 | let byte_ofs = i mod 8 in 237 | (Char.code (Bytes.get t.bitfield byte_num) lsr (7 - byte_ofs)) land 1 <> 0 238 | 239 | let set_piece t i = 240 | assert (i >= 0); 241 | let byte_num = i / 8 in 242 | let byte_ofs = i mod 8 in 243 | Bytes.set t.bitfield byte_num 244 | (Char.chr 245 | (Char.code (Bytes.get t.bitfield byte_num) lor ((1 lsl 7) - byte_ofs))) 246 | 247 | let send_message t msg = Eio.Buf_write.with_flow t.flow (Message.write msg) 248 | let send_unchoke t = send_message t Unchoke 249 | let send_interested t = send_message t Interested 250 | let send_request t ~i ~ofs ~len = send_message t (Request { i; ofs; len }) 251 | 252 | let read_message t = 253 | let msg = Message.parser (Eio.Buf_read.of_flow ~max_size:1_000_000 t.flow) in 254 | (match msg with 255 | | Choke -> t.choked <- true 256 | | Unchoke -> t.choked <- false 257 | | Have i -> set_piece t i 258 | | Keepalive | Interested | Not_interested | Bitfield _ | Request _ | Piece _ 259 | | Cancel _ -> 260 | ()); 261 | msg 262 | -------------------------------------------------------------------------------- /lib/peer.mli: -------------------------------------------------------------------------------- 1 | module Handshake : sig 2 | type t 3 | 4 | val to_sexp : t -> Sexp.t 5 | end 6 | 7 | module Message : sig 8 | type t = 9 | | Keepalive 10 | | Choke 11 | | Unchoke 12 | | Interested 13 | | Not_interested 14 | | Have of int 15 | | Bitfield of string 16 | | Request of { i : int; ofs : int; len : int } 17 | | Piece of { i : int; ofs : int; data : string } 18 | | Cancel of { i : int; ofs : int; len : int } 19 | 20 | val to_sexp : t -> Sexp.t 21 | end 22 | 23 | type t 24 | 25 | type error = 26 | [ `Connect_failed of [ `Exn of exn | `Timeout ] 27 | | `Handshake_failed of 28 | [ `Exn of exn | `Msg of string | `Timeout | `Info_hash_mismatch ] 29 | | `Expected_bitfield 30 | | `Msg of string ] 31 | 32 | val string_of_error : error -> string 33 | 34 | val run : 35 | net:Eio.Net.t -> 36 | clock:Eio.Time.clock -> 37 | sw:Eio.Switch.t -> 38 | info_hash:string -> 39 | peer_id:string -> 40 | Unix.inet_addr -> 41 | int -> 42 | (t, [> error ]) result 43 | 44 | val choked : t -> bool 45 | val has_piece : t -> int -> bool 46 | val send_unchoke : t -> unit 47 | val send_interested : t -> unit 48 | val send_request : t -> i:int -> ofs:int -> len:int -> unit 49 | val read_message : t -> Message.t 50 | -------------------------------------------------------------------------------- /lib/sexp.ml: -------------------------------------------------------------------------------- 1 | type t = Atom of string | List of t list 2 | 3 | module Encoder = struct 4 | type sexp = t 5 | type 'a t = 'a -> sexp 6 | 7 | let int n = Atom (string_of_int n) 8 | let string s = Atom s 9 | let list t l = List (List.map t l) 10 | let pair t u (x, y) = List [ t x; u y ] 11 | let array t a = List (List.map t (Array.to_list a)) 12 | let record l = List (List.map (fun (k, v) -> List [ string k; v ]) l) 13 | let variant s ts = List (string s :: ts) 14 | let run t x = t x 15 | end 16 | 17 | let is_ascii s = 18 | String.for_all 19 | (fun c -> 20 | let c = Char.code c in 21 | 32 <= c && c <= 127) 22 | s 23 | 24 | let max_blob_print_length = 20 25 | 26 | let rec print ppf = function 27 | | Atom s -> 28 | if is_ascii s then Format.pp_print_string ppf s 29 | else 30 | let s = 31 | if String.length s > max_blob_print_length then 32 | String.sub s 0 (max_blob_print_length - 2) ^ ".." 33 | else s 34 | in 35 | Format.fprintf ppf "%S" s 36 | | List l -> 37 | Format.fprintf ppf "@[<1>(%a)@]" 38 | (Format.pp_print_list ~pp_sep:Format.pp_print_space print) 39 | l 40 | -------------------------------------------------------------------------------- /lib/sexp.mli: -------------------------------------------------------------------------------- 1 | type t = Atom of string | List of t list 2 | 3 | module Encoder : sig 4 | type sexp 5 | type 'a t = 'a -> sexp 6 | 7 | val int : int t 8 | val string : string t 9 | val list : 'a t -> 'a list t 10 | val pair : 'a t -> 'b t -> ('a * 'b) t 11 | val array : 'a t -> 'a array t 12 | val record : (string * sexp) list -> sexp 13 | val variant : string -> sexp list -> sexp 14 | val run : 'a t -> 'a -> sexp 15 | end 16 | with type sexp := t 17 | 18 | val print : Format.formatter -> t -> unit 19 | -------------------------------------------------------------------------------- /lib/torrent.ml: -------------------------------------------------------------------------------- 1 | module Piece = struct 2 | type t = { i : int; hash : string; len : int } 3 | end 4 | 5 | let check_integriy piece buf = piece.Piece.hash = Sha1.to_bin (Sha1.string buf) 6 | let max_block_size = 16384 7 | let max_backlog = 5 8 | 9 | let attempt_download_piece ~clock ~peer ~piece = 10 | let downloaded = ref 0 in 11 | let requested = ref 0 in 12 | let backlog = ref 0 in 13 | let buf = Bytes.create piece.Piece.len in 14 | Eio.Time.with_timeout clock 30.0 @@ fun () -> 15 | while !downloaded < piece.Piece.len do 16 | if not (Peer.choked peer) then 17 | while !backlog < max_backlog && !requested < piece.Piece.len do 18 | let block_size = min max_block_size (piece.Piece.len - !requested) in 19 | Peer.send_request peer ~i:piece.Piece.i ~ofs:!requested ~len:block_size; 20 | requested := !requested + block_size; 21 | backlog := !backlog + 1 22 | done; 23 | match Peer.read_message peer with 24 | | Peer.Message.Piece { i = _; ofs; data } -> 25 | let len = String.length data in 26 | Bytes.blit_string data 0 buf ofs len; 27 | downloaded := !downloaded + len; 28 | backlog := !backlog - 1 29 | | _ -> () 30 | done; 31 | let buf = Bytes.unsafe_to_string buf in 32 | if check_integriy piece buf then Error `Hash_failed else Ok buf 33 | 34 | let start_download_worker ~sw ~net ~clock ~info_hash ~peer_id ~peer ~work_queue 35 | ~results = 36 | let on_error exn = raise exn in 37 | (* FIXME *) 38 | Eio.Fiber.fork_sub ~sw ~on_error @@ fun sw -> 39 | match peer.Tracker.Response.Peer.ip with 40 | | `Ipaddr addr -> ( 41 | let peer = 42 | Peer.run ~net ~clock ~sw ~info_hash ~peer_id addr 43 | peer.Tracker.Response.Peer.port 44 | in 45 | match peer with 46 | | Error err -> 47 | Logs.debug (fun f -> 48 | f "Connection to %s failed: %s" 49 | (Unix.string_of_inet_addr addr) 50 | (Peer.string_of_error err)) 51 | | Ok peer -> 52 | Logs.debug (fun f -> 53 | f "Completed handshake with %s" (Unix.string_of_inet_addr addr)); 54 | Peer.send_unchoke peer; 55 | Peer.send_interested peer; 56 | let rec loop () = 57 | let piece = Eio.Stream.take work_queue in 58 | if not (Peer.has_piece peer piece.Piece.i) then ( 59 | Eio.Stream.add work_queue piece; 60 | loop ()) 61 | else ( 62 | (match attempt_download_piece ~clock ~peer ~piece with 63 | | Ok buf -> Eio.Stream.add results (piece, buf) 64 | | Error `Hash_failed -> 65 | Logs.warn (fun f -> 66 | f "Piece #%d failed integrity check" piece.Piece.i); 67 | Eio.Stream.add work_queue piece 68 | | Error `Timeout -> 69 | Logs.warn (fun f -> f "Piece #%d timed out" piece.Piece.i); 70 | Eio.Stream.add work_queue piece); 71 | loop ()) 72 | in 73 | loop ()) 74 | | `Name _ -> () 75 | 76 | let piece_bounds ~piece_offset ~piece_length files = 77 | let rec loop piece_ofs buf_ofs buf_len = function 78 | | [] -> assert false 79 | | (file, file_length) :: files -> 80 | let file_rem = file_length - piece_ofs in 81 | if file_rem <= 0 then loop (-file_rem) buf_ofs buf_len files 82 | else if buf_len <= file_rem then [ (file, piece_ofs, buf_ofs, buf_len) ] 83 | else 84 | (file, piece_ofs, buf_ofs, file_rem) 85 | :: loop 0 (buf_ofs + file_rem) (buf_len - file_rem) files 86 | in 87 | loop piece_offset 0 piece_length files 88 | 89 | let download ~net ~clock ~cwd ~info_hash ~peer_id ~meta ~peers = 90 | let num_pieces = Array.length meta.Meta.pieces in 91 | let work_queue = Eio.Stream.create num_pieces in 92 | let results = Eio.Stream.create 100 in 93 | Eio.Switch.run @@ fun sw -> 94 | let files = 95 | List.map 96 | (fun file -> 97 | Eio.Path.open_out ~sw ~create:(`If_missing 0o600) 98 | Eio.Path.(cwd / file.Meta.path)) 99 | meta.Meta.files 100 | in 101 | for i = 0 to num_pieces - 1 do 102 | let hash = meta.Meta.pieces.(i) in 103 | let len = Meta.piece_length meta i in 104 | Eio.Stream.add work_queue { Piece.i; hash; len } 105 | done; 106 | Eio.Fiber.first 107 | (fun () -> 108 | Eio.Fiber.iter 109 | (fun peer -> 110 | start_download_worker ~sw ~net ~clock ~info_hash ~peer_id ~peer 111 | ~work_queue ~results) 112 | peers) 113 | (fun () -> 114 | let completed = ref 0 in 115 | while !completed < num_pieces do 116 | let piece, buf = Eio.Stream.take results in 117 | let bounds = 118 | let piece_offset = Meta.piece_offset meta piece.Piece.i in 119 | let piece_length = Meta.piece_length meta piece.Piece.i in 120 | let files = 121 | List.map2 122 | (fun file { Meta.length; _ } -> (file, length)) 123 | files meta.Meta.files 124 | in 125 | piece_bounds ~piece_offset ~piece_length files 126 | in 127 | let buf = Cstruct.of_string buf in 128 | List.iter 129 | (fun (file, file_offset, ofs, len) -> 130 | let file_offset = Optint.Int63.of_int file_offset in 131 | Eio.Fs.pwrite_exact file ~file_offset (Cstruct.sub buf ofs len)) 132 | bounds; 133 | completed := !completed + 1; 134 | let percent = float !completed /. float num_pieces *. 100.0 in 135 | Logs.app (fun f -> 136 | f "(%0.2f%%) Downloaded piece #%d" percent piece.Piece.i) 137 | done) 138 | -------------------------------------------------------------------------------- /lib/torrent.mli: -------------------------------------------------------------------------------- 1 | val download : 2 | net:Eio.Net.t -> 3 | clock:Eio.Time.clock -> 4 | cwd:_ Eio.Path.t -> 5 | info_hash:string -> 6 | peer_id:string -> 7 | meta:Meta.t -> 8 | peers:Tracker.Response.Peer.t list -> 9 | unit 10 | -------------------------------------------------------------------------------- /lib/tracker.ml: -------------------------------------------------------------------------------- 1 | module Event = struct 2 | type t = Started | Completed | Stopped 3 | 4 | let to_string = function 5 | | Started -> "started" 6 | | Completed -> "completed" 7 | | Stopped -> "stopped" 8 | end 9 | 10 | module Response = struct 11 | module Peer = struct 12 | type t = { 13 | ip : [ `Ipaddr of Unix.inet_addr | `Name of string ]; 14 | port : int; 15 | } 16 | 17 | let to_sexp t = 18 | let open Sexp.Encoder in 19 | record 20 | [ 21 | ( "ip", 22 | string 23 | (match t.ip with 24 | | `Ipaddr addr -> Unix.string_of_inet_addr addr 25 | | `Name s -> s) ); 26 | ("port", int t.port); 27 | ] 28 | 29 | let decoder = 30 | let open Bencode.Decoder in 31 | let open Bencode.Decoder.O in 32 | let+ ip = member "ip" string and+ port = member "port" int in 33 | { ip = `Name ip; port } 34 | 35 | let decoder_compact n = 36 | let open Bencode.Decoder in 37 | let open Bencode.Decoder.O in 38 | let+ s = string in 39 | assert (String.length s mod (n + 2) = 0); 40 | let rec loop i = 41 | if i = String.length s then [] 42 | else 43 | let addr = 44 | Eio_unix.Ipaddr.to_unix (Eio.Net.Ipaddr.of_raw (String.sub s i n)) 45 | in 46 | let port = String.get_uint16_be s (i + n) in 47 | { ip = `Ipaddr addr; port } :: loop (i + n + 2) 48 | in 49 | loop 0 50 | end 51 | 52 | type ok = { interval : int; peers : Peer.t list; peers6 : Peer.t list } 53 | type t = Failure of string | Ok of ok 54 | 55 | let to_sexp t = 56 | let open Sexp.Encoder in 57 | match t with 58 | | Failure s -> variant "failure" [ string s ] 59 | | Ok t -> 60 | record 61 | [ ("interval", int t.interval); ("peers", list Peer.to_sexp t.peers) ] 62 | 63 | let decoder = 64 | let open Bencode.Decoder in 65 | let open Bencode.Decoder.O in 66 | if_member "failure reason" 67 | (let+ s = string in 68 | Failure s) 69 | (let+ interval = member "interval" int 70 | and+ peers = 71 | member "peers" (if_list Peer.decoder (Peer.decoder_compact 4)) 72 | and+ peers6 = 73 | member "peers6" (if_list Peer.decoder (Peer.decoder_compact 16)) 74 | in 75 | Ok { interval; peers; peers6 }) 76 | 77 | let of_string s = 78 | match Bencode.decode s with 79 | | None -> None 80 | | Some t -> Bencode.Decoder.query decoder t 81 | end 82 | 83 | let urlencode s = 84 | let len = String.length s in 85 | let buf = Buffer.create len in 86 | for i = 0 to len - 1 do 87 | match s.[i] with 88 | | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '~' | '-' | '.' | '_') as c -> 89 | Buffer.add_char buf c 90 | | '+' -> Buffer.add_string buf "%2B" 91 | | ' ' -> Buffer.add_char buf '+' 92 | | c -> Printf.bprintf buf "%%%02X" (Char.code c) 93 | done; 94 | Buffer.contents buf 95 | 96 | let build_params params = 97 | String.concat "&" 98 | (List.map 99 | (fun (k, v) -> String.concat "=" [ urlencode k; urlencode v ]) 100 | params) 101 | 102 | let build_request route params = 103 | Printf.sprintf "GET %s?%s HTTP/1.1\r\n\r\n" route (build_params params) 104 | 105 | let parse_url url = 106 | match Scanf.sscanf_opt url "%s@://%s" (fun proto rest -> (proto, rest)) with 107 | | Some ("http", rest) -> ( 108 | match String.split_on_char '/' rest with 109 | | host :: rest -> 110 | let host, port = 111 | match String.split_on_char ':' host with 112 | | [ host; port ] -> ( 113 | match int_of_string_opt port with 114 | | None -> raise Exit 115 | | Some n -> (host, n)) 116 | | [ host ] -> (host, 80) 117 | | _ -> raise Exit 118 | in 119 | ( host, 120 | port, 121 | String.concat "" (List.concat_map (fun s -> [ "/"; s ]) rest) ) 122 | | [] -> raise Exit) 123 | | _ -> raise Exit 124 | 125 | let parse_url url = 126 | match parse_url url with x -> Some x | exception Exit -> None 127 | 128 | let announce ~net ~info_hash ~peer_id ~port ~uploaded ~downloaded ~left ?event 129 | url = 130 | let server_host, server_port, server_route = 131 | match parse_url url with 132 | | Some x -> x 133 | | None -> failwith (Printf.sprintf "Could not parse URL %s" url) 134 | in 135 | let payload = 136 | let params = 137 | [ 138 | ("info_hash", info_hash); 139 | ("peer_id", peer_id); 140 | ("port", string_of_int port); 141 | ("uploaded", string_of_int uploaded); 142 | ("downloaded", string_of_int downloaded); 143 | ("left", string_of_int left); 144 | ("compact", "1"); 145 | ] 146 | in 147 | let params = 148 | match event with 149 | | None -> params 150 | | Some event -> ("event", Event.to_string event) :: params 151 | in 152 | build_request server_route params 153 | in 154 | let addr = 155 | let he = Unix.gethostbyname server_host in 156 | Eio_unix.Ipaddr.of_unix he.Unix.h_addr_list.(0) 157 | in 158 | let addr = `Tcp (addr, server_port) in 159 | Eio.Switch.run @@ fun sw -> 160 | let flow = Eio.Net.connect ~sw net addr in 161 | Eio.Flow.copy_string payload flow; 162 | let buf = Eio.Buf_read.of_flow flow ~initial_size:100 ~max_size:1_000_000 in 163 | let rec loop () = 164 | match Eio.Buf_read.format_errors Eio.Buf_read.line buf with 165 | | Ok "" -> ( 166 | match Response.of_string (Eio.Buf_read.take_all buf) with 167 | | None -> failwith "could not parse response" 168 | | Some r -> r) 169 | | Ok _ -> loop () 170 | | Error (`Msg s) -> failwith s 171 | in 172 | loop () 173 | -------------------------------------------------------------------------------- /lib/tracker.mli: -------------------------------------------------------------------------------- 1 | module Event : sig 2 | type t = Started | Completed | Stopped 3 | end 4 | 5 | module Response : sig 6 | module Peer : sig 7 | type t = { 8 | ip : [ `Ipaddr of Unix.inet_addr | `Name of string ]; 9 | port : int; 10 | } 11 | end 12 | 13 | type ok = { interval : int; peers : Peer.t list; peers6 : Peer.t list } 14 | type t = Failure of string | Ok of ok 15 | 16 | val to_sexp : t Sexp.Encoder.t 17 | end 18 | 19 | val announce : 20 | net:Eio.Net.t -> 21 | info_hash:string -> 22 | peer_id:string -> 23 | port:int -> 24 | uploaded:int -> 25 | downloaded:int -> 26 | left:int -> 27 | ?event:Event.t -> 28 | string -> 29 | Response.t 30 | --------------------------------------------------------------------------------