/[mldonkey]/mldonkey/src/networks/bittorrent/bTComplexOptions.ml
ViewVC logotype

Diff of /mldonkey/src/networks/bittorrent/bTComplexOptions.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19 by spiralvoice, Thu Jul 7 00:25:46 2005 UTC revision 1.20 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 19  Line 19 
19    
20  open Int64ops  open Int64ops
21  open Printf2  open Printf2
22    open BasicSocket
23  open Md4  open Md4
24  open Options  open Options
25      
26  open CommonGlobals  open CommonGlobals
27  open CommonDownloads  open CommonDownloads
28  open CommonTypes  open CommonTypes
# Line 46  module ClientOption = struct Line 47  module ClientOption = struct
47            let client_port = get_value "client_port" value_to_int in            let client_port = get_value "client_port" value_to_int in
48            let client_uid = get_value "client_uid" (from_value Sha1.option) in            let client_uid = get_value "client_uid" (from_value Sha1.option) in
49            let c = new_client file client_uid (client_ip, client_port) in            let c = new_client file client_uid (client_ip, client_port) in
50              
51            c            c
52        | _ -> failwith "Options: Not a client"        | _ -> failwith "Options: Not a client"
53        
54        
55      let client_to_value c =      let client_to_value c =
56        let (ip,port) = c.client_host in        let (ip,port) = c.client_host in
57            Options.Module [            Options.Module [
# Line 61  module ClientOption = struct Line 62  module ClientOption = struct
62    
63      let to_value = client_to_value      let to_value = client_to_value
64      let of_value = value_to_client      let of_value = value_to_client
65      
66    end    end
67    
68  let value_to_file file_size file_state assocs =  let value_to_file file_size file_state assocs =
69    let get_value name conv = conv (List.assoc name assocs) in    let get_value name conv = conv (List.assoc name assocs) in
70    let get_value_nil name conv =    let get_value_nil name conv =
71      try conv (List.assoc name assocs) with _ -> []      try conv (List.assoc name assocs) with _ -> []
72    in    in
73      
74    let file_trackers =    let file_trackers =
75      try      try
76        get_value "file_trackers" (value_to_list value_to_string)        get_value "file_trackers" (value_to_list value_to_string)
77      with _ ->      with _ ->
78          try          try
79            [get_value "file_tracker"  value_to_string]            [get_value "file_tracker"  value_to_string]
80          with _ -> failwith "Bad file_tracker"          with _ -> failwith "Bad file_tracker"
81    in    in
82      
83    let file_id, torrent, torrent_diskname =    let file_id, torrent, torrent_diskname =
84      try      try
85        let torrent_diskname = get_value "file_torrent_name" value_to_string in        let torrent_diskname = get_value "file_torrent_name" value_to_string in
# Line 86  let value_to_file file_size file_state a Line 87  let value_to_file file_size file_state a
87        let file_id, torrent = BTTorrent.decode_torrent s in        let file_id, torrent = BTTorrent.decode_torrent s in
88        file_id, torrent, torrent_diskname        file_id, torrent, torrent_diskname
89      with _ ->      with _ ->
90            
91          let file_name = get_value "file_name" value_to_string in          let file_name = get_value "file_name" value_to_string in
92          let file_id =          let file_id =
93            try            try
# Line 94  let value_to_file file_size file_state a Line 95  let value_to_file file_size file_state a
95            with _ -> failwith "Bad file_id"            with _ -> failwith "Bad file_id"
96          in          in
97          let file_piece_size = try          let file_piece_size = try
98              value_to_int64 (List.assoc "file_piece_size" assocs)              value_to_int64 (List.assoc "file_piece_size" assocs)
99            with _ -> failwith "Bad file size"            with _ -> failwith "Bad file size"
100          in          in
101          let file_chunks =            let file_chunks =
102            get_value "file_hashes" (value_to_array            get_value "file_hashes" (value_to_array
103                (from_value Sha1.option))                (from_value Sha1.option))
104          in          in
105          let file_size = get_value "file_size" value_to_int64 in          let file_size = get_value "file_size" value_to_int64 in
106          let file_files =            let file_files =
107            try            try
108              let file_files = (get_value "file_files"              let file_files = (get_value "file_files"
109                    (value_to_list (fun v ->                    (value_to_list (fun v ->
110                        match v with                        match v with
111                          SmallList [name; p1]                          SmallList [name; p1]
# Line 121  let value_to_file file_size file_state a Line 122  let value_to_file file_size file_state a
122              torrent_piece_size = file_piece_size;              torrent_piece_size = file_piece_size;
123              torrent_files = file_files;              torrent_files = file_files;
124              torrent_length = file_size;              torrent_length = file_size;
125              torrent_announce =              torrent_announce =
126              (              (
127                try                try
128                  (List.hd file_trackers)                  (List.hd file_trackers)
129                with _ -> ""                with _ -> ""
130              );              );
131            } in            } in
132          let torrent_diskname = Filename.concat downloads_directory          let torrent_diskname = Filename.concat downloads_directory
133              (file_name ^ ".torrent") in              (file_name ^ ".torrent") in
134          file_id, torrent, torrent_diskname          file_id, torrent, torrent_diskname
135      
136    in    in
137    let file_temp = try    let file_temp = try
138        get_value "file_temp" value_to_string        get_value "file_temp" value_to_string
139      with Not_found ->      with Not_found ->
140          let file_temp = Filename.concat !!DO.temp_directory          let file_temp = Filename.concat !!DO.temp_directory
141              (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in              (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in
142          file_temp                  file_temp
143    in    in
144    let file = new_file file_id torrent torrent_diskname file_temp file_state in    let file = new_file file_id torrent torrent_diskname file_temp file_state in
145        
146    let file_uploaded = try    let file_uploaded = try
147        value_to_int64 (List.assoc "file_uploaded" assocs)        value_to_int64 (List.assoc "file_uploaded" assocs)
148      with _ -> zero      with _ -> zero
149    in    in
150    file.file_uploaded <- file_uploaded;    file.file_uploaded <- file_uploaded;
151      
152    (match file.file_swarmer with    (match file.file_swarmer with
153        None -> ()        None -> ()
154      | Some swarmer ->      | Some swarmer ->
# Line 158  let value_to_file file_size file_state a Line 159  let value_to_file file_size file_state a
159        ignore        ignore
160          (get_value  "file_sources" (          (get_value  "file_sources" (
161            value_to_list (ClientOption.of_value file)))            value_to_list (ClientOption.of_value file)))
162      with e ->      with e ->
163          lprintf_nl "[BT]: Exception %s while loading sources"          lprintf_nl "[BT]: Exception %s while loading sources"
164            (Printexc2.to_string e);            (Printexc2.to_string e);
165    );    );
166    
167    as_file file    as_file file
168      
169  let file_to_value file =  let file_to_value file =
170    try    try
171      let sources = Hashtbl2.to_list file.file_clients in      let sources = Hashtbl2.to_list file.file_clients in
# Line 175  let file_to_value file = Line 176  let file_to_value file =
176          "file_name", string_to_value file.file_name;          "file_name", string_to_value file.file_name;
177          "file_uploaded", int64_to_value  (file.file_uploaded);          "file_uploaded", int64_to_value  (file.file_uploaded);
178          "file_id", string_to_value (Sha1.to_string file.file_id);          "file_id", string_to_value (Sha1.to_string file.file_id);
179          "file_trackers", (list_to_value string_to_value)          "file_trackers", (list_to_value string_to_value)
180          (List.map (fun t -> t.tracker_url) file.file_trackers);          (List.map (fun t -> t.tracker_url) file.file_trackers);
181  (* OK, but I still don't like the idea of forgetting all the clients.  (* OK, but I still don't like the idea of forgetting all the clients.
182  We should have a better strategy, ie rating the clients and connecting  We should have a better strategy, ie rating the clients and connecting
183  to them depending on the results of our last connections. And then,  to them depending on the results of our last connections. And then,
184  if we could not download enough in the last interval, ask the tracker to  if we could not download enough in the last interval, ask the tracker to
185  send us more clients.  send us more clients.
186      
187      "file_sources",      "file_sources",
188      list_to_value "BT Sources" (fun c ->      list_to_value "BT Sources" (fun c ->
189          ClientOption.to_value c) sources          ClientOption.to_value c) sources
190  ;  ;
# Line 192  send us more clients. Line 193  send us more clients.
193      in      in
194      let assocs =      let assocs =
195        ("file_torrent_name", string_to_value file.file_torrent_diskname) ::        ("file_torrent_name", string_to_value file.file_torrent_diskname) ::
196        ("file_hashes", array_to_value        ("file_hashes", array_to_value
197            (to_value Sha1.option) file.file_chunks) ::            (to_value Sha1.option) file.file_chunks) ::
198        ("file_files", list_to_value        ("file_files", list_to_value
199            (fun (name, p1) ->            (fun (name, p1) ->
# Line 201  send us more clients. Line 202  send us more clients.
202        assocs        assocs
203      in      in
204      match file.file_swarmer with      match file.file_swarmer with
205        None -> assocs        None -> assocs
206      | Some swarmer ->      | Some swarmer ->
207          Int64Swarmer.swarmer_to_value swarmer assocs          Int64Swarmer.swarmer_to_value swarmer assocs
208    with    with
# Line 209  send us more clients. Line 210  send us more clients.
210        lprintf_nl "BTComplexOptions: exception %s in file_to_value"        lprintf_nl "BTComplexOptions: exception %s in file_to_value"
211          (Printexc2.to_string e); raise e          (Printexc2.to_string e); raise e
212                
213  let old_files =  let old_files =
214    define_option bittorrent_section ["old_files"]    define_option bittorrent_section ["old_files"]
215      "" (list_option (tuple2_option (string_option, int64_option))) []      "" (list_option (tuple2_option (string_option, int64_option))) []
216        
217        
218  let save_config () =  let save_config () =
219    Options.save_with_help bittorrent_ini    Options.save_with_help bittorrent_ini
220    

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26