CryptoPP: drop unnecessary caml/config.h include, fix #86
[mldonkey.git] / src / daemon / driver / driverInteractive.ml
blob28774198daa05576d687013efd8be258f689c8df
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 Md4
22 open Printf2
23 open CommonClient
24 open CommonShared
25 open CommonServer
26 open CommonResult
27 open CommonFile
28 open CommonComplexOptions
29 open CommonInteractive
30 open GuiTypes
31 open CommonNetwork
32 open Options
33 open BasicSocket
34 open CommonTypes
35 open CommonGlobals
36 open CommonOptions
37 open CommonUserDb
38 open Int64ops
40 module VB = VerificationBitmap
42 let log_prefix = "[dIve]"
44 let lprintf_nl fmt =
45 lprintf_nl2 log_prefix fmt
47 let lprintf_n fmt =
48 lprintf2 log_prefix fmt
50 let verify_user_admin () =
51 let warning =
52 "SECURITY WARNING: user admin has an empty password, use command: useradd admin password\n"
54 if has_empty_password (admin_user ()) && !!allowed_ips <>
55 [(Ip.range_of_string (strings_of_option allowed_ips).option_default)] then
56 begin
57 lprintf_n "%s" warning;
58 warning
59 end
60 else ""
62 let check_supported_os () =
63 let uname = Unix32.uname () in
64 let message = Printf.sprintf "MLDonkey is not able to run faultless under %s" uname; in
65 if uname <> "" && not (Unix32.os_supported ()) then begin
66 lprintf_nl "%s" message;
67 message;
68 end
69 else ""
71 let dns_works = ref false
73 let real_startup_message () =
74 let s =
75 !startup_message ^ (verify_user_admin ()) ^ (check_supported_os ())
76 ^ (if not !dns_works then "DNS resolution does not work\n" else "")
77 ^ (if not !Charset.Locale.conversion_enabled then "Charset conversion does not work, disabled\n" else "")
78 ^ (match !created_new_base_directory with
79 None -> ""
80 | Some dir -> (Printf.sprintf "MLDonkey created a new home directory in %s\n" dir))
81 ^ (if not !allow_saving_ini_files then "Base directory is full, ini file saving disabled\n" else "")
82 ^ (if !all_temp_queued then "Temp directory is full, all downloads are queued\n" else "")
83 ^ (if !hdd_full_log_closed then "Logfile directory is full, logging redirected to RAM\n" else "")
84 ^ (if Autoconf.donkey = "yes" && not !!enable_servers && !!enable_donkey then
85 "You disabled option enable_servers, you will not be able to connect to ED2K servers\n"
86 else "")
88 if s = "" then None else Some s
90 let hdd_check () =
91 let dir_full dir mb =
92 match Unix32.diskfree dir with
93 | None -> false
94 | Some v when ((Unix32.filesystem dir = "NFS_SUPER_MAGIC") && v = zero) -> false
95 | Some v -> v < megabytes mb
98 if dir_full !!temp_directory !!hdd_temp_minfree then
99 if !!hdd_temp_stop_core then begin
100 send_dirfull_warning !!temp_directory true "MLDonkey shuts down";
101 CommonInteractive.clean_exit 0
103 else begin
104 send_dirfull_warning !!temp_directory true "MLDonkey queues all downloads";
105 all_temp_queued := true
107 else
108 begin
109 all_temp_queued := false;
111 ignore (Hashtbl.find last_sent_dir_warning !!temp_directory);
112 (try Hashtbl.remove last_sent_dir_warning !!temp_directory with Not_found -> ());
113 send_dirfull_warning !!temp_directory false "MLDonkey unqueues all downloads"
114 with Not_found -> ()
115 end;
117 let core_dir = Sys.getcwd () in
118 if dir_full core_dir !!hdd_coredir_minfree then
119 if !!hdd_coredir_stop_core then begin
120 send_dirfull_warning core_dir true "MLDonkey shuts down";
121 CommonInteractive.clean_exit 0
123 else
124 begin
125 allow_saving_ini_files := false;
126 send_dirfull_warning core_dir true "MLDonkey base directory partition full, stop saving ini files"
128 else
129 begin
130 allow_saving_ini_files := true;
132 ignore (Hashtbl.find last_sent_dir_warning core_dir);
133 (try Hashtbl.remove last_sent_dir_warning core_dir with Not_found -> ());
134 send_dirfull_warning core_dir false "MLDonkey base directory partition has enough free space again, saving ini files again"
135 with Not_found -> ()
136 end;
138 if !!log_file <> "" && (not (keep_console_output ())) then begin
139 let log_dir = Filename.dirname !!log_file in
140 if dir_full log_dir !!hdd_coredir_minfree then
141 begin
142 hdd_full_log_closed := true;
143 send_dirfull_warning log_dir true "MLDonkey logdirectory partition full, redirect log to RAM";
144 close_log ()
146 else
147 begin
148 if !hdd_full_log_closed then log_file =:= !!log_file;
149 hdd_full_log_closed := false;
151 ignore (Hashtbl.find last_sent_dir_warning log_dir);
152 (try Hashtbl.remove last_sent_dir_warning log_dir with Not_found -> ());
153 send_dirfull_warning log_dir false "MLDonkey logdirectory partition has enough free space again, re-enabling logging"
154 with Not_found -> ()
158 (* ripped from gui_downloads *)
160 let calc_file_eta f =
161 let size = Int64.to_float f.file_size in
162 let downloaded = Int64.to_float f.file_downloaded in
163 let missing = size -. downloaded in
164 let rate = f.file_download_rate in
165 let hundays = 1000.0 *. 60.0 *. 60.0 *. 24.0 in
166 match f.file_state with
167 FilePaused | FileQueued -> int_of_float (hundays +. 2.)
168 | _ -> (
169 if rate < 12. then int_of_float (hundays +. 1.) else
170 begin
171 let rate =
172 if rate < 0.0001
173 then
174 let time = BasicSocket.last_time () in
175 let age = time - f.file_age in
176 if age > 0
177 then downloaded /. (float_of_int age)
178 else 0.
179 else rate
181 let eta =
182 if rate < 11.
183 then hundays
184 else missing /. rate
186 int_of_float eta
191 let file_availability f =
192 match f.file_availability with
193 (_,avail) :: _ ->
194 (match f.file_chunks with
195 | None -> 0.
196 | Some chunks ->
197 let rec loop i p n =
198 if i < 0
199 then
200 if n < 0.0001
201 then 0.0
202 else (p /. n *. 100.0)
203 else
204 if partial_chunk (VB.get chunks i)
205 then
206 if avail.[i] <> (char_of_int 0)
207 then loop (i - 1) (p +. 1.0) (n +. 1.0)
208 else loop (i - 1) p (n +. 1.0)
209 else loop (i - 1) p n
211 loop ((String.length avail) - 1) 0.0 0.0)
212 | _ -> 0.0
214 let string_availability s =
215 match s with
216 (_,s) :: _ ->
218 let len = String.length s in
219 let p = ref 0 in
220 for i = 0 to len - 1 do
221 if int_of_char s.[i] <> 0 then begin
222 incr p
224 done;
225 if len = 0 then 0.0 else
226 (float_of_int !p /. float_of_int len *. 100.)
227 | _ -> 0.0
229 let get_file_availability f =
230 if !!html_mods_use_relative_availability
231 then file_availability f
232 else string_availability f.file_availability
234 let number_of_comments f =
235 List.length f.file_comments
237 (* WARNING: these computations are much more expensive as they seem.
238 We use the ShortLazy to avoid recomputing the result too many times,
239 in particular when sorting the files depending on their number of sources...
241 2004/06/18: file.file_all_sources is used when not zero, and in this case,
242 also file.file_active_sources.
245 let number_of_sources gf =
246 List.length (file_all_sources (file_find gf.file_num))
248 let number_of_sources gf =
249 if gf.file_all_sources > 0 then
250 gf.file_all_sources
251 else
252 ShortLazy.compute ("number_of_sources", gf.file_num, 0)
253 number_of_sources gf
255 let number_of_active_sources gf =
256 let nasrcs = ref 0 in
257 List.iter (fun fsrc ->
258 match (client_state fsrc) with
259 Connected_downloading _ -> incr nasrcs
260 | _ -> ()
261 ) (file_active_sources (file_find gf.file_num));
262 !nasrcs
264 let number_of_active_sources gf =
265 if gf.file_all_sources > 0 then
266 gf.file_active_sources
267 else begin
268 ShortLazy.compute ("number_of_active_sources", gf.file_num, 0)
269 number_of_active_sources gf
272 let net_name gf =
273 let n = network_find_by_num gf.file_network in
274 n.network_name
276 let short_net_name gf =
277 let nn = net_name gf in
278 match nn with
279 | "OpenNapster" -> "N"
280 | "Direct Connect" -> "C"
281 | "FileTP" -> "T"
282 | _ -> String.sub nn 0 1
285 module Html = struct
286 let begin_td buf = Printf.bprintf buf "\\<td\\>"
287 let begin_td_option buf option= Printf.bprintf buf "\\<td %s\\>" option
288 let end_td buf = Printf.bprintf buf "\\</td\\>"
289 let begin_table buf = Printf.bprintf buf "\\<table\\>"
290 let begin_table_option buf option = Printf.bprintf buf "\\<table %s\\>" option
291 let end_table buf = Printf.bprintf buf "\\</table\\>"
292 let begin_tr buf = Printf.bprintf buf "\\<tr\\>"
293 let end_tr buf = Printf.bprintf buf "\\</tr\\>"
295 let button buf value onclick =
296 Printf.bprintf buf "
297 \\<input type=\\\"button\\\" value=\\\"%s\\\" onclick=\\\"%s\\\"\\>"
298 value onclick
301 let initialization_completed = ref false
303 let save_config () =
304 (try Unix32.flush () with e ->
305 Printf2.lprintf "Exception %s while flushing\n" (Printexc2.to_string e)
307 if !initialization_completed then (
308 if !allow_saving_ini_files then begin
309 Options.save_with_help downloads_ini;
310 Options.save_with_help_private users_ini;
311 CommonComplexOptions.save ();
312 CommonUploads.save ();
313 CommonStats.save ();
314 networks_iter_all (fun r ->
315 List.iter (fun opfile ->
316 Options.save_with_help opfile
317 ) r.network_config_file);
319 ) else (
320 Printf2.lprintf "Initialization not completed, bypassing state saving\n"
324 let age_to_day date =
325 (last_time () - date) / Date.day_in_secs
328 let percent file =
329 let downloaded = Int64.to_float file.file_downloaded in
330 let size = Int64.to_float file.file_size in
331 if size < 1.0
332 then 0.0
333 else (downloaded *. 100.) /. size
335 let short_name file =
336 shorten file.file_name !!max_name_len
338 type table_align =
339 Align_Left
340 | Align_Right
341 | Align_Center
343 let col_sep = " "
344 let add buf s align max_len =
345 let slen = try Charset.utf8_length s with e -> String.length s in
346 let diff = max_len - slen in
347 match align with
348 Align_Center ->
349 let left = diff / 2 in
350 let right = diff - left in
351 Printf.bprintf buf "%s%s%s"
352 (String.make left ' ') s (String.make right ' ')
353 | Align_Right ->
354 Printf.bprintf buf "%s%s" (String.make diff ' ') s
355 | Align_Left ->
356 Printf.bprintf buf "%s%s" s (String.make diff ' ')
358 let print_table_text buf alignments titles lines =
359 let max_cols = ref (max (Array.length titles) (Array.length alignments)) in
360 List.iter (fun line ->
361 let len = Array.length line in
362 if len > !max_cols then max_cols := len
363 ) lines;
364 let ncols = !max_cols in
365 let cols = Array.make ncols 0 in
366 List.iter (fun line ->
367 let len = Array.length line in
368 for i = 0 to len-1 do
369 let slen = try Charset.utf8_length line.(i) with e -> String.length line.(i) in
370 if cols.(i) < slen then cols.(i) <- slen
371 done;
372 ) (titles :: lines);
373 Array.iteri (fun i s ->
374 add buf s Align_Center cols.(i);
375 Buffer.add_string buf col_sep;
376 ) titles;
377 Buffer.add_char buf '\n';
378 let aligns = Array.make ncols Align_Center in
379 Array.iteri (fun i al -> aligns.(i) <- al) alignments;
380 List.iter (fun line ->
381 let len = Array.length line in
382 Array.iteri (fun i s ->
383 add buf s aligns.(i) cols.(i);
384 if i+1 < len then Buffer.add_string buf col_sep;
385 ) line;
386 Buffer.add_char buf '\n';
387 ) lines
390 let print_table_html_mods buf lines =
392 html_mods_cntr_init ();
394 List.iter (fun line ->
395 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ());
396 Array.iter (fun data ->
397 Printf.bprintf buf "%s" data;
398 ) line;
399 Html.end_tr buf;
400 ) lines;
401 Html.end_table buf;
402 Html.end_td buf;
403 Html.end_tr buf;
404 Html.end_table buf;
405 Printf.bprintf buf "\\</div\\>"
409 let print_table_html spacing buf aligns titles lines =
410 Html.begin_table buf;
412 Html.begin_tr buf;
413 Array.iter (fun title ->
414 Printf.bprintf buf "\\<td align=center\\>%s\\</td\\>" title;
415 Printf.bprintf buf "\\<td width=%d\\> \\</td\\>" spacing;
416 ) titles;
417 let naligns = Array.length aligns in
418 Html.end_tr buf;
420 List.iter (fun line ->
421 Html.begin_tr buf;
422 Array.iteri (fun i title ->
423 Printf.bprintf buf "\\<td%s nowrap\\>%s\\</td\\>"
424 (if i >= naligns then "" else
425 match aligns.(i) with
426 Align_Center -> " align=center"
427 | Align_Left -> " align=left"
428 | Align_Right -> " align=right")
429 title;
430 Printf.bprintf buf "\\<td width=%d\\> \\</td\\>" spacing;
431 ) line;
432 Html.end_tr buf;
433 ) lines;
434 Html.end_table buf
437 let downloading file =
438 match file.file_state with
439 | FileDownloading | FileQueued -> true
440 | _ -> false
442 let stalled file =
443 match file.file_state with
444 | FilePaused | FileQueued -> true
445 | _ -> false
448 let print_file_html_form buf files =
451 Printf.bprintf buf "
452 \\<script language=JavaScript\\>\\<!--
453 function pauseAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.name==\\\"pause\\\") {j.checked=x;}}}
454 function resumeAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.name==\\\"resume\\\") {j.checked=x;}}}
455 function cancelAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.name==\\\"cancel\\\") {j.checked=x;}}}
456 function clearAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.type==\\\"checkbox\\\") {j.checked=x;}}}//--\\>\\</script\\>
459 Printf.bprintf buf "\\<form name=selectForm action=\\\"files\\\"\\>";
462 Html.begin_table_option buf "width=100%";
464 Html.begin_td_option buf "width=50%";
465 Printf.bprintf buf "\\<input type=submit value='Submit changes'\\>";
466 Html.end_td buf;
468 Html.begin_td_option buf "width=50%";
469 Html.end_td buf;
471 Html.begin_td buf;
472 Html.button buf "Pause all" "pauseAll(true);";
473 Html.end_td buf;
475 Html.begin_td buf;
476 Html.button buf "Resume all" "resumeAll(true);";
477 Html.end_td buf;
479 Html.begin_td buf;
480 Html.button buf "Cancel all" "cancelAll(true);";
481 Html.end_td buf;
483 Html.begin_td buf;
484 Html.button buf "Clear all" "clearAll(false);";
485 Html.end_td buf;
487 Html.end_table buf;
489 print_table_html 10 buf
490 [| Align_Left; Align_Left; Align_Left; Align_Right; Align_Right; Align_Right; Align_Right; Align_Right|]
492 "[ Num ]";
493 "P/R/C";
494 "\\<input type=radio value=File name=sortby\\> File";
495 "\\<input type=radio value=Percent name=sortby\\> Percent";
496 "\\<input type=radio value=Downloaded name=sortby\\> Downloaded";
497 "\\<input type=radio value=Size name=sortby\\> Size";
498 "Old";
499 "\\<input type=radio value=Rate name=sortby\\> Rate";
500 "\\<input type=radio value=Priority name=sortby\\> Priority";
502 (List.map (fun file ->
504 (Printf.sprintf "[\\<a href=\\\"submit\\?q\\=vd+%d\\\"\\>%-5d\\</a\\> %s]"
505 file.file_num
506 file.file_num
507 (net_name file)
510 (if downloading file then
511 Printf.sprintf
512 "\\<input name=pause type=checkbox value=%d\\> R
513 \\<input name=cancel type=checkbox value=%d\\>"
514 file.file_num
515 file.file_num
516 else
517 Printf.sprintf
519 \\<input name=resume type=checkbox value=%d\\>
520 \\<input name=cancel type=checkbox value=%d\\>"
521 file.file_num
522 file.file_num);
524 ( let size = Int64.to_float file.file_size in
525 let downloaded = Int64.to_float file.file_downloaded in
526 let size = if size < 1. then 1. else size in
527 Printf.sprintf "%s \\<br\\>
528 \\<table cellpadding=0 cellspacing=0 width=100%%\\>\\<tr\\>
529 \\<td class=\\\"loaded\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\>
530 \\<td class=\\\"remain\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\>
531 \\</tr\\>\\</table\\>"
532 (short_name file)
533 (!!html_vd_barheight)
534 (truncate (downloaded /. size *. 100.))
535 (!!html_vd_barheight)
536 (truncate ( (1. -. downloaded /. size) *. 100.))
539 (Printf.sprintf "%5.1f" (percent file));
540 (Int64.to_string file.file_downloaded);
541 (Int64.to_string file.file_size);
542 (Printf.sprintf "%d:%s"
543 (age_to_day file.file_age)
545 let len = Array.length file.file_chunks_age in
546 if len = 0 then "-" else
547 let min = ref (last_time ()) in
548 for i = 0 to len - 1 do
549 if file.file_chunks_age.(i) < !min then
550 min := file.file_chunks_age.(i)
551 done;
552 if !min = 0 then "-" else
553 string_of_int (age_to_day !min)));
555 (match file.file_state with
556 | FileQueued -> "Queued"
557 | FilePaused -> "Paused"
558 | FileAborted s -> Printf.sprintf "Aborted %s" s
559 | _ ->
560 if file.file_download_rate < 10.24 then
562 else
563 Printf.sprintf "%5.1f" (file.file_download_rate /. 1024.));
564 (Printf.sprintf "%3d" file.file_priority);
566 ) files);
567 Printf.bprintf buf "\\</form\\>"
570 let print_file_html_mods buf guifiles =
572 if (List.length guifiles) > 0 then begin
573 let tsize = ref Int64.zero in
574 let tdl = ref Int64.zero in
575 let trate = ref 0.0 in
576 let qsize = ref Int64.zero in
577 let qdl = ref Int64.zero in
578 let qnum = ref 0 in
580 List.iter (fun file ->
581 tsize := !tsize ++ file.file_size;
582 tdl := !tdl ++ file.file_downloaded;
583 trate := !trate +. file.file_download_rate;
585 if file.file_state = FileQueued then begin
586 qsize := !qsize ++ file.file_size;
587 qdl := !qdl ++ file.file_downloaded;
588 incr qnum;
589 end;
591 ) guifiles;
593 Printf.bprintf buf "\\</pre\\>
594 \\<script language=JavaScript\\>\\<!--
595 function pauseAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.name==\\\"pause\\\") {j.checked=x;}}}
596 function resumeAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.name==\\\"resume\\\") {j.checked=x;}}}
597 function cancelAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.name==\\\"cancel\\\") {j.checked=x;}}}
598 function clearAll(x){for(i=0;i\\<document.selectForm.elements.length;i++){var j=document.selectForm.elements[i];if (j.type==\\\"checkbox\\\") {j.checked=x;}}}
599 function submitPriority(num,cp,sel) {
600 // 2 line workaround for mozilla mouseout bug:
601 var row = sel.parentNode.parentNode.parentNode;
602 row.className=mOvrClass;
603 var divID = document.getElementById(\\\"divSelectPriority\\\" + num);
604 var selectID = document.getElementById(\\\"selectPriority\\\" + num);
605 var params='';
606 if (selectID.value.length \\> 0) {params = '+'+selectID.value+'+'+num;}
607 var np = selectID.value;
608 if (np.charAt(0) == \\\"=\\\") {var p = parseInt(np.substring(1,99));}
609 else {var p = parseInt(cp) + parseInt(selectID.value);}
610 var str='\\<select id=\\\"selectPriority' + num + '\\\" style=\\\"font-size: 8px; font-family: verdana\\\" onchange=\\\"javascript:submitPriority(' + num + ',' + p + ',this)\\\"\\>';
611 if (p != 20 \\&\\& p != 10 \\&\\& p != 0 \\&\\& p != -10 \\&\\& p != -20) { str += '\\<OPTION value=\\\"=' + p + '\\\" SELECTED\\>' + p; }
612 str += '\\<option value=\\\"=20\\\"'; if (p==20) {str += \\\" SELECTED\\\"}; str += '\\>Very High';
613 str += '\\<option value=\\\"=10\\\"'; if (p==10) {str += \\\" SELECTED\\\"}; str += '\\>High';
614 str += '\\<option value=\\\"=0\\\"'; if (p==0) {str += \\\" SELECTED\\\"}; str += '\\>Normal';
615 str += '\\<option value=\\\"=-10\\\"'; if (p==-10) {str += \\\" SELECTED\\\"}; str += '\\>Low';
616 str += '\\<option value=\\\"=-20\\\"'; if (p==-20) {str += \\\" SELECTED\\\"}; str += '\\>Very Low';
617 str += '\\<option value=\\\"10\\\"\\>+10';
618 str += '\\<option value=\\\"5\\\"\\>+5';
619 str += '\\<option value=\\\"1\\\"\\>+1';
620 str += '\\<option value=\\\"-1\\\"\\>-1';
621 str += '\\<option value=\\\"-10\\\"\\>-10';
622 str += \\\"\\</select\\>\\\";
623 divID.innerHTML = str;
624 parent.fstatus.location.href='submit?q=priority' + params;
626 //--\\>\\</script\\>
628 \\<div class=main\\>";
630 if !!html_mods_use_js_tooltips then Printf.bprintf buf
631 "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:
632 -100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\&nbsp;\\</div\\>";
634 Printf.bprintf buf "\\<form id=\\\"selectForm\\\" name=\\\"selectForm\\\" action=\\\"files\\\"\\>
635 \\<table class=main cellspacing=0 cellpadding=0\\>
637 \\<tr\\>\\<td\\>
639 \\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\>
640 \\<td %s class=downloaded width=100%%\\>Total(%d): %s/%s @ %.1f KB/s\\</td\\>%s
642 \\<td class=big\\>\\<input class=bigbutton type=\\\"button\\\" value=\\\"Pause all\\\" onclick=\\\"pauseAll(true);\\\"\\>\\</td\\>
643 \\<td class=big\\>\\<input class=bigbutton type=\\\"button\\\" value=\\\"Resume all\\\" onclick=\\\"resumeAll(true);\\\"\\>\\</td\\>
644 \\<td class=big\\>\\<input class=bigbutton type=\\\"button\\\" value=\\\"Clear all\\\" onclick=\\\"clearAll(false);\\\"\\>\\</td\\>
645 \\<td class=\\\"big pr\\\"\\>\\<input class=bigbutton type=submit value='Submit changes'\\>\\</td\\>
646 \\</tr\\>\\</table\\>
648 \\</td\\>\\</tr\\>
649 \\<tr\\>\\<td\\>
651 \\<table width=\\\"100%%\\\" class=\\\"downloaders\\\" cellspacing=0 cellpadding=0\\>\\<tr\\>
653 \\<td title=\\\"Pause\\\" class=\\\"dlheader np\\\"\\>P\\</td\\>
654 \\<td title=\\\"Resume\\\" class=\\\"dlheader np\\\"\\>R\\</td\\>
655 \\<td title=\\\"Cancel\\\" class=\\\"dlheader brs\\\"\\>C\\</td\\>
656 \\<td title=\\\"Click to switch release status\\\" class=\\\"dlheader brs\\\"\\>R\\</td\\>"
657 (if !qnum > 0 then begin
658 Printf.sprintf "title=\\\"Active(%d): %s/%s | Queued(%d): %s/%s\\\""
659 (List.length guifiles - !qnum) (size_of_int64 (!tdl -- !qdl)) (size_of_int64 (!tsize -- !qsize))
660 !qnum (size_of_int64 !qdl) (size_of_int64 !qsize);
662 else "")
663 (List.length guifiles) (size_of_int64 !tdl) (size_of_int64 !tsize) (!trate /. 1024.)
664 (let unread = ref 0 in
665 Fifo.iter (fun (t,i,num,n,s) -> if t > !last_message_log then incr unread) chat_message_fifo;
666 if !unread > 0 then Printf.sprintf "\\<td onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\" class=downloaded title=\\\"%d unread messages\\\"\\>\\<a onClick=\\\"mSub('fstatus','version');mSub('output','message')\\\"\\>(+%d)\\</a\\>\\&nbsp;\\</td\\>" !unread !unread else "");
668 if !!html_mods_vd_network then Printf.bprintf buf
669 "\\<td title=\\\"Sort by network\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=N name=sortby\\>\\</td\\>";
671 Printf.bprintf buf
672 "\\<td title=\\\"Sort by filename\\\" class=dlheader\\>\\<input class=headbutton type=submit value=File name=sortby\\>\\</td\\>";
674 if !!html_mods_vd_user then Printf.bprintf buf
675 "\\<td title=\\\"Sort by user\\\" class=dlheader\\>\\<input class=headbutton type=submit value=User name=sortby\\>\\</td\\>";
677 if !!html_mods_vd_group then Printf.bprintf buf
678 "\\<td title=\\\"Sort by group\\\" class=dlheader\\>\\<input class=headbutton type=submit value=Group name=sortby\\>\\</td\\>";
680 Printf.bprintf buf
681 "\\<td title=\\\"Sort by size\\\" class=dlheader\\>\\<input class=headbutton type=submit value=Size name=sortby\\>\\</td\\>
682 \\<td title=\\\"Sort by size downloaded\\\" class=dlheader\\>\\<input class=\\\"headbutton ar\\\" type=submit value=DLed name=sortby\\>\\</td\\>
683 \\<td title=\\\"Sort by percent\\\" class=dlheader\\>\\<input class=headbutton type=submit value=%% name=sortby\\>\\</td\\>";
684 if !!html_mods_vd_comments then Printf.bprintf buf
685 "\\<td title=\\\"Sort by comments\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Cm name=sortby\\>\\</td\\>";
687 Printf.bprintf buf
688 "\\<td title=\\\"Sort by number of sources\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Srcs name=sortby\\>\\</td\\>";
690 if !!html_mods_vd_active_sources then Printf.bprintf buf
691 "\\<td title=\\\"Sort by number of active sources\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=A name=sortby\\>\\</td\\>";
693 Printf.bprintf buf
694 "\\<td title=\\\"Sort by file availability percentage (using %s availability)\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Avail name=sortby\\>\\</td\\>"
695 (if !!html_mods_use_relative_availability then "Relative" else "Total");
697 if !!html_mods_vd_age then Printf.bprintf buf
698 "\\<td title=\\\"Sort by age of download\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Age name=sortby\\>\\</td\\>";
700 if !!html_mods_vd_last then Printf.bprintf buf
701 "\\<td title=\\\"Sort by last seen complete\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Last name=sortby\\>\\</td\\>";
703 Printf.bprintf buf
704 "\\<td title=\\\"Sort by rate\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Rate name=sortby\\>\\</td\\>
705 \\<td title=\\\"Sort by estimated time of arrival\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=ETA name=sortby\\>\\</td\\>";
707 if !!html_mods_vd_prio then Printf.bprintf buf "\\<td title=\\\"Sort by priority\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Priority name=sortby\\>\\</td\\>";
709 Printf.bprintf buf "\\</tr\\>";
711 let ctd fn td = Printf.sprintf "\\<td onClick=\\\"location.href='submit?q=vd+%d';return true;\\\" class=\\\"dl ar\\\"\\>%s\\</td\\>" fn td in
713 print_table_html_mods buf
714 (List.map (fun file ->
716 (if !!html_mods_use_js_tooltips then
717 Printf.sprintf "
718 onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%sFile#: %d<br>Network: %s<br>User%s %s%s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>"
719 (Http_server.html_real_escaped (Charset.Locale.to_utf8 file.file_name))
720 (match file_magic (file_find file.file_num) with
721 None -> ""
722 | Some magic -> "File type: " ^ (Http_server.html_real_escaped magic) ^ "<br>")
723 file.file_num
724 (net_name file)
725 (if file.file_group = "none" then "" else ":Group")
726 file.file_user
727 (if file.file_group = "none" then "" else Printf.sprintf ":%s" file.file_group)
729 (if file.file_comments = [] then "" else
730 begin
731 let num_comments = number_of_comments file in
732 let buf1 = Buffer.create (!!max_comment_length * num_comments) in
733 Printf.bprintf buf1 "<br><br>Comments(%d):<br>" (num_comments);
734 let comments =
735 if List.length file.file_comments > 5 then
736 fst (List2.cut 5 file.file_comments) @ [Ip.null, "", 0, (_s "MLDonkey note: click file for more comments")]
737 else
738 file.file_comments
740 List.iter (fun (_,_,_,s) -> Printf.bprintf buf1 "%s<br>" (Http_server.html_real_escaped (Charset.Locale.to_utf8 s))) comments;
741 Buffer.contents buf1
742 end)
744 !!html_mods_js_tooltips_wait
745 !!html_mods_js_tooltips_timeout
746 !!html_mods_js_tooltips_wait
747 else Printf.sprintf " onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>");
749 (if downloading file then
750 Printf.sprintf "\\<td class=\\\"dl al np\\\"\\>\\<input class=checkbox name=pause type=checkbox value=%d\\>\\</td\\>
751 \\<td class=\\\"dl al np\\\"\\>R\\</td\\>
752 \\<td class=\\\"dl al brs\\\"\\>\\<input class=checkbox name=cancel type=checkbox value=%d\\>\\</td\\>"
753 file.file_num
754 file.file_num
755 else
756 Printf.sprintf "\\<td class=\\\"dl al np\\\"\\>P\\</td\\>
757 \\<td class=\\\"dl al np\\\"\\>\\<input class=checkbox name=resume type=checkbox value=%d\\>\\</td\\>
758 \\<td class=\\\"dl al brs\\\"\\>\\<input class=checkbox name=cancel type=checkbox value=%d\\>\\</td\\>"
759 file.file_num
760 file.file_num);
762 Printf.sprintf "\\<td onClick=\\\"location.href='files?%s=%d';return true;\\\" class=\\\"dl al brs\\\"\\>\\%s\\</td\\>"
763 (if file.file_release then "norelease" else "release")
764 file.file_num (if file.file_release then "R" else "-");
766 (if !!html_mods_vd_network then
767 Printf.sprintf "\\<td onClick=\\\"location.href='submit?q=vd+%d';return true;\\\"
768 title=\\\"%s\\\" class=\\\"dl al\\\"\\>%s\\</td\\>"
769 file.file_num (net_name file) (short_net_name file) else "");
771 ( let size = Int64.to_float file.file_size in
772 let downloaded = Int64.to_float file.file_downloaded in
773 let size = if size < 1. then 1. else size in
774 (if !!html_mods_use_js_tooltips then
775 Printf.sprintf "\\<TD onClick=\\\"location.href='submit?q=vd+%d';return true;\\\"
776 class=\\\"dl al\\\"\\>%s\\<br\\>
777 \\<table cellpadding=0 cellspacing=0 width=100%%\\>\\<tr\\>
778 \\<td class=\\\"loaded\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\>
779 \\<td class=\\\"remain\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\>
780 \\</tr\\>\\</table\\>\\</td\\>"
781 file.file_num
782 (short_name file)
783 (!!html_vd_barheight)
784 (truncate (downloaded /. size *. 100.))
785 (!!html_vd_barheight)
786 (truncate ( (1. -. downloaded /. size) *. 100.))
787 else
788 Printf.sprintf "\\<TD onClick=\\\"location.href='submit?q=vd+%d';return true;\\\"
789 title=\\\"[File#: %d] [Net: %s] [Comments: %d]%s\\\" class=\\\"dl al\\\"\\>%s\\<br\\>
790 \\<table cellpadding=0 cellspacing=0 width=100%%\\>\\<tr\\>
791 \\<td class=\\\"loaded\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\>
792 \\<td class=\\\"remain\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\>
793 \\</tr\\>\\</table\\>\\</td\\>"
794 file.file_num
795 file.file_num
796 (net_name file) (number_of_comments file)
797 (if !!max_name_len < String.length file.file_name then " " ^ file.file_name else "")
798 (short_name file)
799 (!!html_vd_barheight)
800 (truncate (downloaded /. size *. 100.))
801 (!!html_vd_barheight)
802 (truncate ( (1. -. downloaded /. size) *. 100.)));
805 (if !!html_mods_vd_user then ctd file.file_num file.file_user else "");
806 (if !!html_mods_vd_group then ctd file.file_num file.file_group else "");
808 (ctd file.file_num (size_of_int64 file.file_size));
809 (ctd file.file_num (size_of_int64 file.file_downloaded));
810 (ctd file.file_num (Printf.sprintf "%.1f" (percent file)));
812 (if !!html_mods_vd_comments then
813 ctd file.file_num (Printf.sprintf "%d" (number_of_comments file))
814 else "");
816 (ctd file.file_num (Printf.sprintf "%d" (number_of_sources file)));
818 (if !!html_mods_vd_active_sources then
819 ctd file.file_num (Printf.sprintf "%d" (number_of_active_sources file))
820 else "");
822 (ctd file.file_num (Printf.sprintf "%.0f" (get_file_availability file)));
825 (if !!html_mods_vd_age then
826 ctd file.file_num (let age = (BasicSocket.last_time ()) - file.file_age in Date.time_to_string age "long")
827 else "");
829 (if !!html_mods_vd_last then
830 ctd file.file_num (if file.file_last_seen > 0
831 then let last = (BasicSocket.last_time ()) - file.file_last_seen in
832 Date.time_to_string last "long"
833 else "-"
835 else ""
838 (ctd file.file_num
839 (match file.file_state with
840 FilePaused -> "Paused"
841 | FileQueued -> "Queued"
842 | _ -> if file.file_download_rate < 10.24 then "-"
843 else Printf.sprintf "%5.1f" (file.file_download_rate /. 1024.)
847 (ctd file.file_num (if (file.file_download_rate < 10.24 || stalled file) then "-"
848 else Date.time_to_string (calc_file_eta file) "long"));
850 (if !!html_mods_vd_prio then
851 (Printf.sprintf "\\<td class=\\\"dl ar\\\"\\>\\<div id=\\\"divSelectPriority%d\\\"\\>\\<select id=\\\"selectPriority%d\\\"
852 style=\\\"font-size: 8px; font-family: verdana\\\" onchange=\\\"javascript:submitPriority(%d,%d,this)\\\"\\>\n"
853 file.file_num file.file_num file.file_num file.file_priority)
854 ^ (match file.file_priority with 0 | -10 | 10 | -20 | 20 -> "" | _ ->
855 Printf.sprintf "\\<option value=\\\"=%d\\\" SELECTED\\>%d\n" file.file_priority file.file_priority)
856 ^ "\\<option value=\\\"=20\\\"" ^ (if file.file_priority = 20 then " SELECTED" else "") ^ "\\>Very high\n"
857 ^ "\\<option value=\\\"=10\\\"" ^ (if file.file_priority = 10 then " SELECTED" else "") ^ "\\>High\n"
858 ^ "\\<option value=\\\"=0\\\"" ^ (if file.file_priority = 0 then " SELECTED" else "") ^ "\\>Normal\n"
859 ^ "\\<option value=\\\"=-10\\\"" ^ (if file.file_priority = -10 then " SELECTED" else "") ^ "\\>Low\n"
860 ^ "\\<option value=\\\"=-20\\\"" ^ (if file.file_priority = -20 then " SELECTED" else "") ^ "\\>Very Low\n"
861 ^ "\\<option value=\\\"10\\\"\\>+10\n"
862 ^ "\\<option value=\\\"5\\\"\\>+5\n"
863 ^ "\\<option value=\\\"1\\\"\\>+1\n"
864 ^ "\\<option value=\\\"-1\\\"\\>-1\n"
865 ^ "\\<option value=\\\"-5\\\"\\>-5\n"
866 ^ "\\<option value=\\\"-10\\\"\\>-10\n"
867 ^ "\\</select\\>\\</div\\>"
868 else "");
871 ) guifiles);
873 Printf.bprintf buf "\\</form\\>"
876 else
877 html_mods_table_one_row buf "downloaderTable" "downloaders" [
878 ("", "srh", (Printf.sprintf (_b "!! No files, please use search or the dllink <url> command to add a new download !!"))); ]
880 let html_mods_done_files buf files =
882 Printf.bprintf buf "\\</pre\\>
883 \\<div class=\\\"main\\\"\\>
884 \\<table class=main cellspacing=0 cellpadding=0\\>
886 \\<tr\\>\\<td\\>
888 \\<form name=selectForm2 action=\\\"files\\\"\\>
889 \\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\>
890 \\<td class=downloaded width=100%%\\>Total: %d - Use '\\<a target=\\\"fstatus\\\" href=\\\"submit?q=commit\\\"\\>commit\\</a\\>' to move these completed files to the incoming directory\\</td\\>
891 \\</tr\\>\\</table\\>
893 \\</td\\>\\</tr\\>
894 \\<tr\\>\\<td\\>
896 \\<table class=downloaders cellspacing=0 cellpadding=0\\>\\<tr\\>
898 \\<td title=\\\"Number\\\" class=dlheader\\>Num\\</td\\>
899 \\<td title=\\\"Network\\\" class=dlheader\\>Network\\</td\\>
900 \\<td title=\\\"Sort by filename\\\" class=dlheader\\>\\<input class=headbutton type=submit value=File name=sortby\\>\\</td\\>
901 \\<td title=\\\"Sort by size\\\" class=dlheader\\>\\<input class=headbutton type=submit value=Size name=sortby\\>\\</td\\>
902 \\<td title=\\\"Hash\\\" class=dlheader\\>Hash\\</td\\>
904 \\</tr\\>
905 " (List.length files);
908 print_table_html_mods buf
910 (List.map (fun file ->
912 (Printf.sprintf "\\>\\<td class=dl\\>%d\\</td\\>\\<td class=dl\\>%s\\</td\\>"
913 file.file_num (net_name file));
914 (Printf.sprintf "\\<td class=dl\\>%s\\</td\\>"
915 (short_name file));
916 (Printf.sprintf "\\<td class=dl\\>%s\\</td\\>"
917 (Int64.to_string file.file_size));
918 (Printf.sprintf "\\<td class=dl\\>%s\\</td\\>"
919 (string_of_uids file.file_uids))
921 ) files);
922 Printf.bprintf buf "\\</form\\>"
924 let print_human_readable file size =
925 (if Int64.to_float size >= 1024. && Int64.to_float size < 1048576. then
926 (Printf.sprintf "%5.1f%s" (Int64.to_float size /. 1024.) ("kb") )
927 else if size >= Int64.of_float 1048576. && Int64.to_float size < 1073741824. then
928 (Printf.sprintf "%5.1f%s" (Int64.to_float size /. 1048576.) ("mb") )
929 else if size >= Int64.of_float 1073741824. then
930 (Printf.sprintf "%5.1f%s" (Int64.to_float size /. 1073741824.) ("gb") )
931 else if size < Int64.zero then
932 (Printf.sprintf "%d chunks"
933 (match file.file_chunks with
934 | None -> 0
935 | Some chunks ->
936 VB.fold_lefti (fun acc _ s -> match s with
937 | VB.State_missing | VB.State_partial -> acc
938 | VB.State_complete | VB.State_verified -> acc + 1
939 ) 0 chunks))
940 else (Printf.sprintf "%8s%s" (Int64.to_string size) ("b") ) )
942 let simple_print_file_list finished buf files format =
943 let print_table = if format.conn_output = HTML then print_table_html 2
944 else print_table_text in
945 if not finished then
946 if format.conn_output = HTML && !!html_checkbox_vd_file_list then
947 begin
948 if !!html_mods then print_file_html_mods buf files
949 else
950 print_file_html_form buf files
952 else
953 print_table buf
955 Align_Left; Align_Left; Align_Right; Align_Left; Align_Left; Align_Left;
956 Align_Right; Align_Right; Align_Right |]
957 (if format.conn_output = HTML then
959 "[ Num ]";
960 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=name\\\"\\> File \\</a\\>";
961 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=percent\\\"\\> Percent \\</a\\>";
962 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=done\\\"\\> Downloaded \\</a\\>";
963 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=size\\\"\\> Size \\</a\\>";
964 "Old";
965 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=rate\\\"\\> Rate \\</a\\>";
966 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=priority\\\"\\> Priority \\</a\\>";
967 |] else
969 "$nNum";
970 "Rele";
971 "Comm";
972 "User";
973 "Group";
974 "File";
975 " %";
976 " Done";
977 " Size";
978 "lSeen";
979 "Old";
980 " Active";
981 "Rate";
982 "Prio";
985 (List.map (fun file ->
986 let rate, color =
987 match file.file_state with
988 | FilePaused -> "Paused", "$r"
989 | FileQueued -> "Queued", "$g"
990 | FileAborted s -> Printf.sprintf "Aborted %s" s, "$r"
991 | _ ->
992 if file.file_download_rate < 10.24 then
993 "-", "$n"
994 else
995 Printf.sprintf "%4.1f" (
996 file.file_download_rate /. 1024.), "$c"
999 (Printf.sprintf "%0s[%0s]%0s"
1000 (if !!term_ansi then (color)
1001 else "")
1002 (if format.conn_output = HTML then
1003 (Printf.sprintf "\\<a href=\\\"submit\\?q\\=vd\\+%d\\\" $S\\>%0s%4d\\</a\\>"
1004 file.file_num
1005 (short_net_name file)
1006 file.file_num)
1007 else
1008 (Printf.sprintf "%0s%4d"
1009 (short_net_name file)
1010 file.file_num))
1011 (if format.conn_output = HTML then
1012 Printf.sprintf "[\\<a href=\\\"submit\\?q\\=cancel\\+%d\\\" $S\\>CANCEL\\</a\\>][\\<a href=\\\"submit\\?q\\=%s\\+%d\\\" $S\\>%s\\</a\\>] "
1013 file.file_num
1014 (if downloading file then "pause" else "resume" )
1015 file.file_num
1016 (if downloading file then "PAUSE" else "RESUME")
1017 else ""));
1018 (Printf.sprintf "%s" (if file.file_release then "R" else "-"));
1019 (Printf.sprintf "%4d" (number_of_comments file));
1020 file.file_user;
1021 file.file_group;
1022 (short_name file);
1023 (Printf.sprintf "%3.1f" (percent file));
1024 (if !!improved_telnet then (print_human_readable file file.file_downloaded)
1025 else (Int64.to_string file.file_downloaded) );
1026 (if !!improved_telnet then (print_human_readable file file.file_size)
1027 else (Int64.to_string file.file_size) );
1028 (Printf.sprintf "%s"
1029 (if file.file_last_seen > 0 then
1030 let last = (BasicSocket.last_time ()) - file.file_last_seen in
1031 Date.time_to_string last "long"
1032 else "-"
1034 (Printf.sprintf "%d:%s" (age_to_day file.file_age)
1036 let len = Array.length file.file_chunks_age in
1037 if len = 0 then "-" else
1038 let min = ref (last_time ()) in
1039 for i = 0 to len - 1 do
1040 if file.file_chunks_age.(i) < !min then
1041 min := file.file_chunks_age.(i)
1042 done;
1043 if !min = 0 then "-" else
1044 string_of_int (age_to_day !min)));
1045 (Printf.sprintf "%2d/%-4d" (number_of_active_sources file) (number_of_sources file));
1046 rate;
1047 (Printf.sprintf "%4d" (file.file_priority);)
1049 ) files)
1050 else
1051 if use_html_mods format then
1052 html_mods_done_files buf files
1053 else
1055 print_table buf
1056 [||]
1057 (if format.conn_output = HTML then
1059 "[ Num ]";
1060 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=name\\\"\\> File \\</a\\>";
1061 "\\<a href=\\\"submit\\?q\\=vd\\&sortby\\=size\\\"\\> Size \\</a\\>";
1062 "MD4";
1064 else
1066 "[ Num ]";
1067 "File";
1068 "Size";
1069 "MD4";
1072 (List.map (fun file ->
1074 (Printf.sprintf "[%s %-5d]"
1075 (net_name file)
1076 file.file_num);
1077 (short_name file);
1078 (Int64.to_string file.file_size);
1079 (Md4.to_string file.file_md4)
1081 ) files)
1083 let print_bw_stats buf =
1084 Printf.bprintf buf "Down: %.1f KB/s ( %d + %d ) | Up: %.1f KB/s ( %d + %d ) | Shared: %d/%s | Downloaded: %s | Uploaded: %s"
1085 (( (float_of_int !udp_download_rate) +. (float_of_int !control_download_rate)) /. 1024.0)
1086 !udp_download_rate
1087 !control_download_rate
1088 (( (float_of_int !udp_upload_rate) +. (float_of_int !control_upload_rate)) /. 1024.0)
1089 !udp_upload_rate
1090 !control_upload_rate
1091 !nshared_files
1092 (size_of_int64 !nshared_bytes)
1093 (size_of_int64 !download_counter)
1094 (size_of_int64 !upload_counter)
1096 let console_topic () =
1097 Printf.sprintf "(DL: %.1f | UL: %.1f) MLNet %s"
1098 (( (float_of_int !udp_download_rate) +. (float_of_int !control_download_rate)) /. 1024.0)
1099 (( (float_of_int !udp_upload_rate) +. (float_of_int !control_upload_rate)) /. 1024.0)
1100 Autoconf.current_version
1102 let display_active_file_list buf o list =
1103 display_vd := true;
1105 if not (use_html_mods o) then begin
1106 (* Printf.bprintf buf "Downloaded %d/%d files\n" (List.length !!done_files)
1107 (List.length !!files); *)
1108 print_bw_stats buf;
1109 Printf.bprintf buf "\n";
1110 end;
1112 if o.conn_output <> HTML && !!improved_telnet then
1113 begin
1114 let list =
1115 List.sort (fun f1 f2 -> compare (percent f2) (percent f1)) list in
1116 simple_print_file_list false buf list o
1118 else
1119 let list =
1121 let sorter =
1122 match o.conn_sortvd with
1124 | BySize -> (fun f1 f2 -> compare f2.file_size f1.file_size)
1125 | ByRate -> (fun f1 f2 ->
1126 if stalled f1 then 1 else
1127 if stalled f2 then -1 else
1128 compare f2.file_download_rate f1.file_download_rate)
1129 | ByName -> (fun f1 f2 -> String.compare
1130 (String.lowercase f1.file_name)
1131 (String.lowercase f2.file_name))
1132 | ByDone -> (fun f1 f2 ->
1133 compare f2.file_downloaded f1.file_downloaded)
1134 | ByPriority -> (fun f1 f2 ->
1135 compare f2.file_priority f1.file_priority)
1136 | BySources -> (fun f1 f2 -> compare
1137 (number_of_sources f2) (number_of_sources f1))
1138 | ByASources -> (fun f1 f2 ->
1139 compare (number_of_active_sources f2)
1140 (number_of_active_sources f1))
1141 | ByPercent -> (fun f1 f2 -> compare (percent f2) (percent f1))
1142 | ByETA -> (fun f1 f2 -> compare (calc_file_eta f1) (calc_file_eta f2))
1143 | ByAge -> (fun f1 f2 -> compare f2.file_age f1.file_age)
1144 | ByLast -> (fun f1 f2 -> compare f2.file_last_seen f1.file_last_seen)
1145 | ByNet -> (fun f1 f2 -> compare (net_name f1) (net_name f2))
1146 | ByAvail -> (fun f1 f2 -> compare
1147 (get_file_availability f2) (get_file_availability f1))
1148 | ByComments -> (fun f1 f2 -> compare
1149 (number_of_comments f2) (number_of_comments f1))
1150 | ByUser -> (fun f1 f2 -> compare f1.file_user f2.file_user)
1151 | ByGroup -> (fun f1 f2 -> compare f1.file_group f2.file_group)
1152 | NotSorted -> raise Not_found
1154 List.sort sorter list
1155 with _ -> list
1157 simple_print_file_list false buf list o
1159 let display_file_list buf o l =
1160 display_active_file_list buf o l;
1161 if not (use_html_mods o) then
1162 Printf.bprintf buf "%0sDownloaded %d files\n" (if !!term_ansi then "$n" else "") (List.length !!done_files);
1163 if !!done_files <> [] then begin
1164 (* List.iter (fun file -> CommonFile.file_print file o) !!done_files; *)
1165 simple_print_file_list true buf
1166 (List2.tail_map file_info !!done_files) o;
1167 if not (use_html_mods o) then
1168 if !!auto_commit then
1169 if o.conn_output = HTML then
1170 html_mods_table_one_row buf "searchTable" "search" [
1171 ("", "srh", "Files will be automatically committed in the incoming directory"); ]
1172 else
1173 Printf.bprintf buf
1174 "Files will be automatically committed in the incoming directory"
1175 else
1176 if o.conn_output = HTML then
1177 html_mods_table_one_row buf "searchTable" "search" [
1178 ("", "srh", "Use 'commit' to move downloaded files to the incoming directory"); ]
1179 else
1180 Printf.bprintf buf
1181 "Use 'commit' to move downloaded files to the incoming directory"
1185 let get_tag_value tag =
1186 match tag.tag_value with
1187 | Uint64 i -> String.escaped (Int64.to_string i)
1188 | Fint64 i -> String.escaped (Int64.to_string i)
1189 | Uint16 i | Uint8 i -> String.escaped (string_of_int i)
1190 | String s -> String.escaped s
1191 | Addr i -> Ip.to_string i
1192 | Pair (x,y) -> Printf.sprintf "%Ld, %Ld" x y
1194 let old_print_search buf o results =
1195 let user = o.conn_user in
1196 let counter = ref 0 in
1197 if use_html_mods o then
1198 begin
1199 html_mods_cntr_init ();
1200 if !!html_mods_use_js_tooltips then Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\&nbsp;\\</div\\>\n";
1201 html_mods_table_header_colspan buf "resultsTable" "results" [
1202 ( "1", "0", "srh", "Network", "Network" ) ;
1203 ( "1", "0", "srh", "File", "File (mouseover)" ) ;
1204 ( "1", "1", "srh ar", "Size", "Size" ) ;
1205 ( "1", "1", "srh ar", "Availability", "A" ) ;
1206 ( "1", "1", "srh ar", "Complete Sources", "C" ) ;
1207 ( "2", "0", "srh", "Hash (click for lookup)", "Hash check" ) ;
1208 ( "1", "1", "srh ar", "Length", "Len" ) ;
1209 ( "1", "1", "srh ar", "Codec", "Code" ) ;
1210 ( "1", "1", "srh ar", "Bitrate", "Rate" ) ;
1211 ( "1", "0", "srh", "Tags (mouseover)", "Tags" ) ] ;
1212 end;
1213 (try
1214 List.iter (fun (rs,r,avail) ->
1215 if !!display_downloaded_results || not r.result_done then begin
1216 incr counter;
1217 if !counter >= !!max_displayed_results then raise Exit;
1219 if use_html_mods o then
1220 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
1222 user.ui_last_results <- (!counter, rs) :: user.ui_last_results;
1223 let network_name =
1224 try
1225 let n = network_find_by_num r.result_source_network in
1226 n.network_name
1227 with _ -> "Unknown"
1230 if use_html_mods o
1231 then Printf.bprintf buf "\\<td class=\\\"sr\\\"\\>%s\\</td\\>"
1232 (let rec iter uids =
1233 match uids with
1234 [] -> network_name
1235 | uid :: tail ->
1236 match Uid.to_uid uid with
1237 Ed2k md4 ->
1238 Printf.sprintf "\\<a href=\\\"%s\\\"\\>%s\\</a\\>"
1239 (file_print_ed2k_link (List.hd r.result_names) r.result_size md4)
1240 network_name
1241 | _ -> iter tail
1243 iter r.result_uids)
1244 else Printf.bprintf buf "[%5d] %s " !counter network_name;
1246 if o.conn_output = HTML then begin
1247 if !!html_mods then
1248 if !!html_mods_use_js_tooltips then
1249 begin
1250 Printf.bprintf buf "\\<td onMouseOver=\\\"setTimeout('popLayer(\\\\\'";
1251 begin
1252 match r.result_names with
1253 [] -> ()
1254 | name :: names ->
1255 Printf.bprintf buf "%s" (Http_server.html_real_escaped name);
1256 List.iter (fun s ->
1257 if use_html_mods o then Printf.bprintf buf "\\<BR\\>";
1258 Printf.bprintf buf " %s" (Http_server.html_real_escaped s)
1259 ) names;
1260 if use_html_mods o then Printf.bprintf buf "\\<BR\\>";
1261 end;
1262 let nl = ref false in
1263 List.iter (fun t ->
1264 match t.tag_name with
1265 | Field_KNOWN "FTH" | Field_KNOWN "urn" -> ()
1266 | _ ->
1267 Buffer.add_string buf ((if !nl then "<br>" else begin nl := true;"" end) ^
1268 escaped_string_of_field t ^ ": " ^ get_tag_value t);
1269 ) r.result_tags;
1270 Printf.bprintf buf "\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"hideLayer();setTimeout('hideLayer()',%d);return true;\\\" class=\\\"sr\\\"\\>\\<a href=results\\?d=%d target=\\\"$S\\\"\\>"
1271 !!html_mods_js_tooltips_wait
1272 !!html_mods_js_tooltips_timeout
1273 !!html_mods_js_tooltips_wait
1274 r.result_num
1276 else begin
1277 Printf.bprintf buf "\\<td title=\\\"";
1278 let nl = ref false in
1279 List.iter (fun t ->
1280 match t.tag_name with
1281 | Field_KNOWN "FTH" | Field_KNOWN "urn" -> ()
1282 | _ ->
1283 Buffer.add_string buf ((if !nl then "\n" else begin nl := true;"" end) ^
1284 "|| (" ^
1285 escaped_string_of_field t ^ "): " ^ get_tag_value t);
1286 ) r.result_tags;
1288 Printf.bprintf buf "\\\" class=\\\"sr\\\"\\>\\<a href=results\\?d=%d target=\\\"$S\\\"\\>" r.result_num
1290 else Printf.bprintf buf "\\<a href=results\\?d=%d $S\\>" r.result_num;
1291 end;
1292 begin
1293 match r.result_names with
1294 [] -> ()
1295 | name :: names ->
1296 Printf.bprintf buf "%s\n" (shorten name !!max_result_name_len);
1297 List.iter (fun s ->
1298 if use_html_mods o then Printf.bprintf buf "\\<BR\\>";
1299 Printf.bprintf buf " %s\n" (shorten s !!max_result_name_len)
1300 ) names;
1301 end;
1302 if r.result_done then
1303 begin
1304 if use_html_mods o then Printf.bprintf buf "\\<BR\\>";
1305 Printf.bprintf buf " ALREADY DOWNLOADED\n "
1306 end;
1307 begin
1308 match r.result_comment with
1309 "" -> ()
1310 | comment -> begin
1311 if use_html_mods o then Printf.bprintf buf "\\<BR\\>";
1312 Printf.bprintf buf "COMMENT: %s\n" comment
1313 end;
1314 end;
1315 if o.conn_output = HTML then
1316 begin
1317 if !!html_mods then Printf.bprintf buf "\\</a\\>\\</td\\>"
1318 else Printf.bprintf buf "\\</a href\\>";
1319 end;
1320 let hash = ref (string_of_uids r.result_uids) in
1321 let real_hash =
1322 if String.contains !hash ':' then
1323 String.sub !hash ((String.rindex !hash ':')+1)
1324 ((String.length !hash) - (String.rindex !hash ':') - 1)
1325 else
1326 !hash
1328 let clength = ref "" in
1329 let ccodec = ref "" in
1330 let cmediacodec = ref "" in
1331 let cbitrate = ref "" in
1332 let cavail = ref (string_of_int avail) in
1333 let csource = ref "" in
1334 let cformat = ref "" in
1335 List.iter (fun t ->
1336 (match t.tag_name with
1337 | Field_KNOWN "urn"
1338 | Field_KNOWN "FTH" -> hash := get_tag_value t
1339 | Field_Availability -> cavail := get_tag_value t
1340 | Field_Completesources -> csource := get_tag_value t
1341 | Field_Length -> clength := get_tag_value t
1342 | Field_Codec -> ccodec := get_tag_value t
1343 | Field_Mediacodec -> cmediacodec := get_tag_value t
1344 | Field_Bitrate -> cbitrate := get_tag_value t
1345 | Field_Format -> cformat := get_tag_value t
1346 | _ -> ())) r.result_tags;
1348 if use_html_mods o then
1349 Printf.bprintf buf "\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
1350 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
1351 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
1352 \\<td class=\\\"sr\\\"\\>\\<a href=\\\"http://bitzi.com/lookup/ed2k:%s\\\"\\>BI\\</a\\>\\</td\\>
1353 \\<td class=\\\"sr\\\"\\>\\<a href=\\\"http://www.filedonkey.com/url/%s\\\"\\>FD\\</a\\>\\</td\\>
1354 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
1355 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
1356 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>"
1357 (size_of_int64 r.result_size)
1358 !cavail
1359 !csource
1360 real_hash
1361 real_hash
1362 !clength
1363 (if !ccodec = "" then
1364 begin
1365 if !cmediacodec = "" then
1366 !cformat
1367 else
1368 !cmediacodec
1370 else
1371 !ccodec)
1372 !cbitrate
1373 else Printf.bprintf buf " %10s %10s "
1374 (Int64.to_string r.result_size)
1375 (string_of_uids r.result_uids);
1377 if use_html_mods o then begin
1378 Printf.bprintf buf "\\<td class=\\\"sr\\\"\\>";
1379 List.iter (fun t ->
1380 (match t.tag_name with
1381 | Field_Completesources
1382 | Field_Availability
1383 | Field_Length
1384 | Field_Codec
1385 | Field_Mediacodec
1386 | Field_Format
1387 | Field_Bitrate
1388 (* TODO : "urn" shouldn't be some kind of Field_Uid of Gnutella ? *)
1389 | Field_KNOWN "urn"
1390 (* TODO : "FTH" shouldn't be some kind of Field_Uid of Fasttrack ? *)
1391 | Field_KNOWN "FTH" -> ()
1392 | _ ->
1393 Buffer.add_string buf ("\\<span title=\\\"" ^
1394 get_tag_value t ^ "\\\"\\>(" ^
1395 escaped_string_of_field t ^ ") \\</span\\>");
1397 ) r.result_tags;
1398 Printf.bprintf buf "\\</td\\>\\</tr\\>";
1400 else
1401 List.iter (fun t ->
1402 Buffer.add_string buf (Printf.sprintf "%-3s "
1403 (if t.tag_name = Field_Availability then !cavail else
1404 get_tag_value t))
1405 ) r.result_tags;
1406 Buffer.add_char buf '\n';
1408 ) results;
1409 if use_html_mods o then Printf.bprintf buf "\\</table\\>"
1410 with _ -> ())
1413 let add_filter_table buf search_num =
1415 Printf.bprintf buf "\\<form action=\\\"filter\\\"\\>";
1416 Printf.bprintf buf "\\<input type=hidden name=num value=%d\\>" search_num;
1418 Printf.bprintf buf "\\<table\\>";
1419 Printf.bprintf buf "\\<tr\\>";
1421 Printf.bprintf buf "\\<td\\>";
1422 Printf.bprintf buf "\\<input type=submit value='Filter Out'\\>";
1423 Printf.bprintf buf "\\</td\\>";
1425 Printf.bprintf buf "\\</tr\\>\\<tr\\>";
1427 Printf.bprintf buf "\\<td\\>\\<table\\>\\<tr\\>";
1429 Printf.bprintf buf "\\<table\\>";
1430 Printf.bprintf buf "\\<td\\> Media: \\</td\\>";
1431 Printf.bprintf buf "\\<td\\>\\<input name=media type=checkbox value=Audio\\> Audio \\</td\\>";
1432 Printf.bprintf buf "\\<td\\>\\<input name=media type=checkbox value=Video\\> Video \\</td\\>";
1433 Printf.bprintf buf "\\<td\\>\\<input name=media type=checkbox value=Pro\\> Pro \\</td\\>";
1434 Printf.bprintf buf "\\<td\\>\\<input name=media type=checkbox value=Doc\\> Doc \\</td\\>";
1435 Printf.bprintf buf "\\</table\\>";
1437 Printf.bprintf buf "\\</tr\\>\\<tr\\>";
1439 Printf.bprintf buf "\\<table\\>";
1440 Printf.bprintf buf "\\<td\\> Formats: \\</td\\>";
1441 Printf.bprintf buf "\\<td\\>\\<input name=format type=checkbox value=mp3\\> Mp3 \\</td\\>";
1442 Printf.bprintf buf "\\<td\\>\\<input name=format type=checkbox value=avi\\> Avi \\</td\\>";
1443 Printf.bprintf buf "\\<td\\>\\<input name=format type=checkbox value=zip\\> Zip \\</td\\>";
1444 Printf.bprintf buf "\\<td\\>\\<input name=format type=checkbox value=mpg\\> Mpg \\</td\\>";
1445 Printf.bprintf buf "\\</table\\>";
1447 Printf.bprintf buf "\\</tr\\>\\<tr\\>";
1449 Printf.bprintf buf "\\<table\\>";
1450 Printf.bprintf buf "\\<td\\> Sizes: \\</td\\>";
1451 Printf.bprintf buf "\\<td\\>\\<input name=size type=checkbox value=0to5\\> 0/5 MB \\</td\\>";
1452 Printf.bprintf buf "\\<td\\>\\<input name=size type=checkbox value=5to20\\> 5/20 MB \\</td\\>";
1453 Printf.bprintf buf "\\<td\\>\\<input name=size type=checkbox value=20to400\\> 20/400 MB \\</td\\>";
1454 Printf.bprintf buf "\\<td\\>\\<input name=size type=checkbox value=400\\> 400+ MB \\</td\\>";
1455 Printf.bprintf buf "\\</table\\>";
1457 Printf.bprintf buf "\\</tr\\>\\</table\\>\\</td\\>";
1458 Printf.bprintf buf "\\</tr\\>";
1460 Printf.bprintf buf "\\</table\\>";
1462 Printf.bprintf buf "\\</form\\>"
1464 (* with checkboxes *)
1465 let print_search_html buf results o search_num =
1466 let user = o.conn_user in
1467 let counter = ref 0 in
1469 let files = ref [] in
1471 (try
1472 List.iter (fun (rs, r, avail) ->
1475 o.conn_filter r;
1476 if !!display_downloaded_results || not r.result_done then
1477 let tags_string =
1478 let buf = Buffer.create 100 in
1479 List.iter (fun t ->
1480 Buffer.add_string buf (Printf.sprintf "%-3s "
1481 (if t.tag_name = Field_Availability then "" else
1482 match t.tag_value with
1483 String s -> s
1484 | Uint64 i -> Int64.to_string i
1485 | Fint64 i -> Int64.to_string i
1486 | _ -> "???"
1488 ) r.result_tags;
1489 Buffer.contents buf
1491 incr counter;
1492 if !counter >= !!max_displayed_results then raise Exit;
1493 user.ui_last_results <- (!counter, rs) :: user.ui_last_results;
1494 files := [|
1496 (Printf.sprintf "[%5d]\\<input name=d type=checkbox value=%d\\>" !counter r.result_num);
1497 (Int64.to_string r.result_size);
1498 (string_of_int avail);
1501 let names = r.result_names in
1502 let names = if r.result_done then
1503 names @ ["ALREADY DOWNLOADED"] else names in
1504 let names = match r.result_comment with
1505 | "" -> names
1506 | comment ->
1507 names @ ["COMMENT: " ^ comment]
1509 match names with
1510 [name] -> name
1511 | _ ->
1512 let buf = Buffer.create 100 in
1513 Buffer.add_string buf "\\<table\\>\n";
1514 List.iter (fun s ->
1515 Buffer.add_string buf "\\<tr\\>\\<td\\>";
1516 Buffer.add_string buf s;
1517 Buffer.add_string buf "\\</td\\>\\</tr\\>";
1518 ) names;
1519 Buffer.add_string buf "\\</table\\>\n";
1521 Buffer.contents buf
1524 tags_string;
1527 (string_of_uids r.result_uids);
1528 |] :: !files
1529 with _ -> ()
1530 ) results;
1531 with _ -> ());
1533 if !counter > !!filter_table_threshold then
1534 add_filter_table buf search_num;
1536 Printf.bprintf buf "\\<form action=results\\>";
1537 Printf.bprintf buf "\\<input type=submit value='Submit Changes'\\>";
1538 print_table_html 10 buf [||]
1540 "[ Num ]";
1541 "Size";
1542 "Avail";
1543 "Names";
1544 "Tags";
1545 "MD4";
1547 (List.rev !files);
1548 Printf.bprintf buf "\\</form\\>"
1552 let print_results stime buf o results =
1554 let user = o.conn_user in
1555 let print_table = if o.conn_output = HTML then print_table_html 2
1556 else print_table_text in
1558 let counter = ref 0 in
1559 let nsources = ref 0 in
1560 let totalsize = ref 0L in
1561 let files = ref [] in
1562 (try
1563 List.iter (fun (rs, r,avail) ->
1564 if !!display_downloaded_results || not r.result_done then begin
1565 incr counter;
1566 nsources := !nsources + avail;
1567 totalsize := !totalsize ++ r.result_size ** (Int64.of_int avail);
1568 if !counter >= !!max_displayed_results then raise Exit;
1569 user.ui_last_results <- (!counter, rs) :: user.ui_last_results;
1570 let new_result = !!save_results > 0 && r.result_time >= stime in
1571 files := [|
1573 (if use_html_mods o then
1574 Printf.sprintf "\\>\\<td class=\\\"sr\\\"\\>%d\\</td\\>" !counter
1575 else Printf.sprintf "%s[%s%5d]"
1576 (if new_result && !!term_ansi then "$b" else "$n")
1577 (if new_result then "N" else " ")
1578 !counter);
1580 (if use_html_mods o then
1581 "\\<td class=\\\"sr ar\\\"\\>" ^ size_of_int64 r.result_size ^ "\\</td\\>"
1582 else Int64.to_string r.result_size
1585 (if use_html_mods o then
1586 "\\<td class=\\\"sr ar\\\"\\>" ^ (string_of_int avail) ^ "\\</td\\>"
1587 else (string_of_int avail)
1590 (if r.result_done then
1591 begin
1592 if use_html_mods o then
1593 "\\<td class=\\\"sr ar\\\"\\>D\\</td\\>"
1594 else "dled"
1596 else
1597 begin
1598 if use_html_mods o then
1599 "\\<td class=\\\"sr ar\\\"\\> \\</td\\>"
1600 else " "
1604 (Printf.sprintf "%s%s%s"
1605 (if o.conn_output = HTML then begin
1606 if !!html_mods then Printf.sprintf "\\<td class=\\\"sr\\\"\\>\\<a href=results\\?d=%d target=\\\"$S\\\"\\>" r.result_num
1607 else Printf.sprintf "\\<a href=results\\?d=%d $S\\>" r.result_num;
1609 else "")
1611 ( shorten (
1612 let names = r.result_names in
1613 let names = match r.result_comment with
1614 "" -> names
1615 | comment ->
1616 names @ ["COMMENT: " ^ comment]
1618 match names with
1619 [name] -> name
1620 | _ ->
1621 let buf = Buffer.create 100 in
1622 if o.conn_output = HTML then Buffer.add_string buf "\\<table\\>\n";
1623 List.iter (fun s ->
1624 if o.conn_output = HTML then Buffer.add_string buf "\\<tr\\>";
1625 Buffer.add_string buf s;
1626 if o.conn_output = HTML then Buffer.add_string buf "\\</tr\\>";
1627 ) names;
1628 if o.conn_output = HTML then Buffer.add_string buf "\\</table\\>\n";
1630 Buffer.contents buf
1631 ) !!max_result_name_len)
1632 (if o.conn_output = HTML then
1633 begin
1634 if !!html_mods then "\\</a\\>\\</td\\>"
1635 else "\\</a href\\>"
1637 else ""
1641 (let buf = Buffer.create 100 in
1643 if use_html_mods o then Buffer.add_string buf "\\<td class=\\\"sr\\\"\\>";
1645 List.iter (fun t ->
1646 Buffer.add_string buf (Printf.sprintf "%-3s "
1647 (if t.tag_name = Field_Availability then "" else
1648 match t.tag_value with
1649 String s -> s
1650 | Uint64 i -> Int64.to_string i
1651 | Fint64 i -> Int64.to_string i
1652 | _ -> ""
1654 ) r.result_tags;
1655 Buffer.contents buf);
1658 let uid = string_of_uids r.result_uids in
1659 if use_html_mods o then
1660 Printf.sprintf "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" uid
1661 else uid
1664 |] :: !files;
1666 ) results;
1667 with _ -> ());
1668 if use_html_mods o then
1669 begin
1671 html_mods_table_header buf "resultsTable" "results" [
1672 ( Num, "srh", "Number", "#" ) ;
1673 ( Num, "srh ar", "Size", "Size" ) ;
1674 ( Str, "srh ar", "Availability", "A" ) ;
1675 ( Str, "srh ar", "Status, D = already downloaded", "S" ) ;
1676 ( Str, "srh", "Filename", "Name" ) ;
1677 ( Str, "srh", "Tag", "Tag" ) ;
1678 ( Str, "srh", "MD4", "MD4" ) ];
1680 print_table_html_mods buf
1681 (List.rev !files)
1685 else
1687 print_table buf [| Align_Left; Align_Right; Align_Right; Align_Right; Align_Left; Align_Left; Align_Left|]
1689 "[ Num ]";
1690 "Size";
1691 "Avail";
1692 "Status";
1693 "Names";
1694 "Tags";
1695 "MD4";
1698 (List.rev !files);
1699 Printf.bprintf buf "%d sources, total available %s\n" !nsources (size_of_int64 !totalsize)
1702 let print_search buf s o =
1703 let user = o.conn_user in
1704 user.ui_last_search <- Some s;
1705 user.ui_last_results <- [];
1706 let results = ref [] in
1707 Intmap.iter (fun r_num (avail,rs) ->
1708 let r = IndexedResults.get_result rs in
1709 results := (rs, r, !avail) :: !results) s.search_results;
1710 let results = List.sort (fun (_, r1,_) (_, r2,_) ->
1711 compare r2.result_size r1.result_size
1712 ) !results in
1714 Printf.bprintf buf "Result of search %d\n" s.search_num;
1715 Printf.bprintf buf "%d results (%s)\n" s.search_nresults
1716 (if s.search_waiting = 0 then "done" else
1717 (string_of_int s.search_waiting) ^ " waiting");
1719 if o.conn_output != HTML then print_results s.search_time buf o results else
1720 begin
1721 if !!html_checkbox_search_file_list then
1722 print_search_html buf results o s.search_num
1723 else
1724 old_print_search buf o results
1727 let browse_friends () =
1728 List.iter (fun c -> client_browse c false) !!friends;
1729 List.iter (fun c -> client_browse c false) !contacts
1732 let networks_header buf =
1733 html_mods_table_header buf "networkTable" "networkInfo" [
1734 ( Str, "srh br", "Network name", "Network" ) ;
1735 ( Str, "srh br", "Status", "Status" ) ;
1736 ( Str, "srh br", "Has upload", "Upload" ) ;
1737 ( Str, "srh br", "Has servers", "Servers" ) ;
1738 ( Str, "srh br", "Has supernodes", "Supernodes" ) ;
1739 ( Str, "srh br", "Has search", "Search" ) ;
1740 ( Str, "srh br", "Has chat", "Chat" ) ;
1741 ( Str, "srh br", "Has rooms", "Rooms" ) ;
1742 ( Str, "srh", "Has multinet", "Multinet" ) ;
1743 ( Str, "srh", "Has porttest", "Porttest" ) ]
1745 let print_network_modules buf o =
1746 let buf = o.conn_buf in
1747 if use_html_mods o then
1748 begin
1749 Printf.bprintf buf "\\<div class=\\\"cs\\\"\\>";
1750 networks_header buf;
1751 html_mods_cntr_init ();
1753 networks_iter_all
1754 (fun n ->
1755 if not (List.mem VirtualNetwork n.network_flags) then
1757 let net_has e = if List.mem e n.network_flags then "yes" else "" in
1758 let net_has_porttest () =
1759 match network_porttest_result n with
1760 PorttestNotAvailable -> ""
1761 | _ -> "yes" in
1762 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
1763 html_mods_td buf [
1764 ("", "sr br", n.network_name);
1765 ("", "sr br", if network_is_enabled n then "Enabled" else "Disabled");
1766 ("", "sr br", net_has NetworkHasUpload);
1767 ("", "sr br", net_has NetworkHasServers);
1768 ("", "sr br", net_has NetworkHasSupernodes);
1769 ("", "sr br", net_has NetworkHasSearch);
1770 ("", "sr br", net_has NetworkHasChat);
1771 ("", "sr br", net_has NetworkHasRooms);
1772 ("", "sr br", net_has NetworkHasMultinet);
1773 ("", "sr" , (net_has_porttest ())); ];
1774 Printf.bprintf buf "\\</tr\\>";
1775 with _ -> ()
1777 Printf.bprintf buf "\\</table\\>\\</div\\>\n";
1778 html_mods_table_header buf "networkTable" "networkInfo" [];
1779 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
1780 html_mods_td buf [
1781 ("", "sr br",
1782 "This table prints information about the capabilities of\nMLDonkey network modules, not the networks themselves"); ];
1783 Printf.bprintf buf "\\</table\\>\\</div\\>\\</div\\>\n"
1785 else
1786 begin
1787 Printf.bprintf buf "Networks:";
1788 networks_iter_all (fun n ->
1790 Printf.bprintf buf "\n %2d %-30s %s" n.network_num n.network_name
1791 (if network_is_enabled n then "Enabled" else "Disabled")
1792 with _ -> ())
1795 let print_gdstats o =
1796 let buf = o.conn_buf in
1797 let picture_suffix () =
1798 if !!html_mods_vd_gfx_png then
1799 Printf.bprintf buf "png\\\"\\>"
1800 else
1801 Printf.bprintf buf "jpg\\\"\\>";
1803 if Autoconf.has_gd then
1805 if !!html_mods_vd_gfx then
1807 Printf.bprintf buf "\\<br\\>\\<table class=bw_stats cellpadding=0 cellspacing=0 align=center\\>\\<tr\\>\\<td\\>";
1808 if !!html_mods_vd_gfx_split then
1809 begin
1810 Printf.bprintf buf "\\<img src=\\\"bw_download.";
1811 picture_suffix ();
1812 if !!html_mods_vd_gfx_flip then
1813 Printf.bprintf buf "\\<br\\>";
1814 Printf.bprintf buf "\\<img src=\\\"bw_upload.";
1815 picture_suffix ();
1817 else
1818 begin
1819 Printf.bprintf buf "\\<img src=\\\"bw_updown.";
1820 picture_suffix ();
1821 end;
1822 Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>";
1823 if !!html_mods_vd_gfx_h then
1825 Printf.bprintf buf "\\<br\\>\\<table class=bw_stats cellpadding=0 cellspacing=0 align=center\\>\\<tr\\>\\<td\\>";
1826 if !!html_mods_vd_gfx_split then
1827 begin
1828 Printf.bprintf buf "\\<img src=\\\"bw_h_download.";
1829 picture_suffix ();
1830 if !!html_mods_vd_gfx_flip then
1831 Printf.bprintf buf "\\<br\\>";
1832 Printf.bprintf buf "\\<img src=\\\"bw_h_upload.";
1833 picture_suffix ();
1835 else
1836 begin
1837 Printf.bprintf buf "\\<img src=\\\"bw_h_updown.";
1838 picture_suffix ();
1839 end;
1840 Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>";
1842 if !!html_mods_vd_gfx_tag then
1843 begin
1844 Printf.bprintf buf "\\<br\\>\\<br\\>\\<table class=bw_stats cellpadding=0 cellspacing=0 align=center\\>\\<tr\\>\\<td\\>\\<img src=\\\"tag.";
1845 picture_suffix ();
1846 Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>";
1847 end;
1850 else
1851 (* fake call if no gd *)
1852 DriverGraphics.G.do_draw_pic "" "" "" download_history download_history
1854 let buildinfo html buf =
1855 let tack listref e =
1856 listref := e :: !listref in
1857 let list = ref [] in
1858 tack list
1860 "Version:\t",
1861 "MLNet Multi-Network p2p client version " ^ Autoconf.current_version
1862 ^ (match Filename.basename (Sys.executable_name) with
1863 | "mlnet" | "mlnet.static" -> ""
1864 | bin -> Printf.sprintf " (%s)" bin)
1866 if Autoconf.scm_version <> "" then
1867 tack list
1869 "SCM version:\t",
1870 Autoconf.scm_version
1872 tack list
1874 "Networks:\t",
1875 !networks_string
1877 tack list
1879 "OCaml version:\t",
1880 Sys.ocaml_version ^
1881 " - C compiler version: " ^ Autoconf.cc_version ^
1882 (if Autoconf.cxx_version <> "" then
1883 " - C++ compiler version: " ^ Autoconf.cxx_version else "")
1885 tack list
1887 "Built on:\t",
1888 Autoconf.build_system ^ " (" ^ Unix2.endianness () ^ ")" ^
1889 (if Autoconf.glibc_version = "" then ""
1890 else
1891 let real_glibc_version = MlUnix.glibc_version_num () in
1892 if real_glibc_version = "" ||
1893 real_glibc_version = Autoconf.glibc_version
1894 then " with glibc " ^ Autoconf.glibc_version
1895 else
1896 Printf.sprintf " (Warning: glibc version mismatch, %s present on your system, MlDonkey was compiled with %s)"
1897 real_glibc_version Autoconf.glibc_version)
1899 if Autoconf.configure_arguments <> "" then
1900 tack list
1902 "Configure args:\t",
1903 Autoconf.configure_arguments
1905 if !patches_string <> "" then
1906 tack list
1908 "Patches:\t",
1909 !patches_string
1911 tack list
1913 "Features:\t",
1914 (if BasicSocket.has_threads () then " threads" else " no-threads") ^
1915 (let s = Zlib2.zlib_version_num () in
1916 Printf.sprintf " zlib%s" (if s <> "" then "-" ^ s else "")) ^
1917 (if Autoconf.bzip2 then
1918 let s, _ = String2.cut_at (Misc2.bzlib_version_num ()) ',' in
1919 Printf.sprintf " bzip2%s" (if s <> "" then "-" ^ s else "")
1920 else " no-bzip2") ^
1921 (match Autoconf.has_gd, Autoconf.has_gd_png, Autoconf.has_gd_jpg with
1922 | false, _, _ -> " no-gd"
1923 | _, true, true ->
1924 let s = DriverGraphics.G.png_version_num () in
1925 Printf.sprintf " gd(jpg/png%s)" (if s <> "" then "-" ^ s else "")
1926 | _, true, false ->
1927 let s = DriverGraphics.G.png_version_num () in
1928 Printf.sprintf " gd(png%s)" (if s <> "" then "-" ^ s else "")
1929 | _, false, true ->
1930 " gd(jpg)"
1931 | _, false, false ->
1932 " gd(neither jpg nor png ?)") ^
1933 (match Autoconf.has_iconv, !Charset.Locale.conversion_enabled with
1934 | true, true -> " iconv(active)"
1935 | true, false -> " iconv(inactive)"
1936 | false, _ -> " no-iconv") ^
1937 (match Autoconf.magic, !Autoconf.magic_works with
1938 | true, true -> " magic(active)"
1939 | true, false -> " magic(inactive)"
1940 | false, _ -> " no-magic") ^
1941 (if Autoconf.upnp_natpmp then " upnp natpmp" else " no-upnp no-natpmp") ^
1942 (if Autoconf.check_bounds then " check-bounds" else " no-check-bounds")
1944 let list = List.rev !list in
1946 if html then
1947 html_mods_table_header buf "sharesTable" "shares" [
1948 ( Str, "srh", "core Build information", "Buildinfo" ) ;
1949 ( Str, "srh", "", "" ) ]
1950 else
1951 Printf.bprintf buf "\n\t--Buildinfo--\n";
1952 html_mods_cntr_init ();
1953 List.iter (fun (desc, text) ->
1954 if html then
1955 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>"
1956 (html_mods_cntr ()) desc text
1957 else
1958 Printf.bprintf buf "%s %s\n" desc text;
1959 ) list;
1960 if html then
1961 Printf.bprintf buf "\\</table\\>\\</div\\>"
1963 let runinfo html buf o =
1964 let bl_loc = Ip_set.bl_length !CommonBlocking.ip_blocking_list in
1965 let bl_web = Ip_set.bl_length !CommonBlocking.web_ip_blocking_list in
1967 let tack listref e =
1968 listref := e :: !listref in
1969 let list = ref [] in
1970 tack list
1972 "MLDonkey user:\t\t",
1973 Printf.sprintf "%s (%s) - uptime: %s%s"
1974 o.conn_user.ui_user.user_name
1975 (if has_empty_password o.conn_user.ui_user then "Warning: empty Password"
1976 else "PW Protected")
1977 (Date.time_to_string (last_time () - start_time) "verbose")
1979 let user_group =
1980 (try Some (Unix.getpwuid (Unix.getuid())).Unix.pw_name with _ -> None),
1981 (try Some (Unix.getgrgid (Unix.getgid())).Unix.gr_name with _ -> None)
1983 match user_group with
1984 | (Some g, Some u) -> Printf.sprintf " - running as %s:%s" u g
1985 | _ -> ""
1988 tack list
1990 "Enabled nets:\t",
1991 List.fold_left (fun acc (c, s) ->
1992 if c then Printf.sprintf "%s %s" acc s else acc) ""
1993 [(Autoconf.donkey = "yes" && !!enable_donkey, "Donkey");
1994 (Autoconf.donkey = "yes" && !!enable_overnet, "Overnet");
1995 (Autoconf.donkey = "yes" && !!enable_kademlia, "Kademlia");
1996 (Autoconf.bittorrent = "yes" && !!enable_bittorrent, "BitTorrent");
1997 (Autoconf.direct_connect = "yes" && !!enable_directconnect, "DirectConnect");
1998 (Autoconf.fasttrack = "yes" && !!enable_fasttrack, "Fasttrack");
1999 (Autoconf.gnutella = "yes" && !!enable_gnutella, "Gnutella");
2000 (Autoconf.gnutella2 = "yes" && !!enable_gnutella2, "G2");
2001 (Autoconf.filetp = "yes" && !!enable_fileTP, "FileTP")]
2003 tack list
2005 "Server usage:\t",
2006 if !!enable_servers then "enabled"
2007 else "disabled (you are not able to connect to ED2K Servers)"
2009 tack list
2011 "Geoip:\t\t",
2012 if Geoip.active () then "enabled, GeoLite data created by MaxMind, available from http://maxmind.com/"
2013 else "disabled, to enable adjust web_infos in downloads.ini for automatic download"
2015 tack list
2017 "IP blocking:\t",
2018 if bl_loc = 0 && bl_web = 0 then "no blocking list loaded"
2019 else Printf.sprintf "local: %d ranges - web: %d ranges" bl_loc bl_web
2021 if not !dns_works then
2022 tack list
2024 "DNS:\t\t",
2025 Printf.sprintf "DNS resolution not available, web_infos %s not work"
2026 (if Autoconf.bittorrent = "yes" then "and BT does" else "do")
2028 if Autoconf.magic then
2029 tack list
2031 "Libmagic:\t",
2032 Printf.sprintf "file-type recognition database%s present"
2033 (if !Autoconf.magic_works then "" else " not")
2035 tack list
2037 "System info:\t",
2038 let uname = Unix32.uname () in
2039 if uname <> "" then
2040 uname ^
2041 (if not (Unix32.os_supported ()) then
2042 " - \nWARNING:\t not supported operating system" else "")
2043 else "unknown"
2045 tack list
2048 Printf.sprintf "\t\t language: %s - locale: %s - UTC offset: %s"
2049 Charset.Locale.default_language
2050 Charset.Locale.locale_string
2051 (Rss_date.mk_timezone (Unix.time ()))
2053 tack list
2055 "",
2056 Printf.sprintf "\t\t max_string_length: %d - word_size: %d - max_array_length: %d - max_int: %d"
2057 Sys.max_string_length
2058 Sys.word_size
2059 Sys.max_array_length
2060 Pervasives.max_int
2062 tack list
2064 "",
2065 Printf.sprintf "\t\t max file descriptors: %d - max useable file size: %s"
2066 (Unix2.c_getdtablesize ())
2067 (match Unix2.c_sizeofoff_t () with
2068 | 4 -> "2GB"
2069 | _ ->
2070 Printf.sprintf "2^%d-1 bits (do the maths ;-p)"
2071 ((Unix2.c_sizeofoff_t () * 8)-1))
2073 let list = List.rev !list in
2075 if html then
2076 html_mods_table_header buf "sharesTable" "shares" [
2077 ( Str, "srh", "core runtime information", "Runinfo" ) ;
2078 ( Str, "srh", "", "" ) ]
2079 else
2080 Printf.bprintf buf "\n\t--Runinfo--\n";
2081 html_mods_cntr_init ();
2082 List.iter (fun (desc, text) ->
2083 if html then
2084 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>"
2085 (html_mods_cntr ()) desc text
2086 else
2087 Printf.bprintf buf "%s %s\n" desc text;
2088 ) list;
2089 if html then
2090 Printf.bprintf buf "\\</table\\>\\</div\\>"
2092 type port_info = {
2093 netname : string;
2094 port : int;
2095 portname : string
2098 let portinfo html buf =
2099 let network_name_list_width = ref 7 in (* "Network" *)
2100 let list = ref [] in
2101 networks_iter (fun r ->
2102 if String.length r.network_name > !network_name_list_width then
2103 network_name_list_width := String.length r.network_name;
2104 List.iter (fun (p,s) -> if p <> 0 then list := !list @
2105 [{netname = r.network_name; port = p; portname = s}]) (network_ports r)
2107 List.iter (fun (p,s) -> if p <> 0 then list := !list @
2108 [{netname = "Core"; port = p; portname = s}])
2109 (network_ports (network_find_by_name "Global Shares"));
2111 let fill_network s = String.make (max 0 (!network_name_list_width - 7)) s in
2112 if html then
2113 html_mods_table_header buf "sharesTable" "shares" [
2114 ( Str, "srh", "Network", "Network" ) ;
2115 ( Num, "srh ar", "Port", "Port" ) ;
2116 ( Str, "srh", "Type", "Type" ) ]
2117 else
2118 begin
2119 Printf.bprintf buf "\n\t--Portinfo--\n";
2120 Printf.bprintf buf "Network%s| Port|Type\n" (fill_network ' ');
2121 Printf.bprintf buf "-------%s+------+-------------------\n" (fill_network '-')
2122 end;
2124 html_mods_cntr_init ();
2125 List.iter (fun p ->
2126 if html then
2127 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%d\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>"
2128 (html_mods_cntr ()) p.netname p.port p.portname
2129 else
2130 Printf.bprintf buf "%-*s|%6d|%s\n"
2131 (max !network_name_list_width (!network_name_list_width - String.length p.netname)) p.netname p.port p.portname
2132 ) (List.sort (fun p1 p2 -> String.compare p1.netname p2.netname) !list);
2133 if html then
2134 Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>"
2136 let diskinfo html buf =
2137 let list = ref [] in
2138 ignore (search_incoming_files ());
2139 ignore (search_incoming_directories ());
2140 list := (Filename2.temp_dir_name (), "$MLDONKEY_TEMP") :: !list;
2141 List.iter (fun dir ->
2142 list := (dir.shdir_dirname, (Printf.sprintf "shared (%s)" dir.shdir_strategy))
2143 :: !list) !!shared_directories;
2144 list := (!!temp_directory, "temp/downloading") :: !list;
2145 list := (Sys.getcwd (), "core/ini files") :: !list;
2147 let len_dir = ref 9 in
2148 let len_strategy = ref 29 in (* "shared (incoming_directories)" *)
2149 List.iter ( fun (dir, strategy) ->
2150 len_dir := max !len_dir (String.length dir);
2151 len_strategy := max !len_strategy (String.length strategy)
2152 ) !list;
2153 let fill_dir = String.make (!len_dir - 9) ' ' in
2154 let fill_dir_line = String.make (!len_dir - 9) '-' in
2155 let fill_strategy = String.make (!len_strategy - 4) ' ' in
2156 let fill_strategy_line = String.make (!len_strategy - 4) '-' in
2157 html_mods_cntr_init ();
2158 if html then
2159 html_mods_table_header buf "sharesTable" "shares" [
2160 ( Str, "srh", "Directory", "Directory" ) ;
2161 ( Str, "srh", "Directory type", "Type" ) ;
2162 ( Num, "srh ar", "HDD used", "used" ) ;
2163 ( Num, "srh ar", "HDD free", "free" ) ;
2164 ( Num, "srh ar", "% free", "% free" ) ;
2165 ( Str, "srh", "Filesystem", "FS" ) ]
2166 else
2167 begin
2168 Printf.bprintf buf "\n\t--Diskinfo--\n";
2169 Printf.bprintf buf "Directory%s|Type%s| used| free|%%free|Filesystem\n"
2170 fill_dir fill_strategy;
2171 Printf.bprintf buf "---------%s+----%s+--------+--------+-----+----------\n"
2172 fill_dir_line fill_strategy_line;
2173 end;
2174 List.iter (fun (dir, strategy) ->
2175 let diskused =
2176 match Unix32.diskused dir with
2177 | None -> Printf.sprintf "---"
2178 | Some du -> size_of_int64 du
2180 let diskfree =
2181 match Unix32.diskfree dir with
2182 | None -> Printf.sprintf "---"
2183 | Some df -> size_of_int64 df
2185 let percentfree =
2186 match Unix32.percentfree dir with
2187 | None -> Printf.sprintf "---"
2188 | Some p -> Printf.sprintf "%d%%" p
2190 let filesystem = Unix32.filesystem dir in
2191 if html then
2192 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>
2193 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
2194 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>"
2195 (html_mods_cntr ()) dir strategy diskused diskfree percentfree filesystem
2196 else
2197 Printf.bprintf buf "%-*s|%-*s|%8s|%8s|%5s|%-s\n"
2198 (max !len_dir (!len_dir - String.length dir)) dir
2199 (max !len_strategy (!len_strategy - String.length strategy)) strategy
2200 diskused diskfree percentfree filesystem
2201 ) !list;
2202 if html then
2203 Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>"
2205 let print_option_help o option =
2206 let buf = o.conn_buf in
2207 let help_text = get_help option in
2208 if use_html_mods o then
2209 begin
2210 Printf.bprintf buf "\\<div class=\\\"cs\\\"\\>";
2211 html_mods_table_header buf "versionTable" "results" [];
2212 Printf.bprintf buf "\\<tr\\>";
2213 html_mods_td buf [ ("", "srh", "Helptext"); ];
2214 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>";
2215 html_mods_td buf [ ("", "sr", Str.global_replace (Str.regexp "\n") "\\<br\\>" help_text); ];
2216 Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\\</div\\>";
2218 else
2219 Printf.bprintf buf "\n\t--Helptext--\n%s\n" help_text
2221 let dllink_print_result html url header results =
2222 let buf = Buffer.create 100 in
2223 if html then
2224 begin
2225 Printf.bprintf buf "\\<div class=\\\"cs\\\"\\>";
2226 html_mods_table_header buf "dllinkTable" "results" [];
2227 Printf.bprintf buf "\\<tr\\>";
2228 html_mods_td buf [ ("", "srh", header); ];
2229 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>";
2230 html_mods_td buf [ ("", "sr", url); ]
2232 else
2233 Printf.bprintf buf "%s : %s\n" header url;
2234 List.iter (fun s ->
2235 if html then
2236 begin
2237 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>";
2238 html_mods_td buf [ ("", "sr", s); ]
2240 else
2241 Printf.bprintf buf "%s\n" s) (List.rev results);
2242 if html then Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\\</div\\>";
2243 Buffer.contents buf
2245 let dllink_query_networks html url user group =
2246 let result = ref [] in
2247 if not (networks_iter_until_true (fun n ->
2249 let s,r = network_parse_url n url user group in
2250 if s = "" then
2252 else
2253 let s1 = Printf.sprintf "%s: %s" n.network_name s in
2254 result := s1 :: !result;
2256 with e ->
2257 let s1 = Printf.sprintf "%s: Exception %s"
2258 (n.network_name) (Printexc2.to_string e)
2260 result := s1 :: !result;
2261 false
2262 )) then
2263 dllink_print_result html url "Unable to match URL" !result
2264 else
2265 dllink_print_result html url "Added link" !result
2267 let dllink_parse html url user =
2268 if (String2.starts_with url "http") then (
2269 let u = Url.of_string url in
2270 let module H = Http_client in
2271 let r = {
2272 H.basic_request with
2273 H.req_url = u;
2274 H.req_proxy = !CommonOptions.http_proxy;
2275 H.req_request = H.HEAD;
2276 H.req_max_retry = 10;
2277 H.req_referer = (
2278 let (rule_search,rule_value) =
2279 try (List.find(fun (rule_search,rule_value) ->
2280 Str.string_match (Str.regexp rule_search) u.Url.server 0
2281 ) !!referers )
2282 with Not_found -> ("",Url.to_string u) in
2283 Some (Url.of_string rule_value) );
2284 H.req_headers = (try
2285 let cookies = List.assoc u.Url.server !!cookies in
2286 [ ( "Cookie", List.fold_left (fun res (key, value) ->
2287 if res = "" then
2288 key ^ "=" ^ value
2289 else
2290 res ^ "; " ^ key ^ "=" ^ value
2291 ) "" cookies
2293 with Not_found -> []);
2294 H.req_user_agent = get_user_agent ();
2295 } in
2296 H.whead r (fun headers ->
2297 (* Combine the list of header fields into one string *)
2298 let concat_headers =
2299 (List.fold_right (fun (n, c) t -> n ^ ": " ^ c ^ "\n" ^ t) headers "")
2301 ignore (dllink_query_networks html concat_headers user user.user_default_group)
2303 dllink_print_result html url "Parsing HTTP url" [])
2304 else
2305 if (String2.starts_with url "ftp") then
2306 dllink_query_networks html (Printf.sprintf "Location: %s" url) user user.user_default_group
2307 else
2308 dllink_query_networks html url user user.user_default_group
2310 module UnionFind = struct
2311 type t = int array
2312 let create_sets n =
2313 Array.init n (fun i -> i) (* each element is its own leader *)
2314 let find_leader t i =
2315 let rec fix_point i =
2316 let parent = t.(i) in
2317 if parent <> i then fix_point parent
2318 else i in
2319 let leader = fix_point i in
2320 t.(i) <- leader;
2321 leader
2322 let merge_sets t i j =
2323 let leaderi = find_leader t i in
2324 let leaderj = find_leader t j in
2325 t.(leaderi) <- leaderj
2326 let number_of_sets t =
2327 let nsets = ref 0 in
2328 Array.iteri (fun i ti ->
2329 if i = ti then incr nsets) t;
2330 !nsets
2333 let filenames_variability o list =
2334 (* over this number of filenames, exact variability is not computed
2335 (too expensive) *)
2336 let bypass_threshold = 100 in
2337 (* minimum distance that must exist between two groups of filenames
2338 so they're considered separate *)
2339 let gap_threshold = 4 in
2341 let buf = o.conn_buf in
2343 let is_alphanum = function
2344 | 'A' .. 'Z'
2345 | 'a' .. 'z'
2346 | '0' .. '9' -> true
2347 | _ -> false in
2349 let canonized_words s =
2350 let len = String.length s in
2351 let current_word = Buffer.create len in
2352 let rec outside_word i wl =
2353 if i < len then
2354 if not (is_alphanum s.[i]) then outside_word (i + 1) wl
2355 else begin (* start of a new word *)
2356 Buffer.add_char current_word (Char.lowercase s.[i]);
2357 inside_word (i + 1) wl
2359 else wl
2360 and inside_word i wl =
2361 if i < len then
2362 if not (is_alphanum s.[i]) then begin (* end of the word *)
2363 let wl = Buffer.contents current_word :: wl in
2364 Buffer.reset current_word;
2365 outside_word i wl
2366 end else begin
2367 Buffer.add_char current_word (Char.lowercase s.[i]);
2368 inside_word (i + 1) wl
2370 else Buffer.contents current_word :: wl
2372 outside_word 0 [] in
2374 let costs = {
2375 Levenshtein.insert_cost = 1;
2376 Levenshtein.delete_cost = 1;
2377 Levenshtein.replace_cost = 2 } in
2378 (* we can only assume the distance is symetric if insert and
2379 delete costs are the same *)
2380 assert (costs.Levenshtein.insert_cost = costs.Levenshtein.delete_cost);
2381 let dist = Levenshtein.ForWords.distance costs in
2383 let score_list =
2384 List.map (fun fileinfo ->
2385 (* canonize filenames by keeping only lowercase words, and
2386 sorting them so that initial order doesn't matter;
2387 Remove duplicate canonized filenames *)
2388 let fns = Array.of_list (List.fold_left (fun acc fn ->
2389 let new_fn =
2390 Array.of_list (List.sort String.compare (canonized_words fn)) in
2391 if List.mem new_fn acc then acc else new_fn :: acc
2392 ) [] fileinfo.file_names) in
2394 let nfilenames = Array.length fns in
2395 if nfilenames > bypass_threshold then
2396 fileinfo, bypass_threshold
2397 else
2398 let unionfind_sets = UnionFind.create_sets nfilenames in
2399 for i = 0 to nfilenames - 2 do
2400 let d1 = dist fns.(i) in
2401 for j = i + 1 to nfilenames - 1 do
2402 if d1 fns.(j) < gap_threshold then
2403 UnionFind.merge_sets unionfind_sets i j
2404 done
2405 done;
2406 fileinfo, UnionFind.number_of_sets unionfind_sets
2407 ) list in
2409 (* files with most clusters at the end of results table *)
2410 let sorted_score_list =
2411 List.sort (fun (_, nc1) (_, nc2) -> compare nc1 nc2)
2412 score_list in
2414 let print_table = if o.conn_output = HTML then print_table_html 2
2415 else print_table_text in
2416 print_table buf
2418 Align_Left; Align_Left; Align_Right |]
2420 "Num";
2421 "File";
2422 "Clusters" |]
2423 (List.map (fun (fileinfo, nc) ->
2424 let n = network_find_by_num fileinfo.file_network in
2426 Printf.sprintf "[%-s %5d]" n.network_name (fileinfo.file_num);
2427 shorten fileinfo.file_name 80;
2428 string_of_int nc |]
2429 ) sorted_score_list)
2431 let print_upstats o list server =
2432 let buf = o.conn_buf in
2433 if use_html_mods o then
2434 begin
2435 if !!html_mods_use_js_tooltips then Printf.bprintf buf
2436 "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:
2437 -100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\&nbsp;\\</div\\>";
2439 Printf.bprintf buf "\\<div class=\\\"upstats\\\"\\>";
2440 match server with
2441 None ->
2442 html_mods_table_one_row buf "upstatsTable" "upstats" [
2443 ("", "srh", Printf.sprintf "Session: %s uploaded | Shared(%d): %s\n"
2444 (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes)); ]
2445 | Some s -> let info = server_info s in
2446 html_mods_table_one_row buf "upstatsTable" "upstats" [
2447 ("", "srh", Printf.sprintf "%d files shared on %s (%s:%s)"
2448 info.G.server_published_files info.G.server_name
2449 (Ip.string_of_addr info.G.server_addr)
2450 (string_of_int info.G.server_port)); ]
2452 else
2453 begin
2454 Printf.bprintf buf "Upload statistics:\n";
2455 Printf.bprintf buf "Session: %s uploaded | Shared(%d): %s\n"
2456 (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes)
2457 end;
2459 if use_html_mods o then
2460 html_mods_table_header buf "upstatsTable" "upstats" [
2461 ( Num, "srh", "Total file requests", "Reqs" ) ;
2462 ( Num, "srh", "Total bytes sent", "Total" ) ;
2463 ( Num, "srh", "Upload Ratio", "UPRatio" ) ;
2464 ( Str, "srh", "Preview", "P" ) ;
2465 ( Str, "srh", "Filename", "Filename" );
2466 ( Str, "srh", "Statistic links", "Stats" );
2467 ( Str, "srh", "Published on servers", "Publ" );
2468 ( Str, "srh", "Share status", "Status" )
2470 else
2471 begin
2472 Printf.bprintf buf " Requests | Bytes | Uploaded | File\n";
2473 Printf.bprintf buf "----------+----------+----------+----------------------------------------------------\n";
2474 end;
2476 html_mods_cntr_init ();
2477 let list = List.sort (fun f1 f2 ->
2478 let c = compare f2.impl_shared_requests f1.impl_shared_requests in
2479 if c <> 0 then c else
2480 compare f2.impl_shared_uploaded f1.impl_shared_uploaded
2481 ) list in
2483 List.iter (fun impl ->
2484 if use_html_mods o then
2485 begin
2486 let published = List.length impl.impl_shared_servers in
2487 let ed2k = file_print_ed2k_link
2488 (Filename.basename impl.impl_shared_codedname)
2489 impl.impl_shared_size impl.impl_shared_id in
2491 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ());
2492 (if !!html_mods_use_js_tooltips then
2493 Printf.bprintf buf " onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>"
2494 (Http_server.html_real_escaped (Filename.basename (Charset.Locale.to_utf8 impl.impl_shared_codedname)))
2495 (match impl.impl_shared_file with
2496 None -> "no file info"
2497 | Some file -> match file_magic file with | None -> "no magic"
2498 | Some magic -> "File type: " ^ (Http_server.html_real_escaped magic) ^ "<br>")
2499 (if impl.impl_shared_servers = [] then "" else
2500 Printf.sprintf "<br>Published on %d %s<br>%s"
2501 published (if published = 1 then "server" else "servers")
2502 (let listbuf = Buffer.create 100 in
2503 List.iter (fun s -> let info = server_info s in
2504 Printf.bprintf listbuf "%s (%s:%s%s)<br>"
2505 info.server_name
2506 (Ip.string_of_addr info.server_addr)
2507 (string_of_int info.server_port)
2508 (if info.server_realport <> 0
2509 then "(" ^ (string_of_int info.server_realport) ^ ")" else "")
2510 ) impl.impl_shared_servers;
2511 Buffer.contents listbuf))
2512 !!html_mods_js_tooltips_wait
2513 !!html_mods_js_tooltips_timeout
2514 !!html_mods_js_tooltips_wait
2515 else Printf.bprintf buf " onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>");
2517 let uploaded = Int64.to_float impl.impl_shared_uploaded in
2518 let size = Int64.to_float impl.impl_shared_size in
2519 html_mods_td buf [
2520 ("", "sr ar", Printf.sprintf "%d" impl.impl_shared_requests);
2521 ("", "sr ar", size_of_int64 impl.impl_shared_uploaded);
2522 ("", "sr ar", Printf.sprintf "%5.1f" ( if size < 1.0 then 0.0 else (uploaded *. 100.) /. size));
2523 ("", "sr", Printf.sprintf "\\<a href=\\\"preview_upload?q=%d\\\"\\>P\\</a\\>" impl.impl_shared_num);
2524 ("", "sr", (if impl.impl_shared_id = Md4.null then
2525 (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len)
2526 else
2527 Printf.sprintf "\\<a href=\\\"%s\\\"\\>%s\\</a\\>"
2528 ed2k (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len)));
2529 ("", "sr", (if impl.impl_shared_id = Md4.null then "" else
2530 Printf.sprintf "\\<a href=\\\"http://tothbenedek.hu/ed2kstats/ed2k?hash=%s\\\"\\>%s\\</a\\>
2531 \\<a href=\\\"http://ed2k.titanesel.ws/ed2k.php?hash=%s\\\"\\>%s\\</a\\>
2532 \\<a href=\\\"http://bitzi.com/lookup/ed2k:%s\\\"\\>%s\\</a\\>"
2533 (Md4.to_string impl.impl_shared_id) "T1"
2534 (Md4.to_string impl.impl_shared_id) "T2"
2535 (Md4.to_string impl.impl_shared_id) "B"));
2536 ("", "sr ar", Printf.sprintf "%d" published);
2537 ("", "sr", shared_state (as_shared impl) o);
2539 Printf.bprintf buf "\\</tr\\>\n";
2541 else
2542 Printf.bprintf buf "%9d | %8s | %7s%% | %-50s\n"
2543 (impl.impl_shared_requests)
2544 (size_of_int64 impl.impl_shared_uploaded)
2545 (Printf.sprintf "%3.1f" ((Int64.to_float impl.impl_shared_uploaded *. 100.) /. Int64.to_float impl.impl_shared_size))
2546 (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len)
2547 ) list;
2549 if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>\\</div\\>"