22 |
open Md4 |
open Md4 |
23 |
open Options |
open Options |
24 |
open BasicSocket |
open BasicSocket |
25 |
|
|
26 |
open CommonDownloads |
open CommonDownloads |
27 |
open CommonTypes |
open CommonTypes |
28 |
open CommonFile |
open CommonFile |
32 |
open FileTPGlobals |
open FileTPGlobals |
33 |
|
|
34 |
module ClientOption = struct |
module ClientOption = struct |
35 |
|
|
36 |
let value_to_client v = |
let value_to_client v = |
37 |
match v with |
match v with |
38 |
| Module assocs -> |
| Module assocs -> |
39 |
|
|
40 |
let get_value name conv = conv (List.assoc name assocs) in |
let get_value name conv = conv (List.assoc name assocs) in |
41 |
let get_value_nil name conv = |
let get_value_nil name conv = |
42 |
try conv (List.assoc name assocs) with _ -> [] |
try conv (List.assoc name assocs) with _ -> [] |
43 |
in |
in |
44 |
let client_hostname = get_value "client_hostname" value_to_string in |
let client_hostname = get_value "client_hostname" value_to_string in |
50 |
|
|
51 |
(* |
(* |
52 |
(try |
(try |
53 |
c.client_user.user_speed <- get_value "client_speed" value_to_int |
c.client_user.user_speed <- get_value "client_speed" value_to_int |
54 |
with _ -> ()); |
with _ -> ()); |
55 |
|
|
56 |
(try |
(try |
57 |
if get_value "client_push" value_to_bool then |
if get_value "client_push" value_to_bool then |
58 |
c.client_user.user_kind <- Indirect_location ("", client_uid) |
c.client_user.user_kind <- Indirect_location ("", client_uid) |
60 |
*) |
*) |
61 |
c |
c |
62 |
| _ -> failwith "Options: Not a client" |
| _ -> failwith "Options: Not a client" |
63 |
|
|
|
|
|
64 |
let client_to_value c = |
let client_to_value c = |
65 |
Options.Module [ |
Options.Module [ |
66 |
"client_hostname", string_to_value c.client_hostname; |
"client_hostname", string_to_value c.client_hostname; |
71 |
"client_push", bool_to_value false; |
"client_push", bool_to_value false; |
72 |
*) |
*) |
73 |
] |
] |
74 |
|
|
75 |
let t = |
let t = |
76 |
define_option_class "Client" value_to_client client_to_value |
define_option_class "Client" value_to_client client_to_value |
77 |
|
|
78 |
end |
end |
79 |
|
|
80 |
let value_to_int32pair v = |
let value_to_int32pair v = |
81 |
match v with |
match v with |
82 |
List [v1;v2] | SmallList [v1;v2] -> |
List [v1;v2] | SmallList [v1;v2] -> |
83 |
(value_to_int64 v1, value_to_int64 v2) |
(value_to_int64 v1, value_to_int64 v2) |
84 |
| _ -> |
| _ -> |
85 |
failwith "Options: Not an int32 pair" |
failwith "Options: Not an int32 pair" |
86 |
|
|
87 |
let value_to_file file_size file_state assocs = |
let value_to_file file_size file_state assocs = |
88 |
let get_value name conv = conv (List.assoc name assocs) in |
let get_value name conv = conv (List.assoc name assocs) in |
89 |
let get_value_nil name conv = |
let get_value_nil name conv = |
90 |
try conv (List.assoc name assocs) with _ -> [] |
try conv (List.assoc name assocs) with _ -> [] |
91 |
in |
in |
92 |
|
|
93 |
let file_name = get_value "file_filename" value_to_string in |
let file_name = get_value "file_filename" value_to_string in |
94 |
let file_id = |
let file_id = |
95 |
try |
try |
96 |
Md4.of_string (get_value "file_id" value_to_string) |
Md4.of_string (get_value "file_id" value_to_string) |
97 |
with _ -> failwith "Bad file_id" |
with _ -> failwith "Bad file_id" |
98 |
in |
in |
99 |
|
|
100 |
let file = new_file file_id file_name file_size in |
let file = new_file file_id file_name file_size in |
101 |
|
|
102 |
(match file.file_swarmer with |
(match file.file_swarmer with |
113 |
add_download file s (Url.of_string (value_to_string index)) |
add_download file s (Url.of_string (value_to_string index)) |
114 |
| _ -> failwith "Bad source" |
| _ -> failwith "Bad source" |
115 |
))) |
))) |
116 |
with e -> |
with e -> |
117 |
lprintf "Exception %s while loading source\n" |
lprintf "Exception %s while loading source\n" |
118 |
(Printexc2.to_string e); |
(Printexc2.to_string e); |
119 |
); |
); |
120 |
as_file file |
as_file file |
121 |
|
|
122 |
let file_to_value file = |
let file_to_value file = |
123 |
let assocs = |
let assocs = |
124 |
[ |
[ |
125 |
(* "file_name", string_to_value file.file_name; *) |
(* "file_name", string_to_value file.file_name; *) |
126 |
"file_downloaded", int64_to_value (file_downloaded file); |
"file_downloaded", int64_to_value (file_downloaded file); |
127 |
"file_id", string_to_value (Md4.to_string file.file_id); |
"file_id", string_to_value (Md4.to_string file.file_id); |
128 |
"file_sources", |
"file_sources", |
129 |
list_to_value (fun c -> |
list_to_value (fun c -> |
130 |
lprintf "SAVING: find_client...\n"; |
lprintf "SAVING: find_client...\n"; |
131 |
let n = (find_download file c.client_downloads).download_url in |
let n = (find_download file c.client_downloads).download_url in |
132 |
lprintf "SAVING: find_client...done...saving\n"; |
lprintf "SAVING: find_client...done...saving\n"; |
133 |
SmallList [ClientOption.client_to_value c; |
SmallList [ClientOption.client_to_value c; |
134 |
string_to_value (Url.to_string n)] |
string_to_value (Url.to_string n)] |
135 |
) file.file_clients; |
) file.file_clients; |
136 |
] |
] |
137 |
in |
in |
138 |
match file.file_swarmer with |
match file.file_swarmer with |
139 |
None -> assocs |
None -> assocs |
140 |
| Some swarmer -> |
| Some swarmer -> |
141 |
Int64Swarmer.swarmer_to_value swarmer assocs |
Int64Swarmer.swarmer_to_value swarmer assocs |
142 |
|
|
143 |
let old_files = |
let old_files = |
144 |
define_option fileTP_section ["old_urls"] |
define_option fileTP_section ["old_urls"] |
145 |
"" (list_option Url.option) [] |
"" (list_option Url.option) [] |
146 |
|
|
147 |
let save_config () = |
let save_config () = |
148 |
|
|
149 |
let files = !!old_files in |
let files = !!old_files in |
150 |
old_files =:= []; |
old_files =:= []; |
151 |
List.iter (fun file -> |
List.iter (fun file -> |
152 |
if not (List.mem file !!old_files) then |
if not (List.mem file !!old_files) then |
153 |
old_files =:= file :: !!old_files |
old_files =:= file :: !!old_files |
154 |
) files; |
) files; |
|
|
|
155 |
() |
() |
156 |
|
|
157 |
let _ = |
let _ = |
158 |
network.op_network_file_of_option <- value_to_file; |
network.op_network_file_of_option <- value_to_file; |
159 |
file_ops.op_file_to_option <- file_to_value; |
file_ops.op_file_to_option <- file_to_value; |