patch #7180
[mldonkey.git] / src / daemon / driver / driverInteractive.ml
blobcf4212ab1310b36af6ab381cf097763a0769e095
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 commited in the incoming directory"); ]
1174 else
1175 Printf.bprintf buf
1176 "Files will be automatically commited 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 ( "1", "srh", "Number", "#" ) ;
1675 ( "1", "srh ar", "Size", "Size" ) ;
1676 ( "0", "srh ar", "Availability", "A" ) ;
1677 ( "0", "srh ar", "Status, D = already downloaded", "S" ) ;
1678 ( "0", "srh", "Filename", "Name" ) ;
1679 ( "0", "srh", "Tag", "Tag" ) ;
1680 ( "0", "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 ( "0", "srh br", "Network name", "Network" ) ;
1737 ( "0", "srh br", "Status", "Status" ) ;
1738 ( "0", "srh br", "Has upload", "Upload" ) ;
1739 ( "0", "srh br", "Has servers", "Servers" ) ;
1740 ( "0", "srh br", "Has supernodes", "Supernodes" ) ;
1741 ( "0", "srh br", "Has search", "Search" ) ;
1742 ( "0", "srh br", "Has chat", "Chat" ) ;
1743 ( "0", "srh br", "Has rooms", "Rooms" ) ;
1744 ( "0", "srh", "Has multinet", "Multinet" ) ;
1745 ( "0", "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.check_bounds then " check-bounds" else " no-check-bounds")
1945 let list = List.rev !list in
1947 if html then
1948 html_mods_table_header buf "sharesTable" "shares" [
1949 ( "0", "srh", "core Build informations", "Buildinfo" ) ;
1950 ( "0", "srh", "", "" ) ]
1951 else
1952 Printf.bprintf buf "\n\t--Buildinfo--\n";
1953 html_mods_cntr_init ();
1954 List.iter (fun (desc, text) ->
1955 if html then
1956 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>"
1957 (html_mods_cntr ()) desc text
1958 else
1959 Printf.bprintf buf "%s %s\n" desc text;
1960 ) list;
1961 if html then
1962 Printf.bprintf buf "\\</table\\>\\</div\\>"
1964 let runinfo html buf o =
1965 let bl_loc = Ip_set.bl_length !CommonBlocking.ip_blocking_list in
1966 let bl_web = Ip_set.bl_length !CommonBlocking.web_ip_blocking_list in
1968 let tack listref e =
1969 listref := e :: !listref in
1970 let list = ref [] in
1971 tack list
1973 "MLDonkey user:\t\t",
1974 Printf.sprintf "%s (%s) - uptime: %s%s"
1975 o.conn_user.ui_user.user_name
1976 (if has_empty_password o.conn_user.ui_user then "Warning: empty Password"
1977 else "PW Protected")
1978 (Date.time_to_string (last_time () - start_time) "verbose")
1980 let user_group =
1981 (try Some (Unix.getpwuid (Unix.getuid())).Unix.pw_name with _ -> None),
1982 (try Some (Unix.getgrgid (Unix.getgid())).Unix.gr_name with _ -> None)
1984 match user_group with
1985 | (Some g, Some u) -> Printf.sprintf " - running as %s:%s" u g
1986 | _ -> ""
1989 tack list
1991 "Enabled nets:\t",
1992 List.fold_left (fun acc (c, s) ->
1993 if c then Printf.sprintf "%s %s" acc s else acc) ""
1994 [(Autoconf.donkey = "yes" && !!enable_donkey, "Donkey");
1995 (Autoconf.donkey = "yes" && !!enable_overnet, "Overnet");
1996 (Autoconf.donkey = "yes" && !!enable_kademlia, "Kademlia");
1997 (Autoconf.bittorrent = "yes" && !!enable_bittorrent, "BitTorrent");
1998 (Autoconf.direct_connect = "yes" && !!enable_directconnect, "DirectConnect");
1999 (Autoconf.fasttrack = "yes" && !!enable_fasttrack, "Fasttrack");
2000 (Autoconf.gnutella = "yes" && !!enable_gnutella, "Gnutella");
2001 (Autoconf.gnutella2 = "yes" && !!enable_gnutella2, "G2");
2002 (Autoconf.filetp = "yes" && !!enable_fileTP, "FileTP")]
2004 tack list
2006 "Server usage:\t",
2007 if !!enable_servers then "enabled"
2008 else "disabled (you are not able to connect to ED2K Servers)"
2010 tack list
2012 "Geoip:\t\t",
2013 if Geoip.active () then "enabled, GeoLite data created by MaxMind, available from http://maxmind.com/"
2014 else "disabled, to enable adjust web_infos in downloads.ini for automatic download"
2016 tack list
2018 "IP blocking:\t",
2019 if bl_loc = 0 && bl_web = 0 then "no blocking list loaded"
2020 else Printf.sprintf "local: %d ranges - web: %d ranges" bl_loc bl_web
2022 if not !dns_works then
2023 tack list
2025 "DNS:\t\t",
2026 Printf.sprintf "DNS resolution not available, web_infos %s not work"
2027 (if Autoconf.bittorrent = "yes" then "and BT does" else "do")
2029 if Autoconf.magic then
2030 tack list
2032 "Libmagic:\t",
2033 Printf.sprintf "file-type recognition database%s present"
2034 (if !Autoconf.magic_works then "" else " not")
2036 tack list
2038 "System info:\t",
2039 let uname = Unix32.uname () in
2040 if uname <> "" then
2041 uname ^
2042 (if not (Unix32.os_supported ()) then
2043 " - \nWARNING:\t not supported operating system" else "")
2044 else "unknown"
2046 tack list
2049 Printf.sprintf "\t\t language: %s - locale: %s - UTC offset: %s"
2050 Charset.Locale.default_language
2051 Charset.Locale.locale_string
2052 (Rss_date.mk_timezone (Unix.time ()))
2054 tack list
2056 "",
2057 Printf.sprintf "\t\t max_string_length: %d - word_size: %d - max_array_length: %d - max_int: %d"
2058 Sys.max_string_length
2059 Sys.word_size
2060 Sys.max_array_length
2061 Pervasives.max_int
2063 tack list
2065 "",
2066 Printf.sprintf "\t\t max file descriptors: %d - max useable file size: %s"
2067 (Unix2.c_getdtablesize ())
2068 (match Unix2.c_sizeofoff_t () with
2069 | 4 -> "2GB"
2070 | _ ->
2071 Printf.sprintf "2^%d-1 bits (do the maths ;-p)"
2072 ((Unix2.c_sizeofoff_t () * 8)-1))
2074 let list = List.rev !list in
2076 if html then
2077 html_mods_table_header buf "sharesTable" "shares" [
2078 ( "0", "srh", "core runtime informations", "Runinfo" ) ;
2079 ( "0", "srh", "", "" ) ]
2080 else
2081 Printf.bprintf buf "\n\t--Runinfo--\n";
2082 html_mods_cntr_init ();
2083 List.iter (fun (desc, text) ->
2084 if html then
2085 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>"
2086 (html_mods_cntr ()) desc text
2087 else
2088 Printf.bprintf buf "%s %s\n" desc text;
2089 ) list;
2090 if html then
2091 Printf.bprintf buf "\\</table\\>\\</div\\>"
2093 type port_info = {
2094 netname : string;
2095 port : int;
2096 portname : string
2099 let portinfo html buf =
2100 let network_name_list_width = ref 7 in (* "Network" *)
2101 let list = ref [] in
2102 networks_iter (fun r ->
2103 if String.length r.network_name > !network_name_list_width then
2104 network_name_list_width := String.length r.network_name;
2105 List.iter (fun (p,s) -> if p <> 0 then list := !list @
2106 [{netname = r.network_name; port = p; portname = s}]) (network_ports r)
2108 List.iter (fun (p,s) -> if p <> 0 then list := !list @
2109 [{netname = "Core"; port = p; portname = s}])
2110 (network_ports (network_find_by_name "Global Shares"));
2112 let fill_network s = String.make (max 0 (!network_name_list_width - 7)) s in
2113 if html then
2114 html_mods_table_header buf "sharesTable" "shares" [
2115 ( "0", "srh", "Network", "Network" ) ;
2116 ( "0", "srh ar", "Port", "Port" ) ;
2117 ( "1", "srh", "Type", "Type" ) ]
2118 else
2119 begin
2120 Printf.bprintf buf "\n\t--Portinfo--\n";
2121 Printf.bprintf buf "Network%s| Port|Type\n" (fill_network ' ');
2122 Printf.bprintf buf "-------%s+------+-------------------\n" (fill_network '-')
2123 end;
2125 html_mods_cntr_init ();
2126 List.iter (fun p ->
2127 if html then
2128 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%d\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>"
2129 (html_mods_cntr ()) p.netname p.port p.portname
2130 else
2131 Printf.bprintf buf "%-*s|%6d|%s\n"
2132 (max !network_name_list_width (!network_name_list_width - String.length p.netname)) p.netname p.port p.portname
2133 ) (List.sort (fun p1 p2 -> String.compare p1.netname p2.netname) !list);
2134 if html then
2135 Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>"
2137 let diskinfo html buf =
2138 let list = ref [] in
2139 ignore (search_incoming_files ());
2140 ignore (search_incoming_directories ());
2141 list := (Filename2.temp_dir_name (), "$MLDONKEY_TEMP") :: !list;
2142 List.iter (fun dir ->
2143 list := (dir.shdir_dirname, (Printf.sprintf "shared (%s)" dir.shdir_strategy))
2144 :: !list) !!shared_directories;
2145 list := (!!temp_directory, "temp/downloading") :: !list;
2146 list := (Sys.getcwd (), "core/ini files") :: !list;
2148 let len_dir = ref 9 in
2149 let len_strategy = ref 29 in (* "shared (incoming_directories)" *)
2150 List.iter ( fun (dir, strategy) ->
2151 len_dir := max !len_dir (String.length dir);
2152 len_strategy := max !len_strategy (String.length strategy)
2153 ) !list;
2154 let fill_dir = String.make (!len_dir - 9) ' ' in
2155 let fill_dir_line = String.make (!len_dir - 9) '-' in
2156 let fill_strategy = String.make (!len_strategy - 4) ' ' in
2157 let fill_strategy_line = String.make (!len_strategy - 4) '-' in
2158 html_mods_cntr_init ();
2159 if html then
2160 html_mods_table_header buf "sharesTable" "shares" [
2161 ( "0", "srh", "Directory", "Directory" ) ;
2162 ( "0", "srh", "Directory type", "Type" ) ;
2163 ( "1", "srh ar", "HDD used", "used" ) ;
2164 ( "1", "srh ar", "HDD free", "free" ) ;
2165 ( "1", "srh ar", "% free", "% free" ) ;
2166 ( "0", "srh", "Filesystem", "FS" ) ]
2167 else
2168 begin
2169 Printf.bprintf buf "\n\t--Diskinfo--\n";
2170 Printf.bprintf buf "Directory%s|Type%s| used| free|%%free|Filesystem\n"
2171 fill_dir fill_strategy;
2172 Printf.bprintf buf "---------%s+----%s+--------+--------+-----+----------\n"
2173 fill_dir_line fill_strategy_line;
2174 end;
2175 List.iter (fun (dir, strategy) ->
2176 let diskused =
2177 match Unix32.diskused dir with
2178 | None -> Printf.sprintf "---"
2179 | Some du -> size_of_int64 du
2181 let diskfree =
2182 match Unix32.diskfree dir with
2183 | None -> Printf.sprintf "---"
2184 | Some df -> size_of_int64 df
2186 let percentfree =
2187 match Unix32.percentfree dir with
2188 | None -> Printf.sprintf "---"
2189 | Some p -> Printf.sprintf "%d%%" p
2191 let filesystem = Unix32.filesystem dir in
2192 if html then
2193 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>
2194 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>
2195 \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>"
2196 (html_mods_cntr ()) dir strategy diskused diskfree percentfree filesystem
2197 else
2198 Printf.bprintf buf "%-*s|%-*s|%8s|%8s|%5s|%-s\n"
2199 (max !len_dir (!len_dir - String.length dir)) dir
2200 (max !len_strategy (!len_strategy - String.length strategy)) strategy
2201 diskused diskfree percentfree filesystem
2202 ) !list;
2203 if html then
2204 Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>"
2206 let print_option_help o option =
2207 let buf = o.conn_buf in
2208 let help_text = get_help option in
2209 if use_html_mods o then
2210 begin
2211 Printf.bprintf buf "\\<div class=\\\"cs\\\"\\>";
2212 html_mods_table_header buf "versionTable" "results" [];
2213 Printf.bprintf buf "\\<tr\\>";
2214 html_mods_td buf [ ("", "srh", "Helptext"); ];
2215 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>";
2216 html_mods_td buf [ ("", "sr", Str.global_replace (Str.regexp "\n") "\\<br\\>" help_text); ];
2217 Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\\</div\\>";
2219 else
2220 Printf.bprintf buf "\n\t--Helptext--\n%s\n" help_text
2222 let dllink_print_result html url header results =
2223 let buf = Buffer.create 100 in
2224 if html then
2225 begin
2226 Printf.bprintf buf "\\<div class=\\\"cs\\\"\\>";
2227 html_mods_table_header buf "dllinkTable" "results" [];
2228 Printf.bprintf buf "\\<tr\\>";
2229 html_mods_td buf [ ("", "srh", header); ];
2230 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>";
2231 html_mods_td buf [ ("", "sr", url); ]
2233 else
2234 Printf.bprintf buf "%s : %s\n" header url;
2235 List.iter (fun s ->
2236 if html then
2237 begin
2238 Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>";
2239 html_mods_td buf [ ("", "sr", s); ]
2241 else
2242 Printf.bprintf buf "%s\n" s) (List.rev results);
2243 if html then Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\\</div\\>";
2244 Buffer.contents buf
2246 let dllink_query_networks html url user group =
2247 let result = ref [] in
2248 if not (networks_iter_until_true (fun n ->
2250 let s,r = network_parse_url n url user group in
2251 if s = "" then
2253 else
2254 let s1 = Printf.sprintf "%s: %s" n.network_name s in
2255 result := s1 :: !result;
2257 with e ->
2258 let s1 = Printf.sprintf "%s: Exception %s"
2259 (n.network_name) (Printexc2.to_string e)
2261 result := s1 :: !result;
2262 false
2263 )) then
2264 dllink_print_result html url "Unable to match URL" !result
2265 else
2266 dllink_print_result html url "Added link" !result
2268 let dllink_parse html url user =
2269 if (String2.starts_with url "http") then (
2270 let u = Url.of_string url in
2271 let module H = Http_client in
2272 let r = {
2273 H.basic_request with
2274 H.req_url = u;
2275 H.req_proxy = !CommonOptions.http_proxy;
2276 H.req_request = H.HEAD;
2277 H.req_max_retry = 10;
2278 H.req_referer = (
2279 let (rule_search,rule_value) =
2280 try (List.find(fun (rule_search,rule_value) ->
2281 Str.string_match (Str.regexp rule_search) u.Url.server 0
2282 ) !!referers )
2283 with Not_found -> ("",Url.to_string u) in
2284 Some (Url.of_string rule_value) );
2285 H.req_headers = (try
2286 let cookies = List.assoc u.Url.server !!cookies in
2287 [ ( "Cookie", List.fold_left (fun res (key, value) ->
2288 if res = "" then
2289 key ^ "=" ^ value
2290 else
2291 res ^ "; " ^ key ^ "=" ^ value
2292 ) "" cookies
2294 with Not_found -> []);
2295 H.req_user_agent = get_user_agent ();
2296 } in
2297 H.whead r (fun headers ->
2298 (* Combine the list of header fields into one string *)
2299 let concat_headers =
2300 (List.fold_right (fun (n, c) t -> n ^ ": " ^ c ^ "\n" ^ t) headers "")
2302 ignore (dllink_query_networks html concat_headers user user.user_default_group)
2304 dllink_print_result html url "Parsing HTTP url" [])
2305 else
2306 if (String2.starts_with url "ftp") then
2307 dllink_query_networks html (Printf.sprintf "Location: %s" url) user user.user_default_group
2308 else
2309 dllink_query_networks html url user user.user_default_group
2311 module UnionFind = struct
2312 type t = int array
2313 let create_sets n =
2314 Array.init n (fun i -> i) (* each element is its own leader *)
2315 let find_leader t i =
2316 let rec fix_point i =
2317 let parent = t.(i) in
2318 if parent <> i then fix_point parent
2319 else i in
2320 let leader = fix_point i in
2321 t.(i) <- leader;
2322 leader
2323 let merge_sets t i j =
2324 let leaderi = find_leader t i in
2325 let leaderj = find_leader t j in
2326 t.(leaderi) <- leaderj
2327 let number_of_sets t =
2328 let nsets = ref 0 in
2329 Array.iteri (fun i ti ->
2330 if i = ti then incr nsets) t;
2331 !nsets
2334 let filenames_variability o list =
2335 (* over this number of filenames, exact variability is not computed
2336 (too expensive) *)
2337 let bypass_threshold = 100 in
2338 (* minimum distance that must exist between two groups of filenames
2339 so they're considered separate *)
2340 let gap_threshold = 4 in
2342 let buf = o.conn_buf in
2344 let is_alphanum = function
2345 | 'A' .. 'Z'
2346 | 'a' .. 'z'
2347 | '0' .. '9' -> true
2348 | _ -> false in
2350 let canonized_words s =
2351 let len = String.length s in
2352 let current_word = Buffer.create len in
2353 let rec outside_word i wl =
2354 if i < len then
2355 if not (is_alphanum s.[i]) then outside_word (i + 1) wl
2356 else begin (* start of a new word *)
2357 Buffer.add_char current_word (Char.lowercase s.[i]);
2358 inside_word (i + 1) wl
2360 else wl
2361 and inside_word i wl =
2362 if i < len then
2363 if not (is_alphanum s.[i]) then begin (* end of the word *)
2364 let wl = Buffer.contents current_word :: wl in
2365 Buffer.reset current_word;
2366 outside_word i wl
2367 end else begin
2368 Buffer.add_char current_word (Char.lowercase s.[i]);
2369 inside_word (i + 1) wl
2371 else Buffer.contents current_word :: wl
2373 outside_word 0 [] in
2375 let costs = {
2376 Levenshtein.insert_cost = 1;
2377 Levenshtein.delete_cost = 1;
2378 Levenshtein.replace_cost = 2 } in
2379 (* we can only assume the distance is symetric if insert and
2380 delete costs are the same *)
2381 assert (costs.Levenshtein.insert_cost = costs.Levenshtein.delete_cost);
2382 let dist = Levenshtein.ForWords.distance costs in
2384 let score_list =
2385 List.map (fun fileinfo ->
2386 (* canonize filenames by keeping only lowercase words, and
2387 sorting them so that initial order doesn't matter;
2388 Remove duplicate canonized filenames *)
2389 let fns = Array.of_list (List.fold_left (fun acc fn ->
2390 let new_fn =
2391 Array.of_list (List.sort String.compare (canonized_words fn)) in
2392 if List.mem new_fn acc then acc else new_fn :: acc
2393 ) [] fileinfo.file_names) in
2395 let nfilenames = Array.length fns in
2396 if nfilenames > bypass_threshold then
2397 fileinfo, bypass_threshold
2398 else
2399 let unionfind_sets = UnionFind.create_sets nfilenames in
2400 for i = 0 to nfilenames - 2 do
2401 let d1 = dist fns.(i) in
2402 for j = i + 1 to nfilenames - 1 do
2403 if d1 fns.(j) < gap_threshold then
2404 UnionFind.merge_sets unionfind_sets i j
2405 done
2406 done;
2407 fileinfo, UnionFind.number_of_sets unionfind_sets
2408 ) list in
2410 (* files with most clusters at the end of results table *)
2411 let sorted_score_list =
2412 List.sort (fun (_, nc1) (_, nc2) -> compare nc1 nc2)
2413 score_list in
2415 let print_table = if o.conn_output = HTML then print_table_html 2
2416 else print_table_text in
2417 print_table buf
2419 Align_Left; Align_Left; Align_Right |]
2421 "Num";
2422 "File";
2423 "Clusters" |]
2424 (List.map (fun (fileinfo, nc) ->
2425 let n = network_find_by_num fileinfo.file_network in
2427 Printf.sprintf "[%-s %5d]" n.network_name (fileinfo.file_num);
2428 shorten fileinfo.file_name 80;
2429 string_of_int nc |]
2430 ) sorted_score_list)
2432 let print_upstats o list server =
2433 let buf = o.conn_buf in
2434 if use_html_mods o then
2435 begin
2436 if !!html_mods_use_js_tooltips then Printf.bprintf buf
2437 "\\<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:
2438 -100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\&nbsp;\\</div\\>";
2440 Printf.bprintf buf "\\<div class=\\\"upstats\\\"\\>";
2441 match server with
2442 None ->
2443 html_mods_table_one_row buf "upstatsTable" "upstats" [
2444 ("", "srh", Printf.sprintf "Session: %s uploaded | Shared(%d): %s\n"
2445 (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes)); ]
2446 | Some s -> let info = server_info s in
2447 html_mods_table_one_row buf "upstatsTable" "upstats" [
2448 ("", "srh", Printf.sprintf "%d files shared on %s (%s:%s)"
2449 info.G.server_published_files info.G.server_name
2450 (Ip.string_of_addr info.G.server_addr)
2451 (string_of_int info.G.server_port)); ]
2453 else
2454 begin
2455 Printf.bprintf buf "Upload statistics:\n";
2456 Printf.bprintf buf "Session: %s uploaded | Shared(%d): %s\n"
2457 (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes)
2458 end;
2460 if use_html_mods o then
2461 html_mods_table_header buf "upstatsTable" "upstats" [
2462 ( "1", "srh", "Total file requests", "Reqs" ) ;
2463 ( "1", "srh", "Total bytes sent", "Total" ) ;
2464 ( "1", "srh", "Upload Ratio", "UPRatio" ) ;
2465 ( "0", "srh", "Preview", "P" ) ;
2466 ( "0", "srh", "Filename", "Filename" );
2467 ( "0", "srh", "Statistic links", "Stats" );
2468 ( "0", "srh", "Published on servers", "Publ" );
2469 ( "0", "srh", "Share status", "Status" )
2471 else
2472 begin
2473 Printf.bprintf buf " Requests | Bytes | Uploaded | File\n";
2474 Printf.bprintf buf "----------+----------+----------+----------------------------------------------------\n";
2475 end;
2477 html_mods_cntr_init ();
2478 let list = List.sort (fun f1 f2 ->
2479 let c = compare f2.impl_shared_requests f1.impl_shared_requests in
2480 if c <> 0 then c else
2481 compare f2.impl_shared_uploaded f1.impl_shared_uploaded
2482 ) list in
2484 List.iter (fun impl ->
2485 if use_html_mods o then
2486 begin
2487 let published = List.length impl.impl_shared_servers in
2488 let ed2k = file_print_ed2k_link
2489 (Filename.basename impl.impl_shared_codedname)
2490 impl.impl_shared_size impl.impl_shared_id in
2492 Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ());
2493 (if !!html_mods_use_js_tooltips then
2494 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)\\\"\\>"
2495 (Http_server.html_real_escaped (Filename.basename (Charset.Locale.to_utf8 impl.impl_shared_codedname)))
2496 (match impl.impl_shared_file with
2497 None -> "no file info"
2498 | Some file -> match file_magic file with | None -> "no magic"
2499 | Some magic -> "File type: " ^ (Http_server.html_real_escaped magic) ^ "<br>")
2500 (if impl.impl_shared_servers = [] then "" else
2501 Printf.sprintf "<br>Published on %d %s<br>%s"
2502 published (if published = 1 then "server" else "servers")
2503 (let listbuf = Buffer.create 100 in
2504 List.iter (fun s -> let info = server_info s in
2505 Printf.bprintf listbuf "%s (%s:%s%s)<br>"
2506 info.server_name
2507 (Ip.string_of_addr info.server_addr)
2508 (string_of_int info.server_port)
2509 (if info.server_realport <> 0
2510 then "(" ^ (string_of_int info.server_realport) ^ ")" else "")
2511 ) impl.impl_shared_servers;
2512 Buffer.contents listbuf))
2513 !!html_mods_js_tooltips_wait
2514 !!html_mods_js_tooltips_timeout
2515 !!html_mods_js_tooltips_wait
2516 else Printf.bprintf buf " onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>");
2518 let uploaded = Int64.to_float impl.impl_shared_uploaded in
2519 let size = Int64.to_float impl.impl_shared_size in
2520 html_mods_td buf [
2521 ("", "sr ar", Printf.sprintf "%d" impl.impl_shared_requests);
2522 ("", "sr ar", size_of_int64 impl.impl_shared_uploaded);
2523 ("", "sr ar", Printf.sprintf "%5.1f" ( if size < 1.0 then 0.0 else (uploaded *. 100.) /. size));
2524 ("", "sr", Printf.sprintf "\\<a href=\\\"preview_upload?q=%d\\\"\\>P\\</a\\>" impl.impl_shared_num);
2525 ("", "sr", (if impl.impl_shared_id = Md4.null then
2526 (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len)
2527 else
2528 Printf.sprintf "\\<a href=\\\"%s\\\"\\>%s\\</a\\>"
2529 ed2k (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len)));
2530 ("", "sr", (if impl.impl_shared_id = Md4.null then "" else
2531 Printf.sprintf "\\<a href=\\\"http://tothbenedek.hu/ed2kstats/ed2k?hash=%s\\\"\\>%s\\</a\\>
2532 \\<a href=\\\"http://ed2k.titanesel.ws/ed2k.php?hash=%s\\\"\\>%s\\</a\\>
2533 \\<a href=\\\"http://bitzi.com/lookup/ed2k:%s\\\"\\>%s\\</a\\>"
2534 (Md4.to_string impl.impl_shared_id) "T1"
2535 (Md4.to_string impl.impl_shared_id) "T2"
2536 (Md4.to_string impl.impl_shared_id) "B"));
2537 ("", "sr ar", Printf.sprintf "%d" published);
2538 ("", "sr", shared_state (as_shared impl) o);
2540 Printf.bprintf buf "\\</tr\\>\n";
2542 else
2543 Printf.bprintf buf "%9d | %8s | %7s%% | %-50s\n"
2544 (impl.impl_shared_requests)
2545 (size_of_int64 impl.impl_shared_uploaded)
2546 (Printf.sprintf "%3.1f" ((Int64.to_float impl.impl_shared_uploaded *. 100.) /. Int64.to_float impl.impl_shared_size))
2547 (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len)
2548 ) list;
2550 if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>\\</div\\>"