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