patch #8106
[mldonkey.git] / src / networks / donkey / donkeyInteractive.ml
blobeda1c562becc36905c68b6b6a53db35d9cd65f98
1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
2 (*
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 open Int64ops
21 open Printf2
22 open Md4
23 open Options
24 open LittleEndian
25 open AnyEndian
27 open BasicSocket
28 open TcpBufferedSocket
30 open GuiTypes
32 open CommonShared
33 open CommonServer
34 open CommonResult
35 open CommonClient
36 open CommonUser
37 open CommonInteractive
38 open CommonNetwork
39 open CommonDownloads
40 open CommonTypes
41 open CommonComplexOptions
42 open CommonFile
44 open DonkeySearch
45 open DonkeyMftp
46 open DonkeyProtoCom
47 open DonkeyServers
48 open DonkeyOneFile
49 open DonkeyFiles
50 open DonkeyComplexOptions
51 open DonkeyTypes
52 open DonkeyOptions
53 open DonkeyGlobals
54 open DonkeyClient
55 open CommonGlobals
56 open CommonOptions
57 open DonkeyStats
58 open DonkeyUdp
60 open Gettext
62 let _s x = _s "DonkeyInteractive" x
63 let _b x = _b "DonkeyInteractive" x
65 let porttest_result = ref PorttestNotStarted
67 module VB = VerificationBitmap
69 let log_prefix = "[EDK]"
71 let lprintf_nl fmt =
72 lprintf_nl2 log_prefix fmt
74 let result_name r =
75 match r.result_names with
76 [] -> None
77 | name :: _ -> Some name
80 let op_file_proposed_filenames file =
81 file.file_file.impl_file_filenames
83 let reconnect_all file =
84 DonkeyProtoOvernet.Overnet.recover_file file;
85 DonkeyProtoKademlia.Kademlia.recover_file file;
87 (* This is expensive, no ? *)
88 (* DonkeySources.reschedule_sources file; *)
89 List.iter (fun s ->
90 match s.server_sock, server_state s with
91 | Connection sock, (Connected _ | Connected_downloading _) ->
92 s.server_waiting_queries <- file :: s.server_waiting_queries
93 | _ -> ()
94 ) (connected_servers())
96 let forget_search s =
97 if !xs_last_search = s.search_num then begin
98 xs_last_search := (-1);
99 xs_servers_list := [];
100 end;
101 DonkeyProtoKademlia.Kademlia.forget_search s;
102 DonkeyProtoOvernet.Overnet.forget_search s
105 let load_server_met filename =
106 if !!update_server_list_server_met then
108 let module S = DonkeyImport.Server in
109 let s = File.to_string filename in
110 let ss = S.read s in
111 List.iter (fun r ->
113 let server = check_add_server r.S.ip r.S.port in
114 List.iter (fun tag ->
115 match tag with
116 | { tag_name = Field_KNOWN "name"; tag_value = String s } ->
117 server.server_name <- s;
118 | { tag_name = Field_KNOWN "description" ; tag_value = String s } ->
119 server.server_description <- s
120 | { tag_name = Field_KNOWN "version" ; tag_value = Uint64 s } ->
121 server.server_version <- Printf.sprintf "%d.%d"
122 ((Int64.to_int s) lsr 16) ((Int64.to_int s) land 0xFFFF)
123 | { tag_name = Field_KNOWN "ping" ; tag_value = Uint64 s } ->
124 server.server_ping <- (Int64.to_int s)
125 | { tag_name = Field_KNOWN "dynip" ; tag_value = String s } ->
126 server.server_dynip <- s
127 | { tag_name = Field_KNOWN "users" ; tag_value = Uint64 s } ->
128 (match server.server_nusers with
129 | None -> server.server_nusers <- Some s | _ -> ())
130 | { tag_name = Field_KNOWN "files" ; tag_value = Uint64 s } ->
131 (match server.server_nfiles with
132 | None -> server.server_nfiles <- Some s | _ -> ())
133 | { tag_name = Field_KNOWN "maxusers" ; tag_value = Uint64 s } ->
134 (match server.server_max_users with
135 | None -> server.server_max_users <- Some s | _ -> ())
136 | { tag_name = Field_KNOWN "softfiles" ; tag_value = Uint64 s } ->
137 (match server.server_soft_limit with
138 | None -> server.server_soft_limit <- Some s | _ -> ())
139 | { tag_name = Field_KNOWN "hardfiles" ; tag_value = Uint64 s } ->
140 (match server.server_hard_limit with
141 | None -> server.server_hard_limit <- Some s | _ -> ())
142 | { tag_name = Field_KNOWN "auxportslist" ; tag_value = String s } ->
143 server.server_auxportslist <- s
144 | { tag_name = Field_KNOWN "lowusers" ; tag_value = Uint64 s } ->
145 (match server.server_lowid_users with
146 | None -> server.server_lowid_users <- Some s | _ -> ())
147 | { tag_name = Field_KNOWN "tcpportobfuscation" ; tag_value = Uint64 s } ->
148 server.server_obfuscation_tcp <- Some (Int64.to_int s)
149 | { tag_name = Field_KNOWN "udpportobfuscation" ; tag_value = Uint64 s } ->
150 server.server_obfuscation_udp <- Some (Int64.to_int s)
151 | { tag_name = Field_KNOWN "country" ; tag_value = String s } -> ()
152 | { tag_name = Field_KNOWN "udpflags" ; tag_value = Uint64 s } -> ()
153 | { tag_name = Field_KNOWN "refs" ; tag_value = Uint64 s } -> ()
154 | _ -> lprintf_nl "parsing server.met, unknown field %s" (string_of_tag tag)
155 ) r.S.tags;
156 server_must_update server
157 with _ -> ()
158 ) ss;
159 List.length ss
160 with e ->
161 lprintf_nl "Exception %s while loading %s" (Printexc2.to_string e)
162 filename;
164 else 0
166 let unpack_server_met filename url =
167 let ext = String.lowercase (Filename2.extension filename) in
168 let last_ext = String.lowercase (Filename2.last_extension filename) in
169 let real_ext = if last_ext = ".zip" then last_ext else ext in
170 match real_ext with
171 | ".zip" ->
172 (try
173 let result =
174 Unix2.tryopen_read_zip filename (fun ic ->
176 let file = Zip.find_entry ic "server.met" in
177 lprintf_nl (_b "server.met found in %s") url;
178 file.Zip.filename
179 with e ->
180 lprintf_nl (_b "Exception %s while extracting server.met from %s")
181 (Printexc2.to_string e) url;
182 raise e) in
183 (try
184 ignore(Misc.archive_extract filename "zip")
185 with e ->
186 lprintf_nl (_b "Exception %s while extracting server.met from %s")
187 (Printexc2.to_string e) url;
188 raise e);
189 result
190 with
191 | Zip.Error _ -> filename
192 | e ->
193 lprintf_nl "Exception %s while opening %s"
194 (Printexc2.to_string e) url;
195 raise Not_found)
196 | ".met.gz" | ".met.bz2" | ".gz" | ".bz2" ->
197 (let filetype =
198 if ext = ".bz2" || ext = ".met.bz2" then "bz2" else "gz" in
200 Misc.archive_extract filename filetype
201 with
202 | Gzip.Error _ -> filename
203 | e ->
204 lprintf_nl "Exception %s while extracting from %s"
205 (Printexc2.to_string e) url;
206 raise Not_found)
207 (* if file is not a supported archive type try loading servers from that file anyway *)
208 | _ -> filename
210 let download_server_met url =
211 let module H = Http_client in
212 let r = {
213 H.basic_request with
214 H.req_url = Url.of_string url;
215 H.req_proxy = !CommonOptions.http_proxy;
216 H.req_user_agent = get_user_agent ();
217 H.req_max_retry = 10;
218 H.req_save = true;
219 } in
220 H.wget r (fun filename ->
222 let nservers = List.length (Hashtbl2.to_list servers_by_key) in
223 let s = unpack_server_met filename url in
224 let n = load_server_met s in
225 if s <> filename then Sys.remove s;
226 lprintf_nl (_b "server.met loaded from %s, %d servers found, %d new ones inserted")
227 url n ((List.length (Hashtbl2.to_list servers_by_key)) - nservers)
228 with e -> ()
231 let already_done = Failure (Printf.sprintf (_b "File already downloaded (use 'force_download' if necessary)"))
232 let no_download_to_force = Failure (Printf.sprintf (_b "No forceable download found"))
233 exception Already_downloading of string
234 exception Already_shared of string
236 let really_query_download filename size md4 location old_file absents user group =
238 begin
240 let file = Hashtbl.find files_by_md4 md4 in
241 if file_state file = FileDownloaded then
242 raise already_done;
243 with Not_found -> ()
244 end;
246 List.iter (fun file ->
247 if file.file_md4 = md4 then raise already_done)
248 !current_files;
250 let file_diskname = Filename.concat !!temp_directory
251 (file_string_of_uid (Ed2k md4)) in
252 begin
253 match old_file with
254 | Some filename when file_diskname <> filename ->
255 if Sys.file_exists filename
256 && not (Sys.file_exists file_diskname)
257 then
258 (try
259 lprintf_nl "Renaming edonkey temp-file from %s to %s"
260 filename file_diskname;
261 Unix2.rename filename file_diskname;
262 Unix2.chmod file_diskname 0o644;
263 with e ->
264 lprintf_nl "Could not rename %s to %s: exception %s"
265 filename file_diskname (Printexc2.to_string e);
267 else lprintf_nl "THERE IS SOME PROBLEM WITH RECOVERING TEMP-FILES, THAT COULD CAUSE FILE-CORRUPTION!!!!!!!!!!! filename: %s exists:%b file_diskname: %s exists:%b"
268 filename (Sys.file_exists filename)
269 file_diskname (Sys.file_exists file_diskname);
270 | _ -> ()
271 end;
273 (* TODO RESULT let other_names = DonkeyIndexer.find_names md4 in *)
274 let file = new_file file_diskname FileDownloading md4 size filename true user group in
275 begin
276 match absents with
277 None -> ()
278 | Some absents ->
279 match file.file_swarmer with
280 None -> assert false
281 | Some swarmer ->
282 let absents =
283 List.sort (fun (p1, _) (p2, _) -> compare p1 p2) absents in
284 CommonSwarming.set_absent swarmer absents
285 end;
287 if !verbose then lprintf_nl (_b "Started new download, file %s, size %Ld, md4 %s, user:group %s:%s")
288 (file_best_name file) size (Md4.to_string md4) user.CommonTypes.user_name (CommonUserDb.user2_print_group group);
290 DonkeyProtoOvernet.Overnet.recover_file file;
291 DonkeyProtoKademlia.Kademlia.recover_file file;
293 current_files := file :: !current_files;
294 (* !file_change_hook file; *)
295 (* set_file_size file (file_size file); *)
297 List.iter (fun s ->
298 add_query_location file s
299 ) (connected_servers());
301 (try
302 let servers = Hashtbl.find_all udp_servers_replies file.file_md4 in
303 List.iter (fun s ->
304 udp_server_send_query_location s [(file.file_md4,(file_size file))]
305 ) servers
306 with _ -> ());
308 (match location with
309 None -> ()
310 | Some num ->
311 let c = client_find num in
312 client_connect c
315 let c = find_client num in
316 (match c.client_kind with
317 Indirect_location ->
318 if not (Intmap.mem c.client_num file.file_indirect_locations) then
319 file.file_indirect_locations <- Intmap.add c.client_num c
320 file.file_indirect_locations
322 | _ ->
323 if not (Intmap.mem c.client_num file.file_known_locations) then
324 new_known_location file c
326 if not (List.memq file c.client_files) then
327 c.client_files <- file :: c.client_files;
328 match client_state c with
329 NotConnected ->
330 connect_client !!client_ip [file] c
331 | Connected_busy | Connected_idle | Connected_queued ->
332 begin
333 match c.client_sock with
334 None -> ()
335 | Some sock ->
336 DonkeyClient.query_files c sock [file]
338 | _ -> ()
339 with _ -> ()
342 as_file file
344 let query_download filename size md4 location old_file absents force user group =
345 if force then
346 if !forceable_download = [] then
347 raise no_download_to_force
348 else
349 begin
350 let f = List.hd !forceable_download in
351 forceable_download := [];
352 really_query_download (List.hd f.result_names) f.result_size md4 None None None user group
354 else
355 begin
357 let file = find_file md4 in
358 if (file_state file) = FileShared then
359 raise (Already_shared (Printf.sprintf (_b "File is already shared%s")
360 (match file.file_shared with
361 None -> ""
362 | Some sh -> (" in " ^ (Filename2.dirname sh.impl_shared_fullname)))))
363 else
364 begin
365 (* jave TODO: if a user currently not downloading this file is requesting the download add this user
366 to the list of users currently downloading this file *)
367 forceable_download := [];
368 raise (Already_downloading (Printf.sprintf (_b "File is already in download queue of %s") (file_owner (as_file file)).CommonTypes.user_name))
370 with Not_found ->
371 begin
372 if List.mem md4 !!old_files then begin
373 (* copy file info into result for later usage in force_download *)
374 let r = { dummy_result with
375 result_uids = [Uid.create (Ed2k md4)];
376 result_names = [filename];
377 result_size = size;
378 result_force = true; (* marker for force_download *)
379 result_modified = false;
380 result_source_network = network.network_num;
381 } in
382 forceable_download := [r];
383 raise already_done
385 else
386 begin
387 forceable_download := [];
388 really_query_download filename size md4 location old_file absents user group
393 let result_download r filenames force user group =
394 let rec iter uids =
395 match uids with
396 [] -> raise IgnoreNetwork
397 | uid :: tail ->
398 match Uid.to_uid uid with
399 Ed2k md4 ->
400 query_download (List.hd filenames) r.result_size md4 None None None force user group
401 | _ -> iter tail
403 iter r.result_uids
405 let load_prefs filename =
407 let module P = DonkeyImport.Pref in
408 let s = File.to_string filename in
409 let t = P.read s in
410 t.P.client_tags, t.P.option_tags
411 with e ->
412 lprintf_nl "Exception %s while loading %s" (Printexc2.to_string e)
413 filename;
414 [], []
416 let import_temp temp_dir =
417 let list = Unix2.list_directory temp_dir in
418 let module P = DonkeyImport.Part in
419 let user = CommonUserDb.admin_user () in
420 List.iter (fun filename ->
422 if Filename2.last_extension filename = ".part" then
423 let filename = Filename.concat temp_dir filename in
424 let met = filename ^ ".met" in
425 if Sys.file_exists met then
426 let s = File.to_string met in
427 let f = P.read s in
428 let filename_met = ref None in
429 let size = ref Int64.zero in
430 List.iter (fun tag ->
431 match tag with
432 { tag_name = Field_Filename; tag_value = String s } ->
433 lprintf_nl "Import Donkey %s" s;
435 filename_met := Some s;
436 | { tag_name = Field_Size; tag_value = Uint64 v } ->
437 size := v
438 | { tag_name = Field_Size_Hi; tag_value = Uint64 v } ->
439 size := Int64.logor !size (Int64.shift_left v 32)
440 | _ -> ()
441 ) f.P.tags;
442 ignore (really_query_download
443 (match !filename_met with
444 None -> filename
445 | Some s -> s) !size f.P.md4 None
446 (Some filename) (Some (List.rev f.P.absents)) user user.user_default_group);
447 with _ -> ()
448 ) list
451 let import_config dirname =
452 ignore (load_server_met (Filename.concat dirname "server.met"));
453 let ct, ot = load_prefs (Filename.concat dirname "pref.met") in
454 let temp_dir = ref (Filename.concat dirname "temp") in
456 List.iter (fun tag ->
457 match tag with
458 | { tag_name = Field_KNOWN "name"; tag_value = String s } ->
459 login =:= s
460 | { tag_name = Field_KNOWN "port"; tag_value = Uint64 v } ->
461 donkey_port =:= Int64.to_int v
462 | _ -> ()
463 ) ct;
465 List.iter (fun tag ->
466 match tag with
467 | { tag_name = Field_KNOWN "temp"; tag_value = String s } ->
468 if Sys.file_exists s then (* be careful on that *)
469 temp_dir := s
470 else (lprintf_nl "Bad temp directory, using default";
472 | _ -> ()
473 ) ot;
475 import_temp !temp_dir
477 let broadcast msg =
478 let s = msg ^ "\n" in
479 let len = String.length s in
480 List.iter (fun sock ->
481 TcpBufferedSocket.write sock s 0 len
482 ) !user_socks
485 let saved_name file =
486 let name = longest_name file in
487 (* if !!use_mp3_tags then
488 match file.file_format with
489 Mp3 tags ->
490 let module T = Mp3tag in
491 let name = match name.[0] with
492 '0' .. '9' -> name
493 | _ -> Printf.sprintf "%02d-%s" tags.T.tracknum name
495 let name = if tags.T.album <> "" then
496 Printf.sprintf "%s/%s" tags.T.album name
497 else name in
498 let name = if tags.T.artist <> "" then
499 Printf.sprintf "%s/%s" tags.T.artist name
500 else name in
501 name
502 | _ -> name
503 else *)
504 name
508 let print_file buf file =
509 Printf.bprintf buf "[%-5d] %s %10Ld %32s %s"
510 (file_num file) (file_best_name file) (file_size file) (Md4.to_string file.file_md4)
511 (if file_state file = FileDownloaded then "Done"
512 else Int64.to_string (file_downloaded file));
514 Buffer.add_char buf '\n';
516 Printf.bprintf buf "Connected clients:\n";
518 let sock_to_string c =
519 match c.client_source.DonkeySources.source_sock with
520 NoConnection -> string_of_date (c.client_source.DonkeySources.source_age)
521 | ConnectionWaiting _ -> "Connecting"
522 | Connection _ -> "Connected"
525 let f _ c =
526 match c.client_kind with
527 Direct_address (ip, port) ->
528 Printf.bprintf buf "[%-5d] %12s %-5d %s\n"
529 (client_num c) (Ip.to_string ip) port (sock_to_string c)
530 | _ ->
531 Printf.bprintf buf "[%-5d] %12s %s\n"
532 (client_num c) "Indirect" (sock_to_string c)
535 (* Intmap.iter f file.file_sources; *)
536 match file.file_swarmer with
537 None -> ()
538 | Some swarmer ->
539 let bitmap = CommonSwarming.verified_bitmap swarmer in
540 Printf.bprintf buf "\nChunks: %s\n" bitmap
543 let recover_md4s md4 =
544 let file = find_file md4 in
545 match file.file_swarmer with
546 None -> ()
547 | Some swarmer ->
548 CommonSwarming.verify_all_chunks swarmer
551 if file.file_chunks <> [||] then
552 for i = 0 to file.file_nchunks - 1 do
553 file.file_chunks.(i) <- (match file.file_chunks.(i) with
554 PresentVerified -> PresentTemp
555 | AbsentVerified -> AbsentTemp
556 | PartialVerified x -> PartialTemp x
557 | x -> x)
558 done
563 let parse_donkey_url url user group =
564 let url = Str.global_replace (Str.regexp "|sources,") "|sources|" url in
565 match String2.split url '|' with
566 (* TODO RESULT *)
567 | "ed2k://" :: "file" :: name :: size :: md4 :: "/" :: "sources" :: sources :: _
568 | "file" :: name :: size :: md4 :: "/" :: "sources" :: sources :: _ ->
569 (* ed2k://|file|Wikipedia_3.3_noimages.iso|2666311680|747735CD46B61DA92973E9A8840A9C99|/|sources,62.143.4.124:4662|/ *)
570 if Int64.of_string size >= max_emule_file_size then
571 (Printf.sprintf (_b "Files > %s are not allowed")
572 (Int64ops.int64_to_human_readable max_emule_file_size)), false
573 else
574 begin
575 let md4 = if String.length md4 > 32 then
576 String.sub md4 0 32 else md4 in
577 let new_sources = ref [] in
578 let s = String2.split sources ',' in
579 List.iter (fun s ->
580 begin try
581 match String2.split s ':' with
582 [ip;port] ->
583 let source_ip = Ip.of_string ip in
584 let source_port = int_of_string port in
585 new_sources := (source_ip, source_port) :: !new_sources
586 | _ -> ()
587 with _ -> ()
588 end) s;
589 begin
591 let file = query_download name (Int64.of_string size)
592 (Md4.of_string md4) None None None false user group in
593 let new_file = find_file (Md4.of_string md4) in
594 CommonInteractive.start_download file;
595 if !new_sources <> [] then
596 begin
597 List.iter (fun (source_ip, source_port) ->
598 add_source new_file source_ip source_port Ip.null 0
599 ) !new_sources;
600 (Printf.sprintf (_b "added %d sources to new download") (List.length !new_sources)), true
602 else "", true
603 with
604 Already_downloading (s)
605 | Already_shared (s) -> s, false
606 | e -> (Printexc2.to_string e), false
609 | "ed2k://" :: "file" :: name :: size :: md4 :: _
610 | "file" :: name :: size :: md4 :: _ ->
611 if Int64.of_string size >= max_emule_file_size then
612 (Printf.sprintf (_b "Files > %s are not allowed")
613 (Int64ops.int64_to_human_readable max_emule_file_size)), false
614 else
615 let md4 = if String.length md4 > 32 then
616 String.sub md4 0 32 else md4 in
617 let name =
618 let name2 = Filename2.filesystem_compliant name "" 0 in
619 if name2 = "" then
620 Printf.sprintf "urn_ed2k_%s" md4
621 else
622 name2
624 begin try
625 let file = query_download name (Int64.of_string size)
626 (Md4.of_string md4) None None None false user group;
628 CommonInteractive.start_download file;
629 "", true
630 with
631 Already_downloading (s)
632 | Already_shared (s) -> s, false
633 | e -> (Printexc2.to_string e), false
635 | "ed2k://" :: "server" :: ip :: port :: _
636 | "server" :: ip :: port :: _ ->
637 let ip = Ip.of_string ip in
638 let s = force_add_server ip (int_of_string port) in
639 server_connect (as_server s.server_server);
640 "", true
641 | "ed2k://" :: "serverlist" :: url :: _
642 | "serverlist" :: url :: _ ->
643 if !!update_server_list_server_met then
644 ignore (download_server_met url);
645 "", true
646 | "ed2k://" :: "friend" :: ip :: port :: _
647 | "friend" :: ip :: port :: _ ->
648 let ip = Ip.of_string ip in
649 let port = int_of_string port in
650 let c = new_client (Direct_address (ip,port)) None in
651 friend_add c;
652 "", true
654 | _ -> "", false
656 let ip_of_server_cid s =
657 match s.server_cid with
658 None -> Ip.null
659 | Some ip -> ip
661 let op_file_check file =
662 match file.file_swarmer with
663 None -> ()
664 | Some swarmer ->
665 CommonSwarming.verify_all_chunks_immediately swarmer
667 let register_commands list =
668 register_commands
669 (List2.tail_map (fun (n,f,h) -> (n, "Network/Edonkey", f,h)) list)
671 let commands = [
672 "n", Arg_multiple (fun args o ->
673 let buf = o.conn_buf in
674 let ip, port =
675 match args with
676 [ip ; port] -> ip, port
677 | [ip] -> ip, "4661"
678 | _ -> failwith "n <ip> [<port>]: bad argument number"
680 let ip = Ip.from_name ip in
681 let port = int_of_string port in
683 let _ = force_add_server ip port in
684 Printf.bprintf buf "New server %s:%d\n"
685 (Ip.to_string ip) port;
687 ), "<ip> [<port>] :\t\t\tadd a server";
689 "afr", Arg_multiple (fun args o ->
690 let ip, port =
691 match args with
692 [ip ; port] -> ip, port
693 | [ip] -> ip, "4662"
694 | _ -> failwith "afr <ip> [<port>]: bad argument number"
696 let ip = Ip.from_name ip in
697 let port = int_of_string port in
698 let c = new_client (Direct_address (ip,port)) None in
699 friend_add c;
700 "friend added";
701 ), "<ip> [<port>] :\t\t\tadd a friend";
704 "comments", Arg_one (fun filename o ->
705 (* TODO DonkeyIndexer.load_comments filename;
706 DonkeyIndexer.save_comments (); *)
707 "comments loaded and saved"
708 ), "<filename> :\t\t\tload comments from file";
710 "comment", Arg_two (fun md4 comment o ->
711 let buf = o.conn_buf in
712 let md4 = Md4.of_string md4 in
713 (* TODO DonkeyIndexer.add_comment md4 comment; *)
714 "Comment added"
715 ), "<md4> \"<comment>\" :\t\tadd comment on a md4";
718 "import", Arg_one (fun dirname o ->
720 import_config dirname;
721 "config loaded"
722 with e ->
723 Printf.sprintf "error %s while loading config" (
724 Printexc2.to_string e)
725 ), "<dirname> :\t\t\timport the config from dirname";
727 "import_temp", Arg_one (fun dirname o ->
729 import_temp dirname;
730 "temp files loaded"
731 with e ->
732 Printf.sprintf "error %s while loading temp files" (
733 Printexc2.to_string e)
734 ), "<temp_dir> :\t\timport the old edonkey temp directory";
737 "load_old_history", Arg_none (fun o ->
738 (* TODO DonkeyIndexer.load_old_history (); *)
739 "Old history loaded"
740 ), ":\t\t\tload history.dat file";
743 "servers", Arg_one (fun filename o ->
744 if !!update_server_list_server_met then
745 begin
746 let nservers = List.length (Hashtbl2.to_list servers_by_key) in
747 if (String2.starts_with filename "http") then
748 begin
749 ignore (download_server_met filename);
750 Printf.sprintf "download of %s started, check log for results" filename
752 else
753 if Sys.file_exists filename then begin
754 let n = load_server_met (unpack_server_met filename "") in
755 Printf.sprintf "%d servers found, %d new ones inserted"
756 n ((List.length (Hashtbl2.to_list servers_by_key)) - nservers)
758 else
759 Printf.sprintf "%s does not exist, ignoring..." filename
761 else
762 Printf.sprintf "ED2K-update_server_list_server_met is disabled, ignoring..."
763 ), "<filename|URL> :\t\tadd the servers from a server.met file or URL";
765 "id", Arg_none (fun o ->
766 let buf = o.conn_buf in
767 List.iter (fun s ->
768 Printf.bprintf buf "For %s (%s) ---> %s\n"
769 (string_of_server s) s.server_name
770 (match s.server_cid with
771 None -> "waiting"
772 | Some ip ->
773 if low_id ip then
774 Printf.sprintf "%s (LowID)" (Int64.to_string (Ip.to_int64 (Ip.rev ip)))
775 else
776 Printf.sprintf "%s (HighID)" (Ip.to_string (ip_of_server_cid s)))
777 ) (connected_servers());
779 ), ":\t\t\t\t\tprint ID on connected servers";
781 "recover_bytes", Arg_multiple (fun args o ->
782 let buf = o.conn_buf in
784 List.iter (fun arg ->
785 let num = int_of_string arg in
786 List.iter (fun file ->
787 if file_num file = num then begin
788 match file.file_swarmer with
789 None -> ()
790 | Some swarmer ->
791 let segments = CommonFile.recover_bytes (as_file file) in
792 let old_downloaded = CommonSwarming.downloaded swarmer in
793 CommonSwarming.set_present swarmer segments;
794 let new_downloaded = CommonSwarming.downloaded swarmer in
795 Printf.bprintf buf "Recovered %Ld bytes for %s\n"
796 (new_downloaded -- old_downloaded)
797 (file_best_name file)
800 ) !current_files
801 ) args;
803 ) , "<f1> <f2> ... :\t\ttry to recover these files at byte level";
805 "preferred", Arg_two (fun arg1 arg2 o ->
806 if CommonUserDb.user2_is_admin o.conn_user.ui_user then
807 let preferred = bool_of_string arg1 in
808 let ip = Ip.of_string arg2 in
809 Hashtbl.iter (fun ip_s s ->
810 if ip_s = ip then begin
811 s.server_preferred <- preferred;
812 server_must_update s;
814 ) servers_by_key;
815 "ok"
816 else
817 _s "You are not allowed to change preferred status"
818 ), "<true|false> <ip> :\t\tset the server with this IP as preferred";
820 "bs", Arg_multiple (fun args o ->
821 if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin
822 List.iter (fun arg ->
823 let range = Ip.range_of_string arg in
824 server_black_list =:= range :: !!server_black_list;
825 ) args;
826 "done"
827 end else
828 _s "You are not allowed to blacklist servers"
829 ), "<range1> <range2> ... :\t\tadd these IPs to the servers black list (can be single IPs, CIDR ranges or begin-end ranges)";
831 "port", Arg_one (fun arg o ->
832 if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin
833 donkey_port =:= int_of_string arg;
834 "new port will change at next restart"
835 end else
836 _s "You are not allowed to change connection port"
838 "<port> :\t\t\t\tchange connection port";
840 "scan_temp", Arg_none (fun o ->
841 if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin
842 let buf = o.conn_buf in
843 let list = Unix2.list_directory !!temp_directory in
845 let counter = ref 0 in
846 let tr = ref "dl-1" in
848 if use_html_mods o then begin
850 Printf.bprintf buf
851 "\\<script language=javascript\\>
852 \\<!--
853 function submitRenameForm(i) {
854 var formID = document.getElementById(\\\"renameForm\\\" + i)
855 parent.fstatus.location.href='submit?q=rename+'+i+'+\\\"'+encodeURIComponent(formID.newName.value)+'\\\"';
857 //--\\>
858 \\</script\\>";
860 html_mods_table_header buf "scan_tempTable" "scan_temp" [
861 ( Str, "srh", "Filename", "Filename (press ENTER to rename)" ) ;
862 ( Str, "srh", "Status", "Status" ) ;
863 ( Str, "srh", "MD4 (link=ed2k)", "MD4 (link=ed2k)" ); ];
866 end;
868 List.iter (fun filename ->
869 incr counter;
870 if (!counter mod 2 == 0) then tr := "dl-1"
871 else tr := "dl-2";
872 let uid =
873 try Uid.of_string filename
874 with _ -> Uid.no
876 let (other,md4) =
877 match Uid.to_uid uid with
878 | Ed2k md4 -> (false,md4)
879 | NoUid ->
880 (try
881 if String.length filename = 32 then
882 (false,(Md4.of_string filename))
883 else (true,Md4.null)
884 with _ ->
885 (true,Md4.null)
887 | _ -> (true,Md4.null)
890 if other then raise Not_found;
892 let file = find_file md4 in
893 if use_html_mods o then
894 let fnum = (file_num file) in
895 Printf.bprintf buf "
896 \\<tr class=\\\"%s\\\"\\>\\<td class=\\\"sr\\\"\\>
897 \\<form name=\\\"renameForm%d\\\" id=\\\"renameForm%d\\\" action=\\\"javascript:submitRenameForm(%d);\\\"\\>
898 \\<input style=\\\"font: 8pt sans-serif\\\" name=\\\"newName\\\" type=text size=50 value=\\\"%s\\\"\\>\\</input\\>\\</td\\>\\</form\\>
899 \\<td class=\\\"sr \\\"\\>%s\\</td\\>
900 \\<td class=\\\"sr \\\"\\>\\<A HREF=\\\"%s\\\"\\>%s\\</A\\>\\</td\\>\\</tr\\>"
901 !tr fnum fnum fnum (file_best_name file) "Downloading" (file_print_ed2k_link (file_best_name file) (file_size file) file.file_md4) filename
902 else
903 Printf.bprintf buf "%s is %s %s\n" filename
904 (file_best_name file)
905 "(downloading)"
906 with _ ->
907 if use_html_mods o then
908 Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>
909 \\<td class=\\\"sr \\\"\\>%s\\</td\\>
910 \\<td class=\\\"sr \\\"\\>%s\\</td\\>\\</tr\\>" !tr
911 (* TODO RESULT (try
912 let names = DonkeyIndexer.find_names md4 in
913 List.hd names
914 with _ -> "Never Seen") *) "?"
915 (if List.mem md4 !!old_files then
916 "Old file" else "Unknown")
917 filename
918 else
919 Printf.bprintf buf "%s %s %s\n"
920 filename
921 (if List.mem md4 !!old_files then
922 "is an old file" else "is unknown")
923 (* TODO RESULT (try
924 let names = DonkeyIndexer.find_names md4 in
925 List.hd names
926 with _ -> "and never seen") *) "?"
928 with _ ->
929 if use_html_mods o then
930 Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>\\<td class=\\\"sr\\\"\\>Unknown\\</td\\>
931 \\<td class=\\\"sr \\\"\\>\\</td\\>
932 \\<td class=\\\"sr \\\"\\>%s\\</td\\>\\</tr\\>" !tr filename
933 else
934 Printf.bprintf buf "%s unknown\n" filename
936 ) list;
938 if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>";
939 "" end
940 else begin
941 print_command_result o "You are not allowed to use scan_temp";
942 "" end
944 ), ":\t\t\t\tprint temp directory content";
946 "sources", Arg_none (fun o ->
947 if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin
948 DonkeySources.print o.conn_buf o.conn_output;
949 "" end
950 else begin
951 print_command_result o "You are not allowed to list sources";
952 "" end
953 ), ":\t\t\t\tshow sources currently known";
955 "xs", Arg_none (fun o ->
956 let buf = o.conn_buf in
957 if !xs_last_search >= 0 then begin
959 DonkeyUdp.make_xs (CommonSearch.search_find !xs_last_search);
960 if o.conn_output = HTML then
961 html_mods_table_one_row buf "searchTable" "search" [
962 ("", "srh", "Extended search started"); ]
963 else
964 Printf.bprintf buf "extended search started";
965 with e -> Printf.bprintf buf "Error %s" (Printexc2.to_string e)
966 end else begin
967 if o.conn_output = HTML then
968 html_mods_table_one_row buf "searchTable" "search" [
969 ("", "srh", "No previous search to extend"); ]
970 else
971 Printf.bprintf buf "No previous search to extend";
972 end;
974 ), ":\t\t\t\t\textend the last search";
976 "clh", Arg_none (fun o ->
977 (* TODO RESULT DonkeyIndexer.clear (); *)
978 "local history cleared"
979 ), ":\t\t\t\t\tclear local history";
981 (* TODO RESULT *)
982 "dd", Arg_two(fun size md4 o ->
983 let file = query_download md4 (Int64.of_string size)
984 (Md4.of_string md4) None None None false o.conn_user.ui_user o.conn_user.ui_user.user_default_group in
985 CommonInteractive.start_download file;
986 "download started"
987 ), "<size> <md4> :\t\t\tdownload from size and md4";
989 "remove_old_servers", Arg_none (fun o ->
990 let buf = o.conn_buf in
991 DonkeyServers.remove_old_servers ();
992 if o.conn_output = HTML then
993 html_mods_table_one_row buf "serversTable" "servers" [
994 ("", "srh", "Clean done"); ]
995 else
996 Printf.bprintf buf "clean done";
998 ), ":\t\t\tremove servers that have not been connected for several days";
1000 "reset_md4", Arg_none (fun _ ->
1001 set_simple_option donkey_ini "client_md4" (Md4.to_string (mldonkey_md4 (Md4.random ())));
1002 if Autoconf.donkey_sui_works () then set_simple_option donkey_ini "client_private_key" (DonkeySui.SUI.create_key ());
1003 "reset client_md4/client_private_key"
1004 ), ":\t\t\t\treset client_md4/client_private_key to random values";
1006 "bp", Arg_multiple (fun args o ->
1007 if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin
1008 List.iter (fun arg ->
1009 let port = int_of_string arg in
1010 port_black_list =:= port :: !!port_black_list;
1011 ) args;
1012 "done"
1013 end else
1014 _s "You are not allowed to blacklist ports"
1015 ), "<port1> <port2> ... :\t\tadd these ports to the port black list";
1018 let _ =
1019 register_commands commands;
1020 file_ops.op_file_download_order <- (fun file strategy ->
1021 match file.file_swarmer with
1022 | None -> None
1023 | Some s ->
1024 (match strategy with
1025 (* return current strategy *)
1026 | None -> Some (CommonSwarming.get_strategy s)
1027 | Some strategy -> CommonSwarming.set_strategy s strategy;
1028 Some (CommonSwarming.get_strategy s))
1030 file_ops.op_file_resume <- (fun file ->
1031 reconnect_all file;
1033 file_ops.op_file_pause <- (fun file ->
1034 DonkeySources.iter_active_sources (fun s ->
1035 let s_uid = s.DonkeySources.source_uid in
1036 let c = new_client s_uid s.DonkeySources.source_country_code in
1037 match client_state c with
1038 | Connected_downloading f when f = file_num file -> disconnect_client c Closed_by_peer
1039 | _ -> ()
1040 ) file.file_sources
1042 file_ops.op_file_queue <- file_ops.op_file_pause;
1044 file_ops.op_file_commit <- (fun file new_name ->
1046 CommonSwarming.remove_swarmer file.file_swarmer;
1047 file.file_swarmer <- None;
1048 (* DonkeyStats.save_download_history file; *)
1050 if !!keep_downloaded_in_old_files
1051 && not (List.mem file.file_md4 !!old_files) then
1052 old_files =:= file.file_md4 :: !!old_files;
1053 DonkeyShare.remember_shared_info file new_name;
1055 (**************************************************************
1057 Since the new version of Unix32.rename does not update the
1058 file name, we need to create a new 'file' and stop using the old
1059 one. For that, we need first to remove definitively the old one
1060 from the system, and thus to disconnect all uploaders for this
1061 file.---------> to be done urgently
1063 ***************************************************************)
1065 unshare_file file;
1067 network.op_network_connected <- (fun _ ->
1068 !nservers > 0
1070 network.op_network_private_message <- (fun iddest s ->
1072 let c = DonkeyGlobals.find_client_by_name iddest in
1073 match c.client_source.DonkeySources.source_sock with
1074 NoConnection ->
1075 DonkeyClient.reconnect_client c;
1076 c.client_pending_messages <- c.client_pending_messages @ [s];
1077 | ConnectionWaiting _ ->
1078 c.client_pending_messages <- c.client_pending_messages @ [s];
1079 | Connection sock ->
1080 client_send c (DonkeyProtoClient.SayReq s)
1081 with
1082 Not_found -> ()
1084 network.op_network_download <- (fun r user group ->
1085 result_download r r.result_names r.result_force user group
1088 module P = GuiTypes
1091 (* How often is this function called when the interface is running ?
1092 is it called when no interface is connected ? it should be as fast
1093 as possible. *)
1095 let _ =
1096 file_ops.op_file_info <- (fun file ->
1098 let last_seen = match file.file_swarmer with
1099 None -> [| last_time () |]
1100 | Some swarmer -> CommonSwarming.compute_last_seen swarmer
1102 let v =
1103 { (impl_file_info file.file_file) with
1105 P.file_network = network.network_num;
1106 P.file_md4 = file.file_md4;
1107 P.file_all_sources = file.file_sources.DonkeySources.manager_all_sources;
1108 P.file_active_sources = file.file_sources.DonkeySources.manager_active_sources;
1109 P.file_chunks =
1110 (match file.file_swarmer with
1111 | None -> None
1112 | Some swarmer -> Some (CommonSwarming.chunks_verified_bitmap swarmer));
1113 P.file_chunk_size =
1114 (match file.file_swarmer with
1115 | None -> None
1116 | Some t -> Some (List.map (fun t -> t.CommonSwarming.t_chunk_size) t.CommonSwarming.t_s.CommonSwarming.s_networks));
1117 P.file_availability =
1119 network.network_num,
1120 (match file.file_swarmer with
1121 | None -> ""
1122 | Some swarmer -> CommonSwarming.chunks_availability swarmer)
1124 P.file_format = file.file_format;
1125 P.file_chunks_age = last_seen;
1126 P.file_uids = [Uid.create (Ed2k file.file_md4)];
1127 P.file_comments = file.file_comments
1128 } in
1130 with e ->
1131 lprintf_nl "Exception %s in op_file_info" (Printexc2.to_string e);
1132 raise e
1136 let _ =
1137 server_ops.op_server_info <- (fun s ->
1138 check_server_country_code s;
1139 if !!enable_donkey then
1140 { (impl_server_info s.server_server) with
1142 P.server_network = network.network_num;
1143 P.server_addr = Ip.addr_of_ip s.server_ip;
1144 P.server_port = s.server_port;
1145 P.server_realport = (match s.server_realport with Some x -> x | None -> 0);
1146 P.server_country_code = s.server_country_code;
1147 P.server_score = s.server_score;
1148 P.server_nusers = (match s.server_nusers with None -> 0L | Some v -> v);
1149 P.server_nfiles = (match s.server_nfiles with None -> 0L | Some v -> v);
1150 P.server_name = s.server_name;
1151 P.server_description = s.server_description;
1152 P.server_banner = s.server_banner;
1153 P.server_preferred = s.server_preferred;
1154 P.server_master = s.server_master;
1155 P.server_published_files = (List.length s.server_sent_shared);
1156 P.server_version = s.server_version;
1157 P.server_max_users = (match s.server_max_users with None -> 0L | Some v -> v);
1158 P.server_soft_limit = (match s.server_soft_limit with None -> 0L | Some v -> v);
1159 P.server_hard_limit = (match s.server_hard_limit with None -> 0L | Some v -> v);
1160 P.server_lowid_users = (match s.server_lowid_users with None -> 0L | Some v -> v);
1161 P.server_ping = s.server_ping;
1162 P.server_features = let temp_buf = Buffer.create 100 in
1163 if s.server_has_zlib then Printf.bprintf temp_buf "zlib ";
1164 if s.server_has_newtags then Printf.bprintf temp_buf "newtags ";
1165 if s.server_has_unicode then Printf.bprintf temp_buf "unicode ";
1166 if s.server_has_related_search then Printf.bprintf temp_buf "related_search ";
1167 if s.server_has_tag_integer then Printf.bprintf temp_buf "tag_integer ";
1168 if s.server_has_largefiles then Printf.bprintf temp_buf "largefiles ";
1169 if s.server_has_get_sources then Printf.bprintf temp_buf "getsources ";
1170 if s.server_has_get_sources2 then Printf.bprintf temp_buf "getsources2 ";
1171 if s.server_has_get_files then Printf.bprintf temp_buf "getfiles ";
1172 (match s.server_obfuscation_tcp with
1173 | Some p when p <> 0 -> Printf.bprintf temp_buf "tcp_obfuscation(%d) " p | _ -> ());
1174 (match s.server_obfuscation_udp with
1175 | Some p when p <> 0 -> Printf.bprintf temp_buf "udp_obfuscation(%d) " p | _ -> ());
1176 if s.server_auxportslist <> "" then Printf.bprintf temp_buf "auxportslist %s " s.server_auxportslist;
1177 if s.server_dynip <> "" then Printf.bprintf temp_buf "dynip %s " s.server_dynip;
1178 if Buffer.contents temp_buf <> "" then Some (Buffer.contents temp_buf) else None;
1180 else raise Not_found
1184 let _ =
1185 user_ops.op_user_info <- (fun u ->
1187 P.user_num = u.user_user.impl_user_num;
1188 P.user_md4 = u.user_md4;
1189 P.user_ip = u.user_ip;
1190 P.user_port = u.user_port;
1191 P.user_tags = []; (* u.user_tags; *)
1192 P.user_name = u.user_name;
1193 P.user_server = u.user_server.server_server.impl_server_num;
1197 let string_of_client_ip c =
1198 try match c.client_source.DonkeySources.source_sock with
1199 Connection sock -> (Ip.to_string (peer_ip sock))
1200 | _ -> ""
1201 with _ -> ""
1203 let get_ips_cc_cn c =
1204 check_client_country_code c;
1206 match c.client_kind with
1207 | Direct_address (ip,port) ->
1208 let cc,cn = Geoip.get_country_code_name c.client_country_code in
1209 (Ip.to_string ip),cc,cn
1210 | Indirect_address (_,_,_,_,real_ip) ->
1211 let cc,cn = Geoip.get_country_code_name c.client_country_code in
1212 (Ip.to_string real_ip),cc,cn
1213 | _ ->
1214 let cc,cn = Geoip.unknown_country in
1215 (string_of_client_ip c),cc,cn
1216 with _ -> ("X","??","Country Error")
1219 let _ =
1220 client_ops.op_client_info <- (fun c ->
1221 check_client_country_code c;
1222 { (impl_client_info c.client_client) with
1224 P.client_network = network.network_num;
1225 P.client_kind = (match c.client_kind with
1226 Direct_address (ip, port) -> Known_location (ip,port)
1227 | Indirect_address (server_ip, server_port, ip, port, real_ip) ->
1228 Indirect_location (c.client_name,c.client_md4, real_ip, port)
1229 | _ -> Indirect_location (c.client_name,c.client_md4, c.client_ip, 0));
1230 P.client_country_code = c.client_country_code;
1231 P.client_state = client_state c;
1232 P.client_type = client_type c;
1233 P.client_name = c.client_name;
1234 P.client_rating = c.client_rating;
1235 P.client_connect_time = c.client_connect_time;
1236 P.client_software = brand_to_string_short c.client_brand;
1237 P.client_os = c.client_osinfo;
1238 P.client_release = c.client_emule_proto.emule_release;
1239 P.client_emulemod = brand_mod_to_string_short c.client_brand_mod;
1240 P.client_total_downloaded = c.client_total_downloaded;
1241 P.client_total_uploaded = c.client_total_uploaded;
1242 P.client_session_downloaded = c.client_session_downloaded;
1243 P.client_session_uploaded = c.client_session_uploaded;
1244 P.client_upload =
1245 (match client_upload (as_client c) with
1246 Some f -> Some (CommonFile.file_best_name f)
1247 | None -> None);
1248 P.client_sui_verified = c.client_sui_verified;
1249 P.client_file_queue = List.map (fun (file,_,_) -> as_file file) c.client_file_queue
1252 client_ops.op_client_debug <- (fun c debug ->
1253 c.client_debug <- debug)
1255 let _ =
1256 server_ops.op_server_remove <- (fun s ->
1257 DonkeyGlobals.remove_server s.server_ip s.server_port
1259 server_ops.op_server_connect <- connect_server;
1260 server_ops.op_server_disconnect <- (fun s ->
1261 disconnect_server s Closed_by_user);
1263 server_ops.op_server_query_users <- (fun s ->
1264 match s.server_sock, server_state s with
1265 Connection sock, (Connected _ | Connected_downloading _) ->
1266 server_send sock (DonkeyProtoServer.QueryUsersReq "");
1267 Fifo.put s.server_users_queries false
1268 | _ -> ()
1270 server_ops.op_server_find_user <- (fun s user ->
1271 match s.server_sock, server_state s with
1272 Connection sock, (Connected _ | Connected_downloading _) ->
1273 server_send sock (DonkeyProtoServer.QueryUsersReq user);
1274 Fifo.put s.server_users_queries true
1275 | _ -> ()
1277 server_ops.op_server_users <- (fun s ->
1278 List2.tail_map (fun u -> as_user u.user_user) s.server_users) ;
1280 server_ops.op_server_published <- (fun s ->
1281 List.map (fun f -> as_file f) s.server_sent_shared);
1283 server_ops.op_server_cid <- (fun s -> ip_of_server_cid s);
1285 server_ops.op_server_low_id <- (fun s -> low_id (ip_of_server_cid s));
1287 server_ops.op_server_set_preferred <- (fun s b ->
1288 s.server_preferred <- b;
1289 server_must_update s);
1291 server_ops.op_server_rename <- (fun s name ->
1292 s.server_name <- name;
1293 server_must_update s);
1297 let _ =
1298 file_ops.op_file_save_as <- (fun file name ->
1299 add_file_filenames (as_file file) name;
1300 set_file_best_name (as_file file) name "" 0
1302 file_ops.op_file_shared <- (fun file ->
1303 match file.file_shared with
1304 None -> None
1305 | Some sh -> Some (as_shared sh)
1307 file_ops.op_file_set_format <- (fun file format ->
1308 file.file_format <- format);
1309 file_ops.op_file_check <- op_file_check;
1310 file_ops.op_file_recover <- (fun file ->
1311 if file_state file = FileDownloading then
1312 reconnect_all file);
1313 file_ops.op_file_all_sources <- (fun file ->
1314 let list = ref [] in
1315 DonkeySources.iter_all_sources (fun s ->
1316 let s_uid = s.DonkeySources.source_uid in
1317 let c = new_client s_uid s.DonkeySources.source_country_code in
1318 list := (as_client c) :: !list
1319 ) file.file_sources;
1320 !list
1322 file_ops.op_file_active_sources <- (fun file ->
1323 let list = ref [] in
1324 DonkeySources.iter_active_sources (fun s ->
1325 let s_uid = s.DonkeySources.source_uid in
1326 let c = new_client s_uid s.DonkeySources.source_country_code in
1327 list := (as_client c) :: !list
1328 ) file.file_sources;
1329 !list
1331 file_ops.op_file_print <- (fun file o ->
1333 let buf = o.conn_buf in
1334 if not (use_html_mods o) then begin
1335 let cntr = ref 0 in
1336 List.iter (fun (ip, n, r, c) ->
1337 incr cntr;
1338 Printf.bprintf buf
1339 "Comment %d: Rating(%d): %s (%s/%s)\n" !cntr r (Charset.Locale.to_utf8 c) n (Ip.to_string ip)) file.file_comments
1340 end else begin
1341 let tr () =
1342 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ())
1345 tr ();
1346 html_mods_td buf [
1347 ("Fake check links", "sr br", "Fakecheck");
1348 ("", "sr", Printf.sprintf "\\<a target=\\\"_blank\\\" href=\\\"http://bitzi.com/lookup/urn:ed2k:%s\\\"\\>[Bitzi-Bitpedia]\\</a\\> \\<a target=\\\"_blank\\\" href=\\\"http://www.filedonkey.com/url/%s\\\"\\>[FileDonkey]\\</a\\>"
1349 (Md4.to_string file.file_md4) (Md4.to_string file.file_md4)
1350 ) ];
1352 let cntr = ref 0 in
1353 List.iter (fun (ip, n, r, c) ->
1354 incr cntr;
1355 tr ();
1356 html_mods_td buf [
1357 ("Comment", "sr br", Printf.sprintf "Comment %d" !cntr);
1358 ("User rating and comment", "sr", Printf.sprintf "Rating(%d): %s (%s/%s)" r (Charset.Locale.to_utf8 c) n (Ip.to_string ip));
1360 ) file.file_comments;
1362 tr ();
1363 html_mods_td buf [
1364 ("File History Links", "sr br", "File History");
1365 ("","sr", Printf.sprintf
1366 "\\<a target=\\\"_blank\\\" href=\\\"http://tothbenedek.hu/ed2kstats/ed2k?hash=%s\\\"\\>Toth File History\\</a\\>
1367 \\<a target=\\\"_blank\\\" href=\\\"http://ed2k.titanesel.ws/ed2k.php?hash=%s\\\"\\>Titanesel File History\\</a\\>"
1368 (Md4.to_string file.file_md4) (Md4.to_string file.file_md4)
1371 tr ();
1372 let ed2k = file_print_ed2k_link (file_best_name file) (file_size file) file.file_md4 in
1373 html_mods_td buf [
1374 ("ed2k link", "sr br", "ed2k link");
1375 ("", "sr", Printf.sprintf "\\<a href=\\\"%s\\\"\\>%s\\</A\\>" ed2k ed2k) ];
1376 tr ();
1377 let optionlist = ref "" in
1378 List.iter (fun name ->
1379 optionlist := !optionlist ^ Printf.sprintf "\\<option value=\\\"%s\\\"\\>%s\n" name name;
1380 ) file.file_file.impl_file_filenames;
1383 let input_size = (Printf.sprintf "%d" ((String.length (file_best_name file))+3)) in
1384 html_mods_td buf [
1385 ("Rename file by selecting an alternate name", "sr br", "Filename");
1386 ("Rename file", "sr",
1387 Printf.sprintf "\\<script language=javascript\\>
1388 \\<!--
1389 function submitRenameForm(i) {
1390 var formID = document.getElementById(\\\"renameForm\\\" + i)
1391 parent.fstatus.location.href='submit?q=rename+%d+\\\"'+encodeURIComponent(formID.newName.value)+'\\\"';
1393 //--\\>
1394 \\</script\\>" (file_num file)
1396 ^ "\\<table border=0 cellspacing=0 cellpadding=0\\>\\<tr\\>"
1397 ^ "\\<form name=\\\"renameForm1\\\" id=\\\"renameForm1\\\" action=\\\"javascript:submitRenameForm(1);\\\"\\>"
1398 ^ "\\<td\\>"
1399 ^ "\\<select name=\\\"newName\\\" id=\\\"newName\\\" onchange=\\\"javascript:renameForm2.newName.value=renameForm1.newName.options[renameForm1.newName.selectedIndex].value;this.form.submit();\\\"\\>"
1400 ^ Printf.sprintf "\\<option value=\\\"%s\\\" selected\\>%s\n" (file_best_name file) (file_best_name file)
1401 ^ !optionlist
1402 ^ "\\</select\\>\\</td\\>\\</form\\>\\</tr\\>\\<tr\\>\\<form name=\\\"renameForm2\\\" id=\\\"renameForm2\\\" action=\\\"javascript:submitRenameForm(2);\\\"\\>"
1403 ^ "\\<td\\>"
1404 ^ "\\<input name=\\\"newName\\\" type=text size=" ^ input_size ^ " value=\\\"" ^ (file_best_name file) ^ "\\\"\\>\\</input\\>\\</td\\>\\</form\\>\\</tr\\>\\</table\\>"
1405 ) ];
1408 file_ops.op_file_print_sources <- (fun file o ->
1410 if not (use_html_mods o) then raise Not_found;
1411 let buf = o.conn_buf in
1412 let sources_list = ref [] in
1413 DonkeySources.iter_relevant_sources (fun s ->
1414 let s_uid = s.DonkeySources.source_uid in
1415 let c = new_client s_uid s.DonkeySources.source_country_code in
1416 sources_list := (s,c) :: !sources_list
1417 ) file.file_sources;
1419 if List.length !sources_list > 0 then
1420 begin
1422 let chunks =
1423 (match file.file_swarmer with
1424 | None -> None
1425 | Some swarmer -> Some (CommonSwarming.chunks_verified_bitmap swarmer))
1428 html_mods_table_header buf "sourcesTable" "sources al" ([
1429 ( Num, "srh ac", "Client number (click to add as friend)", "Num" ) ;
1430 ( Str, "srh", "[A] = Active download from client", "A" ) ;
1431 ( Str, "srh", "Client state", "CS" ) ;
1432 ( Str, "srh", "Client name", "Name" ) ;
1433 ( Str, "srh", "Client brand", "CB" ) ;
1434 ( Str, "srh", "Client release", "CR" ) ;
1436 (if !!emule_mods_count then [( Str, "srh", "eMule MOD", "EM" )] else [])
1438 ( Str, "srh", "Overnet [T]rue, [F]alse", "O" ) ;
1439 ( Str, "srh", "Connection [I]ndirect, [D]irect", "C" ) ;
1440 ( Str, "srh", "Secure User Identification [N]one, [P]assed, [F]ailed", "S" ) ;
1441 ( Str, "srh br", "IP address", "IP address" ) ;
1442 ] @ (if Geoip.active () then [( Str, "srh br", "Country Code/Name", "CC" )] else []) @ [
1443 ( Num, "srh ar", "Total UL bytes to this client for all files", "tUL" ) ;
1444 ( Num, "srh ar br", "Total DL bytes from this client for all files", "tDL" ) ;
1445 ( Num, "srh ar", "Session UL bytes to this client for all files", "sUL" ) ;
1446 ( Num, "srh ar br", "Session DL bytes from this client for all files", "sDL" ) ;
1447 ( Num, "srh ar", "Your queue rank on this client", "Rnk" ) ;
1448 ( Num, "srh ar br", "Source score", "Scr" ) ;
1449 ( Num, "srh ar br", "Last ok", "LO" ) ;
1450 ( Num, "srh ar", "Request score", "RS" ) ;
1451 ( Num, "srh ar", "Request queue (see sources command)", "RQ" ) ;
1452 ( Num, "srh ar br", "Request time (last connect) (# minutes ago)", "RT" ) ;
1453 ( Str, "srh", "Has a slot [T]rue, [F]alse", "H" ) ;
1454 ( Str, "srh br", "Banned [T]rue, [F]alse", "B" ) ;
1455 ( Num, "srh ar", "Requests sent", "RS" ) ;
1456 ( Num, "srh ar", "Requests received", "RR" ) ;
1457 ( Num, "srh ar br", "Connected time (minutes)", "CT" ) ;
1458 ( Str, "srh br", "Client MD4", "MD4" ) ;
1459 ( Str, "srh", "Chunks (absent|partial|present|verified)",
1460 match chunks with
1461 | None -> ""
1462 | Some chunks -> colored_chunks chunks) ;
1463 ( Num, "srh ar", "Number of full chunks", (Printf.sprintf "%d"
1464 (match chunks with
1465 | None -> 0
1466 | Some chunks ->
1467 VerificationBitmap.fold_lefti (fun acc _ s ->
1468 if s = VerificationBitmap.State_verified then acc + 1
1469 else acc) 0 chunks))) ]);
1472 html_mods_cntr_init();
1473 List.iter (fun (s,c) ->
1474 let ac = as_client c in
1476 Printf.bprintf buf "\\<tr onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\" class=\\\"dl-%d\\\"\\>"
1477 (html_mods_cntr());
1479 Printf.bprintf buf "\\<td title=\\\"Add as Friend\\\" class=\\\"srb ar\\\" onClick=\\\"parent.fstatus.location.href='submit?q=friend_add+%d'\\\"\\>%d\\</TD\\>"
1480 (client_num c) (client_num c);
1482 let req_queue, req_score, req_min =
1483 try
1484 let r = DonkeySources.find_request s file.file_sources in
1485 let q = r.DonkeySources.request_queue in
1486 let s = r.DonkeySources.request_score in
1487 let t = r.DonkeySources.request_time in
1488 (Printf.sprintf "%d" q,
1489 Printf.sprintf "%d" s,
1490 if t = 0 then "N" else Printf.sprintf "%d" ((last_time() - t) / 60))
1491 with _ -> ("?","?","?") in
1493 let ip_string,cc,cn = get_ips_cc_cn c in
1495 html_mods_td buf ([
1496 ("", "sr", (match c.client_download with
1497 None -> ""
1498 | Some _ -> (
1499 let qfiles = c.client_file_queue in
1500 let (qfile, qchunks,_) = List.hd qfiles in
1501 if (qfile == file) then
1502 "A" else "";)) );
1503 ((string_of_connection_state (client_state c)), "sr",
1504 (short_string_of_connection_state (client_state c)) );
1505 (String.escaped c.client_name, "sr", client_short_name c.client_name);
1506 (client_software (brand_to_string c.client_brand) c.client_osinfo, "sr",
1507 client_software_short (brand_to_string_short c.client_brand) c.client_osinfo);
1508 ("", "sr", c.client_emule_proto.emule_release);
1511 (if !!emule_mods_count then [(brand_mod_to_string c.client_brand_mod, "sr", brand_mod_to_string_short c.client_brand_mod)] else [])
1514 ("", "sr", (if DonkeySources.source_brand c.client_source then "T" else "F"));
1515 ("", "sr", (match c.client_kind with
1516 | Direct_address (ip,port) -> "D"
1517 | _ -> "I"
1519 ("", "sr", (match c.client_sui_verified with
1520 | None -> "N"
1521 | Some b -> if b then "P" else "F"
1523 ("", "sr br", ip_string);
1524 ] @ (if Geoip.active () then [(cn, "sr br", CommonPictures.flag_html cc)] else []) @ [
1525 ("", "sr ar", (size_of_int64 c.client_total_uploaded));
1526 ("", "sr ar br", (size_of_int64 c.client_total_downloaded));
1527 ("", "sr ar", (size_of_int64 c.client_session_uploaded));
1528 ("", "sr ar br", (size_of_int64 c.client_session_downloaded));
1529 ("", "sr ar", Printf.sprintf "%d" c.client_rank);
1530 ("", "sr ar br", Printf.sprintf "%d" c.client_source.DonkeySources.source_score);
1531 ("", "sr ar br", (string_of_date (c.client_source.DonkeySources.source_age)));
1532 ("", "sr ar", req_score);
1533 ("", "sr ar", req_queue);
1534 ("", "sr ar br", req_min);
1535 ("", "sr ar", (if client_has_a_slot ac then "T" else "F"));
1536 ("", "sr ar br", (if c.client_banned then "T" else "F"));
1537 ("", "sr ar", Printf.sprintf "%d" c.client_requests_sent);
1538 ("", "sr ar", Printf.sprintf "%d" c.client_requests_received);
1539 ("", "sr ar br", Printf.sprintf "%d" (((last_time ()) - c.client_connect_time) / 60));
1540 ("", "sr br", (Md4.to_string c.client_md4)); ]);
1542 Printf.bprintf buf "\\<td class=\\\"sr \\\"\\>";
1544 ( let qfiles = c.client_file_queue in
1545 if qfiles <> [] then begin
1547 let _, qchunks,_ = List.find (fun (qfile, _,_) ->
1548 qfile == file) qfiles in
1549 let tc = ref 0 in
1550 let arr =
1551 VerificationBitmap.init (Bitv.length qchunks) (fun i ->
1552 if Bitv.get qchunks i then begin
1553 incr tc;
1554 VerificationBitmap.State_complete
1555 end else VerificationBitmap.State_missing) in
1556 Printf.bprintf buf "%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%d\\</td\\>"
1557 (CommonFile.colored_chunks arr) !tc;
1558 with Not_found -> (
1559 Printf.bprintf buf "\\</td\\>\\<td class=\\\"sr ar\\\"\\>\\</td\\>"
1562 else
1563 Printf.bprintf buf "\\</td\\>\\<td class=\\\"sr ar\\\"\\>\\</td\\>"
1566 Printf.bprintf buf "\\</tr\\>";
1567 with _ -> ()
1569 ) (List.sort (fun (s1,c1) (s2,c2) -> compare (client_num c1) (client_num c2)) !sources_list);
1572 Printf.bprintf buf "\\</table\\>\\</div\\>\\<br\\>";
1574 end;
1577 file_ops.op_file_cancel <- (fun file ->
1578 CommonSwarming.remove_swarmer file.file_swarmer;
1579 file.file_swarmer <- None;
1580 Hashtbl.remove files_by_md4 file.file_md4;
1581 current_files := List2.removeq file !current_files;
1582 DonkeySources.remove_file_sources_manager file.file_sources;
1583 if !!keep_cancelled_in_old_files &&
1584 not (List.mem file.file_md4 !!old_files) then
1585 old_files =:= file.file_md4 :: !!old_files;
1586 DonkeyProtoOvernet.Overnet.cancel_recover_file file;
1587 DonkeyProtoKademlia.Kademlia.cancel_recover_file file;
1589 file_ops.op_file_files <- (fun file impl ->
1590 match file.file_swarmer with
1591 None -> [CommonFile.as_file impl]
1592 | Some swarmer ->
1593 CommonSwarming.subfiles swarmer)
1595 let try_recover_temp_file filename md4 =
1597 ignore (Hashtbl.find files_by_md4 md4)
1598 with Not_found ->
1599 let user = CommonUserDb.admin_user () in
1600 let file_diskname = Filename.concat !!temp_directory filename in
1601 let size = Unix32.getsize file_diskname in
1602 if size <> zero then
1603 begin
1604 ignore (really_query_download (Md4.to_string md4) size md4 None (Some file_diskname) None user user.user_default_group);
1605 recover_md4s md4
1608 let _ =
1609 network.op_network_extend_search <- (fun s e ->
1610 match e with
1611 | ExtendSearchLocally ->
1612 (* TODO RESULT DonkeyIndexer.find s *) ()
1613 | ExtendSearchRemotely ->
1614 DonkeyUdp.make_xs s
1617 network.op_network_clean_servers <- (fun _ ->
1618 DonkeyServers.remove_old_servers ());
1620 network.op_network_connect_servers <- (fun _ ->
1621 force_check_server_connections true);
1623 (* TODO RESULT *)
1624 network.op_network_recover_temp <- (fun _ ->
1625 let files = Unix2.list_directory !!temp_directory in
1626 List.iter (fun filename ->
1627 let uid =
1628 try Uid.of_string filename
1629 with _ -> Uid.no
1631 match Uid.to_uid uid with
1632 | Ed2k md4 ->
1633 (try
1634 try_recover_temp_file filename md4
1635 with e ->
1636 lprintf_nl "exception %s in recover_temp"
1637 (Printexc2.to_string e);
1639 | NoUid ->
1640 (if String.length filename = 32 then
1642 let md4 = Md4.of_string filename in
1643 try_recover_temp_file filename md4
1644 with e ->
1645 lprintf_nl "exception %s in recover_temp"
1646 (Printexc2.to_string e);
1648 | _ -> ()
1649 ) files
1652 network.op_network_parse_url <- parse_donkey_url;
1653 network.op_network_reset <- (fun _ -> ());
1655 network.op_network_close_search <- (fun s -> ());
1656 network.op_network_check_upload_slots <- (fun _ -> ());
1657 network.op_network_porttest_start <- (fun _ ->
1658 porttest_result := PorttestInProgress (last_time ());
1659 let module H = Http_client in
1660 let r = { H.basic_request with
1661 H.req_url = Url.of_string
1662 (Printf.sprintf "http://porttest.emule-project.net:81/ct_noframe.php?lang=&tcpport=%d&udpport=%d"
1663 !!donkey_port (!!donkey_port + 4));
1664 H.req_proxy = !CommonOptions.http_proxy;
1665 H.req_max_retry = 10;
1666 H.req_user_agent = get_user_agent () } in
1667 H.wget r (fun file ->
1668 Unix2.tryopen_read file (fun cin ->
1670 while true do
1671 let line = input_line cin in
1673 if Str.string_match (Str.regexp "^<P>Testing IP") line 0 then
1674 porttest_result := PorttestResult (last_time (), line)
1675 with _ -> ()
1676 done
1677 with End_of_file -> ())
1679 network.op_network_forget_search <- forget_search
1681 (* emule<->mldonkey disconnects during chat, and this doesn't seem to auto reconnect
1682 when sending a message? emule or ml problem? *)
1683 let _ =
1684 client_ops.op_client_say <- (fun c s ->
1685 match c.client_source.DonkeySources.source_sock with
1686 | NoConnection ->
1687 DonkeyClient.reconnect_client c;
1688 c.client_pending_messages <- c.client_pending_messages @ [s];
1689 | ConnectionWaiting _ ->
1690 c.client_pending_messages <- c.client_pending_messages @ [s];
1691 | Connection sock ->
1692 client_send c (DonkeyProtoClient.SayReq s)
1694 client_ops.op_client_files <- (fun c ->
1695 match c.client_all_files with
1696 None -> []
1697 | Some files ->
1698 List2.tail_map (fun r -> "", r) files);
1699 client_ops.op_client_browse <- (fun c immediate ->
1700 if !verbose then lprintf_nl "connecting friend %s" (full_client_identifier c);
1701 match c.client_source.DonkeySources.source_sock with
1702 | Connection sock when c.client_emule_proto.emule_noviewshared <> 1 ->
1703 if !verbose then lprintf_nl "retrieving filelist from friend %s" (full_client_identifier c);
1704 client_send c (
1705 let module M = DonkeyProtoClient in
1706 let module C = M.ViewFiles in
1707 M.ViewFilesReq C.t);
1708 | NoConnection when c.client_emule_proto.emule_noviewshared <> 1 ->
1709 if !verbose then lprintf_nl "re-connecting friend %s"
1710 (full_client_identifier c);
1711 set_must_browse (as_client c);
1712 reconnect_client c
1713 | _ -> ()
1715 client_ops.op_client_connect <- (fun c ->
1716 match c.client_source.DonkeySources.source_sock with
1717 NoConnection -> reconnect_client c
1718 | _ -> ()
1720 client_ops.op_client_disconnect <- (fun c ->
1721 DonkeyClient.disconnect_client c Closed_by_user
1723 client_ops.op_client_clear_files <- (fun c ->
1724 c.client_all_files <- None;
1727 client_ops.op_client_bprint <- (fun c buf ->
1728 Printf.bprintf buf "\t\t%s (last_ok <%s>)\n"
1729 c.client_name
1730 (string_of_date (c.client_source.DonkeySources.source_age))
1732 client_ops.op_client_print_info <- (fun c o ->
1733 let buf = o.conn_buf in
1734 let ip_string,cc,cn = get_ips_cc_cn c in
1736 Printf.bprintf buf "Client %d: %s\n"
1737 (client_num c)
1738 (full_client_identifier c);
1740 match c.client_osinfo with
1741 | Some i -> Printf.bprintf buf " osinfo: %s\n" i
1742 | None -> ()
1744 Printf.bprintf buf " state: %s, rank: %d\n"
1745 (string_of_connection_state (client_state c)) c.client_rank;
1746 if Geoip.active () then Printf.bprintf buf " country: %s: %s\n" cc cn;
1747 Printf.bprintf buf " MD4: %s\n" (Md4.to_string c.client_md4);
1748 Printf.bprintf buf " downloaded\n";
1749 Printf.bprintf buf " - session %s\n" (size_of_int64 c.client_session_downloaded);
1750 Printf.bprintf buf " - total %s\n" (size_of_int64 c.client_total_downloaded);
1752 match c.client_download with
1753 | Some (f,_) -> Printf.bprintf buf " downloading file %s\n" (file_best_name f)
1754 | None -> Printf.bprintf buf " not downloading\n"
1756 Printf.bprintf buf " uploaded\n";
1757 Printf.bprintf buf " - session %s\n" (size_of_int64 c.client_session_uploaded);
1758 Printf.bprintf buf " - total %s\n" (size_of_int64 c.client_total_uploaded);
1760 match c.client_upload with
1761 | Some u -> Printf.bprintf buf " uploading file %s\n" (file_best_name u.up_file)
1762 | _ -> Printf.bprintf buf " not uploading\n"
1764 Printf.bprintf buf " SUI %s\n" (
1765 match c.client_sui_verified with
1766 | None -> "not supported"
1767 | Some b -> if b then "passed" else "failed"
1769 Printf.bprintf buf " kind: %s\n" (
1770 match c.client_kind with
1771 | Direct_address (ip,port) ->
1772 Printf.sprintf "highID %s:%d" (Ip.to_string ip) port
1773 | Indirect_address (server_ip, server_port, id, port, real_ip) ->
1774 Printf.sprintf "lowID %s:%d, server %s:%d"
1775 (Ip.to_string real_ip) port (Ip.to_string server_ip) server_port
1776 | Invalid_address (name,md4) -> Printf.sprintf "invalid"
1778 if c.client_emule_proto.received_miscoptions1 then
1779 Printf.bprintf buf "\nmiscoptions1:\n%s" (DonkeyProtoClient.print_emule_proto_miscoptions1 c.client_emule_proto)
1780 else
1781 Printf.bprintf buf "no miscoptions1 received\n";
1782 if c.client_emule_proto.received_miscoptions2 then
1783 Printf.bprintf buf "miscoptions2:\n%s" (DonkeyProtoClient.print_emule_proto_miscoptions2 c.client_emule_proto)
1784 else
1785 Printf.bprintf buf "no miscoptions2 received\n";
1786 List.iter (fun (file,_,_) -> Printf.bprintf buf "\nQueue: %s" (file_best_name file)) c.client_file_queue;
1787 List.iter (fun r ->
1788 Printf.bprintf buf "\nSource file: %s, score %d, request time %d"
1789 (CommonFile.file_best_name (r.DonkeySources.request_file.DonkeySources.manager_file ()))
1790 r.DonkeySources.request_score
1791 r.DonkeySources.request_time;
1792 ) c.client_source.DonkeySources.source_files;
1794 client_ops.op_client_dprint <- (fun c o file ->
1795 let info = file_info file in
1796 let buf = o.conn_buf in
1800 (match c.client_download with
1801 None -> ()
1802 | Some _ -> (
1803 let qfiles = c.client_file_queue in
1804 let (qfile, qchunks,_) = List.hd qfiles in
1805 if (qfile == (as_file_impl file).impl_file_val) then begin
1806 Printf.bprintf buf "[Donkey%6d] Name : %-27s IP : %-20s"
1807 (client_num c)
1808 (shorten c.client_name 20)
1809 (match c.client_kind with
1810 Direct_address (ip,port) -> (Ip.to_string ip)
1811 | _ -> (string_of_client_ip c));
1812 Printf.bprintf buf "\n%14sDown : %-10s Uploaded: %-10s Ratio: %s%1.1f (%s)\n" ""
1813 (Int64.to_string c.client_total_downloaded)
1814 (Int64.to_string c.client_total_uploaded)
1815 (if c.client_total_downloaded > c.client_total_uploaded then "-" else "+")
1816 (if c.client_total_uploaded > Int64.zero then (Int64.to_float (Int64.div c.client_total_downloaded c.client_total_uploaded)) else (1.))
1817 (brand_to_string c.client_brand);
1818 (Printf.bprintf buf "%14sFile : %s\n" "" info.GuiTypes.file_name);
1819 end;
1825 with _ -> ()
1829 client_ops.op_client_dprint_html <- (fun c o file str ->
1830 let info = file_info file in
1831 let buf = o.conn_buf in
1833 (match c.client_download with
1834 None -> false
1835 | Some _ -> (
1836 let qfiles = c.client_file_queue in
1837 let (qfile, qchunks,_) = List.hd qfiles in
1838 if (qfile == (as_file_impl file).impl_file_val) then begin
1840 Printf.bprintf buf " \\<tr onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\"
1841 class=\\\"%s\\\"\\> \\<td title=\\\"Add as friend\\\" class=\\\"srb ar\\\"
1842 onClick=\\\"parent.fstatus.location.href='submit?q=friend_add+%d'\\\"\\>%d\\</TD\\>"
1843 str (client_num c) (client_num c);
1845 let ip_string,cc,cn = get_ips_cc_cn c in
1847 html_mods_td buf ([
1848 (string_of_connection_state (client_state c), "sr",
1849 short_string_of_connection_state (client_state c));
1850 (Md4.to_string c.client_md4, "sr", client_short_name c.client_name);
1851 ("", "sr", brand_to_string_short c.client_brand);
1852 ("", "sr", c.client_emule_proto.emule_release);
1854 (if !!emule_mods_count then [("", "sr", brand_mod_to_string_short c.client_brand_mod)] else [])
1856 ("", "sr", (if DonkeySources.source_brand c.client_source
1857 then "T" else "F"));
1858 ("", "sr ar", Printf.sprintf "%d" (((last_time ()) - c.client_connect_time) / 60));
1859 ("", "sr", (match c.client_kind with
1860 | Direct_address (ip,port) -> Printf.sprintf "D"
1861 | _ -> Printf.sprintf "I"
1863 ("", "sr", (match c.client_sui_verified with
1864 | None -> "N"
1865 | Some b -> if b then "P" else "F"
1866 ));
1867 ("", "sr", ip_string);
1868 ] @ (if Geoip.active () then [(cn, "sr", CommonPictures.flag_html cc)] else []) @ [
1869 ("", "sr ar", (size_of_int64 c.client_total_uploaded));
1870 ("", "sr ar", (size_of_int64 c.client_total_downloaded));
1871 ("", "sr ar", (size_of_int64 c.client_session_uploaded));
1872 ("", "sr ar", (size_of_int64 c.client_session_downloaded));
1873 ("", "sr", info.GuiTypes.file_name) ]);
1875 Printf.bprintf buf "\\</tr\\>";
1876 true
1878 else false;
1881 with _ -> false;
1884 let _ =
1885 user_ops.op_user_set_friend <- (fun u ->
1886 let s = u.user_server in
1887 DonkeyUdp.add_user_friend s u
1890 let _ =
1891 shared_ops.op_shared_state <- (fun f o ->
1892 match file_state f with
1893 | FileShared ->
1894 (match file_shared (as_file f) with
1895 | None -> "no file_shared info"
1896 | Some f ->
1897 let pre_share1_dir =
1898 String2.replace (Filename2.dirname (as_shared_impl f).impl_shared_fullname) '\\' "/" in
1899 let pre_share2_dir =
1900 try
1901 String2.after pre_share1_dir
1902 (String2.search_from
1903 (Filename2.dirname (as_shared_impl f).impl_shared_fullname) 0 (Sys.getcwd ()) +
1904 String.length (Sys.getcwd ()))
1905 with Not_found -> pre_share1_dir
1907 let dir =
1908 if String2.check_prefix pre_share2_dir "/" then String2.after pre_share2_dir 1 else pre_share2_dir in
1909 if o.conn_output = HTML then
1910 Printf.sprintf "\\<a href=\\\"submit?q=debug_dir+%s\\\"\\>%s\\</a\\>" (Http_server.html_real_escaped dir) (Http_server.html_real_escaped dir)
1911 else Printf.sprintf "Shared in %s" dir)
1912 | state -> string_of_state state
1914 shared_ops.op_shared_unshare <- (fun file ->
1915 unshare_file file;
1916 (* Should we or not ??? *)
1917 if file_state file = FileShared then
1918 try Hashtbl.remove files_by_md4 file.file_md4 with _ -> ();
1920 shared_ops.op_shared_info <- (fun file ->
1921 let module T = GuiTypes in
1922 match file.file_shared with
1923 None -> assert false
1924 | Some impl ->
1925 { (impl_shared_info impl) with
1926 T.shared_network = network.network_num;
1927 T.shared_filename = file_best_name file;
1928 T.shared_uids = [Uid.create (Ed2k file.file_md4)];
1931 pre_shared_ops.op_shared_info <- (fun s ->
1932 let module T = GuiTypes in
1933 let impl = s.shared_shared in
1934 { (impl_shared_info impl) with
1935 T.shared_network = network.network_num }
1938 let _ =
1939 CommonWeb.add_web_kind "server.met" "List of donkey servers"
1940 (fun url filename ->
1941 if !!enable_donkey && !!update_server_list_server_met then
1942 begin
1943 lprintf_nl "server.met loaded from %s" url;
1944 let s = unpack_server_met filename url in
1945 let nservers = List.length (Hashtbl2.to_list servers_by_key) in
1946 let n = load_server_met s in
1947 if s <> filename then Sys.remove s;
1948 lprintf_nl "%d servers found, %d new ones inserted"
1949 n ((List.length (Hashtbl2.to_list servers_by_key)) - nservers)
1951 else
1952 if not !!enable_donkey then
1953 lprintf_nl "eDonkey module is disabled, ignoring..."
1954 else
1955 lprintf_nl "ED2K-update_server_list_server_met is disabled, ignoring..."
1958 file_ops.op_file_proposed_filenames <- op_file_proposed_filenames;
1959 network.op_network_add_server <- (fun ip port ->
1960 let s = DonkeyComplexOptions.force_add_server (Ip.ip_of_addr ip) port in
1961 as_server s.server_server