src/daemon/common/commonOptions.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   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.
   9
  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.
  14
  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
  18 *)
  19
  20 open Gettext
  21 open Printf2
  22 open Md4
  23 open BasicSocket
  24 open TcpBufferedSocket
  25 open Options
  26 open Unix
  27 open CommonTypes
  28
  29 let log_prefix = "[cO]"
  30
  31 let lprintf_nl fmt =
  32   lprintf_nl2 log_prefix fmt
  33
  34 let lprintf_n fmt =
  35   lprintf2 log_prefix fmt
  36
  37 let _s x = _s "CommonOptions" x
  38 let _b x = _b "CommonOptions" x
  39
  40 let startup_message = ref ""
  41
  42 let bin_dir = Filename.dirname Sys.argv.(0)
  43
  44 let hidden_dir_prefix =
  45   if Autoconf.windows then "" else "."
  46
  47 let config_dir_basename = hidden_dir_prefix ^ "mldonkey"
  48
  49 let pid_filename = Printf.sprintf "%s.pid" (Filename.basename Sys.argv.(0))
  50
  51 let security_space_filename = "config_files_space.tmp"
  52
  53 let home_dir =
  54   match Autoconf.system with
  55   | "cygwin"
  56   | "mingw" -> "."
  57   | _ -> Filename.concat (try Sys.getenv "HOME" with _ -> ".") config_dir_basename
  58
  59 let installer_ini = create_options_file (Filename.concat home_dir
  60       "installer.ini")
  61
  62 let installer_section = file_section installer_ini [] ""
  63
  64 let created_new_base_directory = ref None
  65
  66 let mldonkey_directory = define_option installer_section ["mldonkey_directory"]
  67   "The directory where mldonkey's option files are"
  68     string_option home_dir
  69
  70 let _ =
  71   (try Options.load installer_ini with _ -> ())
  72
  73 let file_basedir_pre =
  74   try
  75     if (String2.starts_with
  76           (Filename.basename Sys.argv.(0))  "mlgui")
  77     then raise Exit;
  78     let chroot_dir = Sys.getenv "MLDONKEY_CHROOT" in
  79     try
  80       Unix.chdir chroot_dir;
  81       let new_passwd = Filename.concat chroot_dir "/etc/passwd" in
  82       if not (Sys.file_exists new_passwd) then
  83         lprintf_nl "No /etc/passwd in your chroot directory\n create one if you want to use 'run_as_user' option";
  84       MlUnix.chroot chroot_dir;
  85       lprintf_nl "mldonkey is now running in %s"  chroot_dir;
  86         "."
  87
  88     with e ->
  89         lprintf_nl "Exception %s trying to chroot %s"
  90           (Printexc2.to_string e) chroot_dir;
  91         exit 2
  92   with _ ->
  93         try
  94           let s = Sys.getenv "MLDONKEY_DIR" in
  95           if s = "" then home_dir else Filename2.normalize s
  96         with _ ->
  97             home_dir
  98
  99 let file_basedir =
 100 (* Creating dirs does work differently on Windows than Unix.
 101    Dirs like c:\b are split down by unix2.safe_mkdir to "c".
 102    This function splits the directory name into the drive name
 103    and chdir to it before creating directories.
 104    Non-absolute paths in $MLDONKEY_DIR do not work as well *)
 105   if Sys.file_exists (Filename.concat (Sys.getcwd ()) "downloads.ini") then
 106     "."
 107   else
 108     if Autoconf.windows && file_basedir_pre <> home_dir then
 109       match String2.split file_basedir_pre ':' with
 110       | drive :: directory :: _ ->
 111           Unix.chdir (drive ^ ":\\");
 112           directory
 113       | _ -> lprintf "Please provide an absolute path in MLDONKEY_DIR like d:\\mldonkey, exiting...\n"; exit 2
 114     else file_basedir_pre
 115
 116 let exit_message file = Printf.sprintf
 117 "\nThis means another MLDonkey process could still be working
 118 in this directory. Please shut it down before starting
 119 a new instance here. If you are sure no other process uses
 120 this directory delete %s and restart the core.\n" file
 121
 122 let exit_message_dev file exit = Printf.sprintf
 123 "\n/dev/%s does not exist, please create it%s
 124 If you are using a chroot environment, create it inside the chroot.\n"
 125   file (if exit then ", exiting..." else "")
 126
 127 let windows_sleep seconds =
 128   lprintf_nl "waiting %d seconds to exit..." seconds;
 129   Unix.sleep seconds
 130
 131 let min_reserved_fds = 50
 132 let min_connections = 50
 133
 134 let _ =
 135   lprintf_nl "Starting MLDonkey %s ... " Autoconf.current_version;
 136   let ulof_old = Unix2.c_getdtablesize () in
 137   lprintf_nl "Language %s, locale %s, ulimit for open files %d"
 138     Charset.default_language Charset.locstr ulof_old;
 139
 140   let nofile = Unix2.ml_getrlimit Unix2.RLIMIT_NOFILE in
 141     if nofile.Unix2.rlim_max > 0 && nofile.Unix2.rlim_max > nofile.Unix2.rlim_cur then
 142       Unix2.ml_setrlimit Unix2.RLIMIT_NOFILE nofile.Unix2.rlim_max;
 143   let ulof = Unix2.c_getdtablesize () in
 144   if ulof_old <> ulof then
 145     lprintf_nl "raised ulimit for open files from %d to %d" ulof_old ulof;
 146   let absolute_min = Unix32.max_cache_size_default +
 147     min_reserved_fds + min_connections in
 148   if ulof < absolute_min then begin
 149     lprintf_nl "ulimit for open files is set to %d, at least %d is required, exiting..." ulof absolute_min;
 150     exit 2
 151   end;
 152
 153   lprintf_nl "MLDonkey is working in %s" file_basedir;
 154   if not (Sys.file_exists file_basedir) ||
 155          not (Sys.file_exists (Filename.concat file_basedir "downloads.ini")) then begin
 156     lprint_newline ();
 157     lprintf_nl "creating new MLDonkey base directory in %s\n" file_basedir;
 158     created_new_base_directory := Some file_basedir
 159   end;
 160   (try
 161      Unix2.safe_mkdir file_basedir
 162    with e ->
 163      lprintf_nl "Exception (%s) trying to create dir %s"
 164        (Printexc2.to_string e) file_basedir;
 165      exit 2);
 166   Unix2.can_write_to_directory file_basedir;
 167   Unix.chdir file_basedir;
 168
 169   let filename =
 170     try
 171       Sys.getenv "MLDONKEY_STRINGS"
 172     with _ ->
 173         "mlnet_strings"
 174   in
 175   set_strings_file filename;
 176   lprintf_nl (_b "loaded language resource file");
 177
 178   let uname = Unix32.uname () in
 179   if uname = "" then
 180     begin
 181       lprintf_nl "Unknown operating system, please report to the MLDonkey development team";
 182       lprintf_nl "at http://savannah.nongnu.org/bugs/?group=mldonkey"
 183     end
 184   else
 185     if not (Unix32.os_supported ()) then begin
 186       lprintf_nl "WARNING: MLDonkey is not supported on %s" uname;
 187       if Autoconf.windows then
 188         lprintf_nl "WARNING: MLDonkey is only supported on Windows NT/2000/XP/Server 2003."
 189     end;
 190
 191   if (String2.starts_with (Filename.basename Sys.argv.(0)) "mlnet")
 192     && not Autoconf.windows && not (Autoconf.system = "morphos")
 193     && Autoconf.donkey_sui = "yes" && not (Sys.file_exists "/dev/urandom") then
 194     begin
 195       Autoconf.donkey_sui_urandom := false;
 196       lprintf "%s" (exit_message_dev "urandom" false);
 197       if Autoconf.system = "hpux" then
 198         lprintf_nl "For HP-UX get urandom support from http://www.josvisser.nl/hpux11-random";
 199     end
 200   else
 201     Autoconf.donkey_sui_urandom := true;
 202
 203   if (String2.starts_with (Filename.basename Sys.argv.(0)) "mlnet")
 204     && not Autoconf.windows && not (Sys.file_exists "/dev/null") then begin
 205       lprintf "%s" (exit_message_dev "null" true);
 206       exit 2
 207     end;
 208
 209   (* Charset conversion self-test *)
 210   let filename = "abcdefghijklmnopqrstuvwxyz" in
 211   let conv_filename = Charset.to_locale filename in
 212   if filename <> conv_filename then Charset.conversion_enabled := false;
 213
 214   Unix2.can_write_to_directory (Filename2.temp_directory ());
 215
 216   if (String2.starts_with (Filename.basename Sys.argv.(0)) "mlnet") then begin
 217     if Sys.file_exists pid_filename then begin
 218       lprintf_nl "PID file %s exists." (Filename.concat file_basedir pid_filename);
 219       let pid =
 220         try
 221           Unix2.tryopen_read pid_filename (fun pid_ci ->
 222           int_of_string (input_line pid_ci))
 223         with _ ->
 224           lprintf_nl "But it couldn't be read to check if the process still exists.";
 225           lprintf_nl "To avoid doing any harm, MLDonkey will now stop.";
 226           if Autoconf.windows then windows_sleep 10;
 227           exit 2
 228       in
 229       try
 230         lprintf_nl "Checking whether PID %d is still used..." pid;
 231         Unix.kill pid 0;
 232         lprintf "%s" (exit_message pid_filename);
 233         exit 2
 234       with (* stalled pid file, disregard it *)
 235       | Unix.Unix_error (Unix.ESRCH, _, _) ->
 236           lprintf_nl "Removing stalled file %s..." pid_filename;
 237           (try Sys.remove pid_filename with _ -> ())
 238       | e ->
 239           lprintf "%s" (exit_message pid_filename);
 240           if Autoconf.system = "mingw" then lprintf_nl
 241             "can not check for stalled pid file because Unix.kill is not implemented on MinGW";
 242           lprintf_nl "Exception %s, exiting..." (Printexc2.to_string e);
 243           if Autoconf.system = "mingw" then windows_sleep 10;
 244           exit 2
 245     end;
 246     if Sys.file_exists security_space_filename then begin
 247       try
 248         let security_space_oc =
 249           Unix.openfile security_space_filename [Unix.O_WRONLY; Unix.O_CREAT] 0o600 in
 250         Unix.lockf security_space_oc Unix.F_TLOCK 0;
 251         Unix.close security_space_oc;
 252         lprintf_nl "Removing stalled file %s..."
 253           (Filename.concat file_basedir security_space_filename);
 254         begin
 255           try
 256             (try Unix.close security_space_oc with _ -> ());
 257             Sys.remove security_space_filename
 258           with e ->
 259             lprintf_nl "can not remove %s: %s"
 260               (Filename.concat file_basedir security_space_filename)
 261               (Printexc2.to_string e);
 262             if Autoconf.windows then windows_sleep 10;
 263             exit 2
 264         end
 265       with
 266         Unix.Unix_error ((Unix.EAGAIN | Unix.EACCES), _, _) ->
 267           lprintf_nl "%s exists and is locked by another process."
 268             (Filename.concat file_basedir security_space_filename);
 269           lprintf "%s" (exit_message security_space_filename);
 270           if Autoconf.windows then windows_sleep 10;
 271           exit 2
 272       | e ->
 273           lprintf_nl "error while checking file %s: %s"
 274             (Filename.concat file_basedir security_space_filename)
 275             (Printexc2.to_string e);
 276           lprintf "%s" (exit_message security_space_filename);
 277           if Autoconf.windows then windows_sleep 10;
 278           exit 2
 279     end
 280   end
 281
 282 let define_option a b ?desc ?restart ?public ?internal c d e =
 283   match desc with
 284     None -> define_option a b (_s c) d e ?restart ?public ?internal
 285   | Some desc -> define_option a b ~desc: (_s desc) (_s c) d e ?restart ?public ?internal
 286
 287 let define_expert_option a b ?desc ?restart ?public ?internal c d e =
 288   match desc with
 289     None -> define_expert_option a b (_s c) d e ?restart ?public ?internal
 290   | Some desc -> define_expert_option a b ~desc: (_s desc) (_s c) d e ?restart ?public ?internal
 291
 292 let html_themes_dir = "html_themes"
 293 let downloads_ini = create_options_file "downloads.ini"
 294 let servers_ini = create_options_file "servers.ini"
 295 let searches_ini = create_options_file "searches.ini"
 296 let results_ini = create_options_file "results.ini"
 297 let files_ini = create_options_file "files.ini"
 298 let friends_ini = create_options_file "friends.ini"
 299
 300 let messages_log = ref "messages.log"
 301
 302 let servers_section = file_section servers_ini [] ""
 303
 304 let ip_list_option = list_option Ip.option
 305
 306 let ip_range_list_option = list_option Ip.range_option
 307
 308 let int_list_option = list_option int_option
 309
 310 let string_list_option = list_option string_option
 311
 312 let allow_browse_share_option = define_option_class "Integer"
 313     (fun v ->
 314       match v with
 315         StringValue "true" -> 2
 316       | StringValue "false" -> 0
 317       | _ -> value_to_int v)
 318   int_to_value
 319
 320 let addr_option  =  define_option_class "Addr"
 321     (fun value ->
 322       let s = value_to_string value in
 323       let addr, port = String2.cut_at s ':' in
 324       addr, int_of_string port)
 325       (fun (addr, port) -> string_to_value (Printf.sprintf "%s:%d" addr port))
 326
 327 let _ =
 328   Options.set_string_wrappers ip_list_option
 329     (fun list ->
 330       List.fold_left (fun s ip ->
 331           Printf.sprintf "%s %s" (Ip.to_string ip) s
 332       ) "" list
 333   )
 334   (fun s ->
 335       let list = String2.tokens s in
 336       List.map (fun ip -> Ip.of_string ip) list
 337   );
 338
 339   Options.set_string_wrappers ip_range_list_option
 340     (fun list ->
 341       String.concat " " (List.map Ip.string_of_range (List.rev list))
 342   )
 343   (fun s ->
 344       let list = String2.tokens s in
 345       List.map (fun ip -> Ip.range_of_string ip) list
 346   );
 347
 348   Options.set_string_wrappers int_list_option
 349     (fun list ->
 350       List.fold_left (fun s i ->
 351           Printf.sprintf "%s %s" (string_of_int i) s
 352       ) "" (List.rev list)
 353   )
 354   (fun s ->
 355       let list = String2.tokens s in
 356       List.map (fun i -> int_of_string i) list
 357   );
 358   Options.set_string_wrappers string_list_option
 359   (String.concat " ")
 360   String2.tokens
 361
 362 let is_not_spam = ref (fun _ -> true)
 363 let is_not_comment_spam = ref (fun _ -> true)
 364
 365
 366
 367
 368 (*************************************************************************)
 369 (*                                                                       *)
 370 (*                         BASIC OPTIONS                                 *)
 371 (*                                                                       *)
 372 (*************************************************************************)
 373
 374 let _ = Random.self_init ()
 375
 376 let random_letter () =
 377   char_of_int (97 + Random.int 26)
 378
 379 let new_name () =
 380   (Printf.sprintf "%c%c%c%c%c%c"
 381     (random_letter ()) (random_letter ()) (random_letter ())
 382     (random_letter ()) (random_letter ()) (random_letter ()))
 383
 384
 385 let main_section = file_section downloads_ini ["Main"]
 386   "Main options"
 387 let interfaces_section = file_section downloads_ini ["Interfaces"]
 388   "Options to control ports used by mldonkey interfaces"
 389 let bandwidth_section = file_section downloads_ini ["Bandwidth"]
 390   "Bandwidth options"
 391 let networks_section = file_section downloads_ini ["Networks"]
 392   "Networks options"
 393 let network_section = file_section downloads_ini ["Network Config"]
 394   "Network config options"
 395 let html_section = file_section downloads_ini ["HTML mods"]
 396   "Options to configure HTML mode"
 397 let debug_section = file_section downloads_ini ["Debug"]
 398   "Debug options"
 399 let download_section = file_section downloads_ini ["Download"]
 400   "Download options"
 401 let startup_section = file_section downloads_ini ["Startup"]
 402   "Startup options"
 403 let mail_section = file_section downloads_ini ["Mail"]
 404   "Mail options"
 405 let path_section = file_section downloads_ini ["Paths"]
 406   "Paths options"
 407 let security_section = file_section downloads_ini ["Security"]
 408   "Security options"
 409 let other_section = file_section downloads_ini ["Other"]
 410   "Other options"
 411
 412
 413
 414
 415 (*************************************************************************)
 416 (*                                                                       *)
 417 (*                         Main section                                  *)
 418 (*                                                                       *)
 419 (*************************************************************************)
 420
 421 let current_section = main_section
 422
 423 let global_login = define_option current_section ["client_name"]
 424   "small name of client"
 425     string_option (new_name ())
 426
 427
 428
 429
 430 (*************************************************************************)
 431 (*                                                                       *)
 432 (*                         Interfaces section                            *)
 433 (*                                                                       *)
 434 (*************************************************************************)
 435
 436 let current_section = interfaces_section
 437
 438 let allowed_ips = define_option current_section ["allowed_ips"]
 439   ~desc: "Allowed IPs"
 440   "list of IP address allowed to connect to the core via telnet/GUI/WEB
 441   for internal command set: list separated by spaces
 442   example for internal command: set allowed_ips \"127.0.0.0/8 192.168.1.2\"
 443   or for editing the ini-file: list separated by semi-colon
 444   example for ini-file: allowed_ips = [ \"127.0.0.0/8\"; \"192.168.1.2\";]
 445   CIDR and range notations are supported: ie use 192.168.0.0/24
 446   or 192.168.0.0-192.168.0.255 for 192.168.0.*"
 447     ip_range_list_option [ Ip.RangeSingleIp Ip.localhost ]
 448
 449 let allowed_ips_set = ref Ip_set.BL_Empty
 450
 451 let _ =
 452   option_hook allowed_ips (fun _ ->
 453     let new_list = ref [] in
 454     List.iter (fun i ->
 455         let new_range =
 456           match i with
 457           | Ip.RangeSingleIp ip ->
 458             (let a, b, c, d = Ip.to_ints ip in
 459               match a = 255, b = 255, c = 255, d = 255 with
 460               |  true,  true,  true,  true -> Ip.RangeCIDR (Ip.null, 0)
 461               | false,  true,  true,  true -> Ip.RangeCIDR ((Ip.of_string (Printf.sprintf "%d.0.0.0" a)), 8)
 462               | false, false,  true,  true -> Ip.RangeCIDR ((Ip.of_string (Printf.sprintf "%d.%d.0.0" a b)), 16)
 463               | false, false, false,  true -> Ip.RangeCIDR ((Ip.of_string (Printf.sprintf "%d.%d.%d.0" a b c)), 24)
 464               | false, false, false, false -> i
 465               | _ -> i)
 466           | Ip.RangeRange (ip1, ip2) -> i
 467           | Ip.RangeCIDR (ip, shift) -> i
 468         in
 469         if i <> new_range then
 470           lprintf_nl "allowed_ips: converted %s to %s" (Ip.string_of_range i) (Ip.string_of_range new_range);
 471         new_list := new_range :: !new_list
 472     ) !!allowed_ips;
 473     new_list := if !new_list = [] then [ Ip.localhost_range ] else List.rev !new_list;
 474     if !new_list <> !!allowed_ips then allowed_ips =:= !new_list;
 475     allowed_ips_set := (Ip_set.of_list !!allowed_ips))
 476
 477
 478 let gui_port = define_option current_section ["gui_port"]
 479   ~desc: "The port to connect the GUI"
 480   ~restart: true
 481   "port for Graphical Interfaces, 0 to deactivate GUI interface"
 482     port_option 4001
 483
 484 let gift_port = define_option current_section ["gift_port"]
 485   ~desc: "The port to connect for GiFT GUIs."
 486   ~restart: true
 487   "port for GiFT Graphical Interfaces interaction. It was 1213, but the default is
 488   now 0 for disabled, because it does not check for a password."
 489     port_option 0
 490
 491 let http_port = define_option current_section ["http_port"]
 492   ~desc: "The port to connect via HTTP"
 493   ~public: true
 494   ~restart: true
 495   "The port used to connect to your client with a web browser, 0 to deactivate web interface"
 496     port_option 4080
 497
 498 let telnet_port = define_option current_section ["telnet_port"]
 499   ~desc: "The port to connect via telnet"
 500   ~restart: true
 501   "port for user interaction, 0 to deactivate telnet interface"
 502     port_option 4000
 503
 504 let http_bind_addr = define_expert_option current_section ["http_bind_addr"]
 505   ~restart: true
 506   "The IP address used to bind the http server"
 507     Ip.option (Ip.any)
 508
 509 let gui_bind_addr = define_expert_option current_section ["gui_bind_addr"]
 510   ~restart: true
 511   "The IP address used to bind the gui server"
 512     Ip.option (Ip.of_inet_addr Unix.inet_addr_any)
 513
 514 let telnet_bind_addr = define_expert_option current_section ["telnet_bind_addr"]
 515   ~restart: true
 516   "The IP address used to bind the telnet server"
 517     Ip.option (Ip.of_inet_addr Unix.inet_addr_any)
 518
 519 let print_all_sources = define_expert_option current_section ["print_all_sources"]
 520   "Should *all* sources for a file be shown on HTML/telnet vd <num>"
 521     bool_option true
 522
 523 let improved_telnet = define_expert_option current_section ["improved_telnet"]
 524   "Improved telnet interface"
 525     bool_option true
 526
 527 let alias_commands = define_option current_section ["alias_commands"]
 528   "Aliases to commands. The alias (fist string) has to be
 529   whitespaceless, the outcome of the alias (second string)
 530   may have spaces (put it in quotation then)."
 531     (list_option (tuple2_option (string_option, string_option)))
 532     [ "quit", "q";
 533       "exit", "q";
 534     ]
 535
 536 let verbosity = define_expert_option current_section ["verbosity"]
 537   "A space-separated list of keywords. Each keyword triggers
 538   printing information on the corresponding messages:
 539   verb : verbose mode (interesting not only for coders)
 540   mc : debug client messages
 541   mr|raw : debug raw messages
 542   mct : debug emule clients tags
 543   ms : debug server messages
 544   sm : debug source management
 545   net : debug net
 546   gui : debug gui
 547   no-login : disable login messages
 548   file : debug file handling
 549   do : some download warnings
 550   up : some upload warnings
 551   unk : unknown messages
 552   ov : overnet
 553   loc : debug source research/master servers
 554   share: debug sharing
 555   md4 : md4 computation
 556   connect : debug connections
 557   udp : udp messages
 558   ultra|super : debug supernode
 559   swarming : debug swarming
 560   hc : http_client messages
 561   hs : http_server messages
 562   com : commands by non-admin users
 563   act : debug activity
 564   bw : debug bandwidth
 565   geo : debug GeoIP
 566   unexp : debug unexpected messages"
 567     string_option ""
 568
 569
 570
 571
 572 (*************************************************************************)
 573 (*                                                                       *)
 574 (*                         Bandwidth section                             *)
 575 (*                                                                       *)
 576 (*************************************************************************)
 577
 578 let current_section = bandwidth_section
 579
 580 let max_hard_upload_rate = define_option current_section ["max_hard_upload_rate"]
 581   "The maximal upload rate you can tolerate on your link in kBytes/s (0 = no limit)
 582   The limit will apply on all your connections (clients and servers) and both
 583   control and data messages."
 584     int_option 10
 585
 586 let max_hard_download_rate = define_option current_section ["max_hard_download_rate"]
 587   "The maximal download rate you can tolerate on your link in kBytes/s (0 = no limit)
 588   The limit will apply on all your connections (clients and servers) and both
 589   control and data messages. Maximum value depends on max_hard_upload_rate:
 590   >= 10    -> unlimited download
 591   < 10 > 3 -> download limited to upload * 4
 592   < 4      -> download limited to upload * 3"
 593     int_option 50
 594
 595 let max_hard_upload_rate_2 = define_option current_section ["max_hard_upload_rate_2"]
 596     "Second maximal upload rate for easy toggling (use bw_toggle)"
 597     int_option 5
 598
 599 let max_hard_download_rate_2 = define_option current_section ["max_hard_download_rate_2"]
 600     "Second maximal download rate for easy toggling (use bw_toggle)"
 601     int_option 20
 602
 603 let max_opened_connections = define_option current_section ["max_opened_connections"]
 604   "Maximal number of opened connections"
 605     int_option 200
 606
 607 let max_indirect_connections = define_option current_section ["max_indirect_connections"]
 608   "Amount of indirect connections in percent (min 30, max 70) of max_opened_connections"
 609     int_option 30
 610
 611 let max_upload_slots = define_option current_section ["max_upload_slots"]
 612   "How many slots can be used for upload"
 613     int_option 5
 614
 615 let max_release_slots = define_option current_section ["max_release_slots"]
 616   "How many percent of upload slots can be used for downloading files tagged as release"
 617     percent_option 20
 618
 619 let friends_upload_slot = define_option current_section ["friends_upload_slot"]
 620   "Set aside a single reserved slot to upload to friends"
 621     bool_option true
 622
 623 let small_files_slot_limit = define_option current_section ["small_files_slot_limit"]
 624   "Maximum file size to benefit from the reserved slot for small files (0 to disable)"
 625     int64_option 10240L
 626
 627 let dynamic_slots = define_option current_section ["dynamic_slots"]
 628   "Set this to true if you want to have dynamic upload slot allocation (experimental)"
 629     bool_option false
 630
 631 let max_connections_per_second = define_option current_section ["max_connections_per_second"]
 632   "Maximal number of connections that can be opened per second"
 633     int_option 5
 634
 635 let loop_delay = define_expert_option current_section ["loop_delay"]
 636   "The delay in milliseconds to wait in the event loop. Can be decreased to
 637   increase the bandwidth usage, or increased to lower the CPU usage."
 638     int_option 5
 639
 640 let nolimit_ips = define_option current_section ["nolimit_ips"]
 641   ~desc: "No-limit IPs"
 642   "list of IP addresses allowed to connect to the core with no limit on
 643   upload/download and upload slots.  List separated by spaces, wildcard=255
 644   ie: use 192.168.0.255 for 192.168.0.* "
 645     ip_list_option [Ip.localhost]
 646
 647 let copy_read_buffer = define_option current_section ["copy_read_buffer"]
 648   "This option enables MLdonkey to always read as much data as possible
 649   from a channel, but use more CPU as it must then copy the data in the
 650   channel buffer."
 651     bool_option true
 652
 653
 654
 655
 656 (*************************************************************************)
 657 (*                                                                       *)
 658 (*                         Networks section                              *)
 659 (*                                                                       *)
 660 (*************************************************************************)
 661
 662 let current_section = networks_section
 663
 664 let enable_overnet = define_option current_section ["enable_overnet"]
 665   "Set to true if you also want mldonkey to run as an overnet client
 666   (enable_donkey must be true)"
 667     bool_option false
 668
 669 let enable_kademlia = define_option current_section ["enable_kademlia"]
 670   "Set to true if you also want mldonkey to run as an kademlia client
 671   (enable_donkey must be true, and only experimental)"
 672     bool_option false
 673
 674 let enable_servers = define_option current_section ["enable_servers"]
 675   "Set to true if you want mldonkey to connect to edonkey servers
 676   (enable_donkey must be true, and only experimental)"
 677     bool_option true
 678
 679 let enable_bittorrent = define_option current_section ["enable_bittorrent"]
 680   "Set to true if you also want mldonkey to run as an Bittorrent client"
 681     bool_option false
 682
 683 let enable_donkey = define_option current_section ["enable_donkey"]
 684   "Set to true if you also want mldonkey to run as a donkey client"
 685     bool_option false
 686
 687 let enable_opennap = define_option current_section ["enable_opennap"]
 688   "Set to true if you also want mldonkey to run as a napster client (experimental)"
 689     bool_option false
 690
 691 let enable_soulseek = define_option current_section ["enable_soulseek"]
 692   "Set to true if you also want mldonkey to run as a soulseek client (experimental)"
 693     bool_option false
 694
 695 let enable_gnutella = define_option current_section ["enable_gnutella"]
 696   "Set to true if you also want mldonkey to run as a gnutella1 sub node (experimental)"
 697     bool_option false
 698
 699 let enable_gnutella2 = define_option current_section ["enable_gnutella2"]
 700   "Set to true if you also want mldonkey to run as a gnutella2 sub node (experimental)"
 701     bool_option false
 702
 703 let enable_fasttrack = define_option current_section ["enable_fasttrack"]
 704   "Set to true if you also want mldonkey to run as a Fasttrack sub node (experimental)"
 705     bool_option false
 706
 707 let enable_directconnect = define_option current_section ["enable_directconnect"]
 708   "Set to true if you also want mldonkey to run as a direct-connect node (experimental)"
 709     bool_option false
 710
 711 let enable_openft = define_expert_option current_section ["enable_openft"]
 712   "Set to true if you also want mldonkey to run as a OpenFT sub node (experimental)"
 713     bool_option false
 714
 715 let enable_fileTP = define_option current_section ["enable_fileTP"]
 716   "Set to true if you also want mldonkey to download HTTP files (experimental)"
 717     bool_option true
 718
 719
 720
 721
 722 (*************************************************************************)
 723 (*                                                                       *)
 724 (*                         HTML section                                  *)
 725 (*                                                                       *)
 726 (*************************************************************************)
 727
 728 let current_section = html_section
 729
 730 let html_mods = define_expert_option current_section ["html_mods"]
 731   "Whether to use the modified WEB interface"
 732     bool_option true
 733
 734 let html_mods_style = define_expert_option current_section ["html_mods_style"]
 735   "Which html_mods style to use (set with html_mods_style command)"
 736     int_option 0
 737
 738 let html_mods_human_readable = define_expert_option current_section ["html_mods_human_readable"]
 739   "Whether to use human readable GMk number format"
 740     bool_option true
 741
 742 let html_mods_use_relative_availability = define_expert_option current_section ["html_mods_use_relative_availability"]
 743   "Whether to use relative availability in the WEB interface"
 744     bool_option true
 745
 746 let html_mods_vd_network = define_expert_option current_section ["html_mods_vd_network"]
 747   "Whether to display the Net column in vd output"
 748     bool_option true
 749
 750 let html_mods_vd_comments = define_expert_option current_section ["html_mods_vd_comments"]
 751   "Whether to display the Comments column in vd output"
 752     bool_option true
 753
 754 let html_mods_vd_user = define_expert_option current_section ["html_mods_vd_user"]
 755   "Whether to display the User column in vd output"
 756     bool_option false
 757
 758 let html_mods_vd_group = define_expert_option current_section ["html_mods_vd_group"]
 759   "Whether to display the Group column in vd output"
 760     bool_option false
 761
 762 let html_mods_vd_active_sources = define_expert_option current_section ["html_mods_vd_active_sources"]
 763   "Whether to display the Active Sources column in vd output"
 764     bool_option true
 765
 766 let html_mods_vd_age = define_expert_option current_section ["html_mods_vd_age"]
 767   "Whether to display the Age column in vd output"
 768     bool_option true
 769
 770 let html_flags = define_expert_option current_section ["html_flags"]
 771   "Whether to display flags instead of country codes"
 772     bool_option true
 773
 774 let html_mods_vd_gfx = define_expert_option current_section ["html_mods_vd_gfx"]
 775   "Show graph in vd output"
 776     bool_option true
 777
 778 let html_mods_vd_gfx_remove = define_expert_option current_section ["html_mods_vd_gfx_remove"]
 779   "Remove graph files on core shutdown"
 780     bool_option false
 781
 782 let html_mods_vd_gfx_fill = define_expert_option current_section ["html_mods_vd_gfx_fill"]
 783   "Fill graph in vd output"
 784     bool_option true
 785
 786 let html_mods_vd_gfx_split = define_expert_option current_section ["html_mods_vd_gfx_split"]
 787   "Split download and upload graph in vd output"
 788     bool_option false
 789
 790 let html_mods_vd_gfx_stack = define_expert_option current_section ["html_mods_vd_gfx_stack"]
 791   "Stacked download and upload graph"
 792     bool_option true
 793
 794 let html_mods_vd_gfx_flip = define_expert_option current_section ["html_mods_vd_gfx_flip"]
 795   "Flip up/side graph position in vd output"
 796     bool_option true
 797
 798 let html_mods_vd_gfx_mean = define_expert_option current_section ["html_mods_vd_gfx_mean"]
 799   "Show mean line on graph in vd output"
 800     bool_option true
 801
 802 let html_mods_vd_gfx_transparent = define_expert_option current_section ["html_mods_vd_gfx_transparent"]
 803   "Show transparent graph in vd output (only for png)"
 804     bool_option true
 805
 806 let html_mods_vd_gfx_png = define_expert_option current_section ["html_mods_vd_gfx_png"]
 807   "Draw graph as png if true, else draw as jpg in vd output"
 808     bool_option true
 809
 810 let html_mods_vd_gfx_h = define_expert_option current_section ["html_mods_vd_gfx_h"]
 811   "Show hourly graph in vd output"
 812     bool_option true
 813
 814 let html_mods_vd_gfx_x_size = define_expert_option current_section ["html_mods_vd_gfx_x_size"]
 815   "Graph x size in vd output ( 365 < x < 3665 )"
 816     int_option 795
 817
 818 let html_mods_vd_gfx_y_size = define_expert_option current_section ["html_mods_vd_gfx_y_size"]
 819   "Graph y size in vd output ( 200 < y < 1200 )"
 820     int_option 200
 821
 822 let html_mods_vd_gfx_h_intervall = define_expert_option current_section ["html_mods_vd_gfx_h_intervall"]
 823   ~restart: true
 824   "compute values for hourly graph every 1,2,3,4,5,10,15,20,30,60 min
 825         Changes to this option require a core restart."
 826      int_option 60
 827
 828 let html_mods_vd_gfx_h_dynamic = define_expert_option current_section ["html_mods_vd_gfx_h_dymamic"]
 829   "Dynamic grid width, start with 1 h/grid, maximum html_mods_vd_gfx_h_grid_time h/grid"
 830     bool_option true
 831
 832 let html_mods_vd_gfx_h_grid_time = define_expert_option current_section ["html_mods_vd_gfx_h_grid_time"]
 833   "Max hours on time scale per grid (0 = no limit)"
 834     int_option 0
 835
 836 let html_mods_vd_gfx_subgrid = define_expert_option current_section ["html_mods_vd_gfx_subgrid"]
 837   "Number of shown subgrids on graph (0 = no subgrids)"
 838     int_option 0
 839
 840 let html_mods_vd_gfx_tag = define_expert_option current_section ["html_mods_vd_gfx_tag"]
 841   "Draw tag graph"
 842     bool_option false
 843
 844 let html_mods_vd_gfx_tag_use_source = define_expert_option current_section ["html_mods_vd_gfx_tag_use_source"]
 845   "Use tag source image "
 846     bool_option false
 847
 848 let html_mods_vd_gfx_tag_source = define_expert_option current_section ["html_mods_vd_gfx_tag_source"]
 849   "Tag source image name"
 850     string_option "image"
 851
 852 let html_mods_vd_gfx_tag_png = define_expert_option current_section ["html_mods_vd_gfx_tag_png"]
 853   "Draw tag as png if true, else draw as jpg in vd output"
 854     bool_option true
 855
 856 let html_mods_vd_gfx_tag_enable_title = define_expert_option current_section ["html_mods_vd_gfx_tag_enable_title"]
 857   "Enable tag graph title"
 858     bool_option true
 859
 860 let html_mods_vd_gfx_tag_title = define_expert_option current_section ["html_mods_vd_gfx_tag_title"]
 861   "Tag graph title"
 862     string_option "MLNet traffic"
 863
 864 let html_mods_vd_gfx_tag_title_x_pos = define_expert_option current_section ["html_mods_vd_gfx_tag_title_x_pos"]
 865   "Tag graph title x pos in vd output"
 866     int_option 4
 867
 868 let html_mods_vd_gfx_tag_title_y_pos = define_expert_option current_section ["html_mods_vd_gfx_tag_title_y_pos"]
 869   "Tag graph title y pos in vd output"
 870     int_option 1
 871
 872 let html_mods_vd_gfx_tag_dl_x_pos = define_expert_option current_section ["html_mods_vd_gfx_tag_dl_x_pos"]
 873   "Tag graph download x pos in vd output"
 874     int_option 4
 875
 876 let html_mods_vd_gfx_tag_dl_y_pos = define_expert_option current_section ["html_mods_vd_gfx_tag_dl_y_pos"]
 877   "Tag graph download y pos in vd output"
 878     int_option 17
 879
 880 let html_mods_vd_gfx_tag_ul_x_pos = define_expert_option current_section ["html_mods_vd_gfx_tag_ul_x_pos"]
 881   "Tag graph upload x pos in vd output"
 882     int_option 4
 883
 884 let html_mods_vd_gfx_tag_ul_y_pos = define_expert_option current_section ["html_mods_vd_gfx_tag_ul_y_pos"]
 885   "Tag graph upload y pos in vd output"
 886     int_option 33
 887
 888 let html_mods_vd_gfx_tag_x_size = define_expert_option current_section ["html_mods_vd_gfx_tag_x_size"]
 889   "Tag graph x size in vd output ( 130 < x < 3600 )"
 890     int_option 80
 891
 892 let html_mods_vd_gfx_tag_y_size = define_expert_option current_section ["html_mods_vd_gfx_tag_y_size"]
 893   "Tag graph y size in vd output ( 50 < x < 1200 )"
 894     int_option 50
 895
 896 let html_mods_vd_last = define_expert_option current_section ["html_mods_vd_last"]
 897   "Whether to display the Last column in vd output"
 898     bool_option true
 899
 900 let html_mods_vd_prio = define_expert_option current_section ["html_mods_vd_prio"]
 901   "Whether to display the Priority column in vd output"
 902     bool_option true
 903
 904 let html_vd_barheight = define_expert_option current_section ["html_vd_barheight"]
 905   "Change height of download indicator bar in vd output"
 906     int_option 2
 907
 908 let html_vd_chunk_graph = define_expert_option current_section ["html_vd_chunk_graph"]
 909   "Whether to display chunks list as graph or text in vd output"
 910     bool_option true
 911
 912 let html_vd_chunk_graph_style = define_expert_option current_section ["html_vd_chunk_graph_style"]
 913   "Change style of chunk graph"
 914     int_option 0
 915
 916 let html_vd_chunk_graph_max_width = define_expert_option current_section ["html_vd_chunk_graph_max_width"]
 917   "Change max width of chunk graph"
 918     int_option 200
 919
 920 let html_mods_show_pending = define_expert_option current_section ["html_mods_show_pending"]
 921   "Whether to display the pending slots in uploaders command"
 922     bool_option true
 923
 924 let html_mods_load_message_file = define_expert_option current_section ["html_mods_load_message_file"]
 925   "Whether to load the mldonkey_messages.ini file (false=use internal settings)"
 926     bool_option false
 927
 928 let html_mods_max_messages = define_expert_option current_section ["html_mods_max_messages"]
 929   "Maximum chat messages to log in memory"
 930     int_option 50
 931
 932 let html_mods_bw_refresh_delay = define_option current_section ["html_mods_bw_refresh_delay"]
 933   "bw_stats refresh delay (seconds)"
 934     int_option 11
 935
 936 let html_mods_theme = define_option current_section ["html_mods_theme"]
 937   "html_mods_theme to use (located in relative html_themes/<theme_name> directory
 938   leave blank to use internal theme"
 939     string_option ""
 940
 941 let use_html_mods o =
 942   o.conn_output = HTML && !!html_mods
 943
 944 let html_checkbox_vd_file_list = define_expert_option current_section ["html_checkbox_vd_file_list"]
 945   "Whether to use checkboxes in the WEB interface for download list"
 946     bool_option true
 947
 948 let html_checkbox_search_file_list = define_expert_option current_section ["html_checkbox_search_file_list"]
 949   "Whether to use checkboxes in the WEB interface for search result list"
 950     bool_option false
 951
 952 let html_use_gzip = define_expert_option current_section ["html_use_gzip"]
 953   "Use gzip compression on web pages"
 954     bool_option false
 955
 956 let html_mods_use_js_tooltips = define_expert_option current_section ["html_mods_use_js_tooltips"]
 957   "Whether to use the fancy javascript tooltips or plain html-title"
 958     bool_option true
 959
 960 let html_mods_js_tooltips_wait = define_expert_option current_section ["html_mods_js_tooltips_wait"]
 961   "How long to wait before displaying the tooltips"
 962     int_option 0
 963
 964 let html_mods_js_tooltips_timeout = define_expert_option current_section ["html_mods_js_tooltips_timeout"]
 965   "How long to display the tooltips"
 966     int_option 100000
 967
 968 let html_mods_use_js_helptext = define_expert_option current_section ["html_mods_use_js_helptext"]
 969   "Use javascript to display option help text as js popup (true=use js, false=use html tables)"
 970     bool_option true
 971
 972
 973
 974
 975 (*************************************************************************)
 976 (*                                                                       *)
 977 (*                         Network section                               *)
 978 (*                                                                       *)
 979 (*************************************************************************)
 980
 981 let current_section = network_section
 982
 983 let set_client_ip = define_option current_section ["client_ip"]
 984   "The last IP address used for this client" Ip.option
 985     (Ip.my ())
 986
 987 let force_client_ip = define_option current_section ["force_client_ip"]
 988   "Use the IP specified by 'client_ip' instead of trying to determine it
 989   ourself. Don't set this option to true if you have dynamic IP."
 990     bool_option false
 991
 992 let discover_ip = define_option current_section ["discover_ip"]
 993   "Use http://ip.discoveryvip.com/ip.asp to obtain WAN IP"
 994     bool_option true
 995
 996 let user_agent = define_option current_section ["user_agent"]
 997   "User agent string (default = \"default\")"
 998     string_option "default"
 999
1000 let get_user_agent () =
1001   if !!user_agent = "default" then
1002      Printf.sprintf "MLDonkey/%s" Autoconf.current_version
1003   else !!user_agent
1004
1005 let web_infos = define_option current_section ["web_infos"]
1006   "A list of lines to download on the WEB: each line has
1007   the format: (kind, period, url), where kind is either
1008   'server.met' for a server.met file (also in gz/bz2/zip format)
1009                containing ed2k server, or
1010   'comments.met' for a file of comments, or
1011   'guarding.p2p' for a blocklist file (also in gz/bz2/zip format), or
1012   'ocl' for file in the ocl format containing overnet peers, or
1013   'contact.dat' for an contact.dat file containing overnet peers,
1014   'nodes.gzip' for a fasttrack nodes.gzip,
1015   and period is the period between updates (in hours),
1016   a period of zero means the file is only loaded once on startup,
1017   and url is the url of the file to download.
1018   IMPORTANT: Put the URL and the kind between quotes.
1019   EXAMPLE:
1020     web_infos = [
1021     (\"server.met\", 0, \"http://www.gruk.org/server.met.gz\");
1022     (\"hublist\", 0, \"http://dchublist.com/hublist.config.bz2\");
1023     (\"guarding.p2p\", 96, \"http://www.bluetack.co.uk/config/level1.gz\");
1024     (\"ocl\", 24, \"http://members.lycos.co.uk/appbyhp2/FlockHelpApp/contact-files/contact.ocl\");
1025     (\"contact.dat\", 168, \"http://download.overnet.org/contact.dat\");
1026     (\"geoip.dat\", 168, \"http://www.maxmind.com/download/geoip/database/GeoIP.dat.gz\");
1027     ]
1028   "
1029     (list_option (tuple3_option (string_option, int_option, string_option)))
1030     [
1031       ("guarding.p2p", 96,
1032         "http://www.bluetack.co.uk/config/level1.gz");
1033       ("server.met", 0,
1034         "http://www.gruk.org/server.met.gz");
1035       ("contact.dat", 168,
1036         "http://download.overnet.org/contact.dat");
1037       ("geoip.dat", 0,
1038         "http://www.maxmind.com/download/geoip/database/GeoIP.dat.gz");
1039       ("nodes.gzip", 0,
1040         "http://update.kceasy.com/update/fasttrack/nodes.gzip");
1041       ("hublist", 0,
1042         "http://dchublist.com/hublist.config.bz2");
1043 (*
1044     ("slsk_boot", 0,
1045       "http://www.slsknet.org/slskinfo2");
1046 *)
1047     ]
1048
1049 let rss_feeds = define_expert_option current_section ["rss_feeds"]
1050   "URLs of RSS feeds"
1051     (list_option Url.option) []
1052
1053 let rss_preprocessor = define_expert_option current_section ["rss_preprocessor"]
1054   "If MLDonkey can not read broken RSS feeds, use this program to preprocess them"
1055     string_option "xmllint"
1056
1057 let ip_blocking_descriptions = define_expert_option current_section ["ip_blocking_descriptions"]
1058   "Keep IP blocking ranges descriptions in memory"
1059     bool_option false
1060
1061 let ip_blocking = define_expert_option current_section ["ip_blocking"]
1062   "IP blocking list filename (peerguardian format), can also be in gz/bz2/zip format
1063   Zip files must contain either a file named guarding.p2p or guarding_full.p2p."
1064     string_option ""
1065
1066 let ip_blocking_countries = define_expert_option current_section ["ip_blocking_countries"]
1067   "List of countries to block connections from/to (requires Geoip).
1068   Names are in ISO 3166 format, see http://www.maxmind.com/app/iso3166
1069   You can also at your own risk use \"Unknown\" for IPs Geoip won't recognize."
1070     string_list_option []
1071
1072 let ip_blocking_countries_block = define_expert_option current_section ["ip_blocking_countries_block"]
1073   "false: use ip_blocking_countries as block list, all other countries are allowed
1074   true: use ip_blocking_countries as allow list, all other countries are blocked"
1075     bool_option false
1076
1077 let geoip_dat = define_expert_option current_section ["geoip_dat"]
1078   "Location of GeoIP.dat (Get one from http://www.maxmind.com/download/geoip/database/)"
1079     string_option ""
1080
1081 let _ =
1082   option_hook ip_blocking_descriptions (fun _ ->
1083     Ip_set.store_blocking_descriptions := !!ip_blocking_descriptions
1084   )
1085
1086 let tcpip_packet_size = define_expert_option current_section ["tcpip_packet_size"]
1087   "The size of the header of a TCP/IP packet on your connection (ppp adds
1088   14 bytes sometimes, so modify to take that into account)"
1089     int_option 40
1090
1091 let mtu_packet_size = define_expert_option current_section ["mtu_packet_size"]
1092   "The size of the MTU of a TCP/IP packet on your connection"
1093     int_option 1500
1094
1095 let minimal_packet_size = define_expert_option current_section ["minimal_packet_size"]
1096   "The size of the minimal packet you want mldonkey to send when data is
1097   available on the connection"
1098     int_option !TcpBufferedSocket.minimal_packet_size
1099
1100 let socket_keepalive = define_expert_option current_section ["socket_keepalive"]
1101   "Should a connection check if the peer we are connected to is still alive?
1102   This implies some bandwidth-cost (with 200 connections ~10-20%)"
1103     bool_option !BasicSocket.socket_keepalive
1104
1105 let referers = define_option current_section ["referers"]
1106   "Cookies send with a http request (used for .torrent files and web_infos)"
1107     (list_option (tuple2_option (string_option, string_option))) [(".*suprnova.*", "http://www.suprnova.org/")]
1108
1109 let cookies = define_option current_section ["cookies"]
1110   "Cookies send with a http request (used for .torrent files and web_infos)"
1111     (list_option (tuple2_option (string_option, list_option (tuple2_option (string_option, string_option))))) []
1112
1113 let http_proxy_server = define_option current_section ["http_proxy_server"]
1114   "Direct HTTP queries to HTTP proxy"
1115     string_option ""
1116
1117 let http_proxy_port = define_option current_section ["http_proxy_port"]
1118   "Port of HTTP proxy"
1119     port_option 8080
1120
1121 let http_proxy_tcp = define_option current_section ["http_proxy_tcp"]
1122   "Direct TCP connections to HTTP proxy (the proxy should support CONNECT)"
1123     bool_option false
1124
1125
1126
1127
1128 (*************************************************************************)
1129 (*                                                                       *)
1130 (*                         Mail section                                  *)
1131 (*                                                                       *)
1132 (*************************************************************************)
1133
1134 let current_section = mail_section
1135
1136 let smtp_server = define_option current_section ["smtp_server"]
1137   "The mail server you want to use (must be SMTP). Use hostname or IP address"
1138     string_option "127.0.0.1"
1139
1140 let smtp_port = define_option current_section ["smtp_port"]
1141   "The port to use on the mail server (default 25)"
1142     port_option 25
1143
1144 let mail = define_option current_section ["mail"]
1145   "Your e-mail if you want to receive mails when downloads are completed"
1146     string_option ""
1147
1148 let add_mail_brackets = define_option current_section ["add_mail_brackets"]
1149   "Does your mail-server need <...> around addresses"
1150     bool_option false
1151
1152 let filename_in_subject = define_option current_section ["filename_in_subject"]
1153   "Send filename in mail subject"
1154     bool_option true
1155
1156 let url_in_mail = define_option current_section ["url_in_mail"]
1157   "Put a prefix for the filename here which shows up in the notification mail"
1158     string_option ""
1159
1160
1161
1162
1163 (*************************************************************************)
1164 (*                                                                       *)
1165 (*                         Download section                              *)
1166 (*                                                                       *)
1167 (*************************************************************************)
1168
1169 let current_section = download_section
1170
1171 let auto_commit = define_option current_section ["auto_commit"]
1172   "Set to false if you don't want mldonkey to automatically put completed files
1173   in incoming directory"
1174     bool_option true
1175
1176 let pause_new_downloads = define_option current_section ["pause_new_downloads"]
1177   "Set to true if you want all new downloads be paused immediatly
1178   will be set to false on core start."
1179     bool_option false
1180
1181 (*  emulate_sparsefiles does not work, temporarily disabled
1182 let emulate_sparsefiles = define_expert_option current_section ["emulate_sparsefiles"]
1183   "Set to true if you want MLdonkey to emulate sparse files on your disk.
1184   Files will use less space, but <preview> and <recover> won't work anymore.
1185   Works only on Edonkey plugin. EXPERIMENTAL."
1186     bool_option false
1187 *)
1188
1189 let max_concurrent_downloads = define_option current_section ["max_concurrent_downloads"]
1190   "The maximal number of files in Downloading state (other ones are Queued)"
1191     int_option 50
1192
1193 let sources_per_chunk = define_expert_option current_section ["sources_per_chunk"]
1194   "How many sources to use to download each chunk"
1195     int_option 3
1196
1197 let max_recover_gap = define_option current_section ["max_recover_zeroes_gap"]
1198   "The maximal length of zero bytes between non-zero bytes in a file that
1199   should be interpreted as downloaded during a recovery"
1200     int64_option 16L
1201
1202 let file_completed_cmd = define_option current_section ["file_completed_cmd"]
1203   "A command that is called when a file is committed, does not work on MinGW.
1204   Arguments are (kept for compatability):
1205     $1 - temp file name, without path
1206     $2 - file size
1207     $3 - filename of the committed file
1208   Also these environment variables can be used (prefered way):
1209     $TEMPNAME  - temp file name, including path
1210     $FILEID    - same as $1
1211     $FILESIZE  - same as $2
1212     $FILENAME  - same as $3
1213     $FILEHASH  - internal hash
1214     $DURATION  - download duration
1215     $INCOMING  - directory used for commit
1216     $NETWORK   - network used for downloading
1217     $ED2K_HASH - ed2k hash if MD4 is known
1218     $FILE_OWNER - user who started the download
1219     $FILE_GROUP - group the file belongs to
1220     $USER_MAIL - mail address of file_owner
1221   "
1222     string_option ""
1223
1224 let file_started_cmd = define_option current_section ["file_started_cmd"]
1225   "The command which is called when a download is started. Arguments
1226   are '-file <num>'
1227   Also these environment variables can be used (prefered way):
1228     $TEMPNAME  - temp file name, including path
1229     $FILEID    - same as $1
1230     $FILESIZE  - same as $2
1231     $FILENAME  - same as $3
1232     $FILEHASH  - internal hash
1233     $NETWORK   - network used for downloading
1234     $ED2K_HASH - ed2k hash if MD4 is known
1235     $FILE_OWNER - user who started the download
1236     $FILE_GROUP - group the file belongs to
1237     $USER_MAIL - mail address of file_owner
1238   "
1239     string_option ""
1240
1241
1242
1243 (*************************************************************************)
1244 (*                                                                       *)
1245 (*                         Startup section                               *)
1246 (*                                                                       *)
1247 (*************************************************************************)
1248
1249 let current_section = startup_section
1250
1251 let run_as_user = define_option current_section ["run_as_user"]
1252   ~restart: true
1253   "The login of the user you want mldonkey to run as, after the ports
1254   have been bound (can be use not to run with root priviledges when
1255   a port < 1024 is needed)"
1256     string_option ""
1257
1258 let run_as_useruid = define_option current_section ["run_as_useruid"]
1259   ~restart: true
1260   "The UID of the user (0=disabled) you want mldonkey to run as, after the ports
1261   have been bound (can be use not to run with root priviledges when
1262   a port < 1024 is needed)"
1263     int_option 0
1264
1265 let ask_for_gui = define_option current_section ["ask_for_gui"]
1266   "Ask for GUI start"
1267     bool_option false
1268
1269 let start_gui = define_option current_section ["start_gui"]
1270   "Automatically Start the GUI"
1271     bool_option false
1272
1273 let recover_temp_on_startup = define_option current_section ["recover_temp_on_startup"]
1274   "Should MLdonkey try to recover downloads of files in temp/ at startup"
1275     bool_option true
1276
1277 let config_files_security_space = define_expert_option current_section ["config_files_security_space"]
1278   ~restart: true
1279   "How many megabytes should MLdonkey keep for saving configuration files."
1280     int_option 10
1281
1282
1283
1284
1285 (*************************************************************************)
1286 (*                                                                       *)
1287 (*                         Path section                                  *)
1288 (*                                                                       *)
1289 (*************************************************************************)
1290
1291 let current_section = path_section
1292
1293 let temp_directory = define_option current_section ["temp_directory"]
1294   "The directory where temporary files should be put"
1295     string_option "temp"
1296
1297 let share_scan_interval = define_option current_section ["share_scan_interval"]
1298   ~restart: true
1299   "How often (in minutes) should MLDonkey scan all shared directories for new/removed files.
1300   Minimum 5, 0 to disable. Use command reshare to manually scan shares.
1301   When core starts, shared directories are scanned once, independent of this option."
1302     int_option 30
1303
1304 let create_file_mode = define_option current_section ["create_file_mode"]
1305   "New download files are created with these rights (in octal)"
1306     string_option "664"
1307
1308 let create_dir_mode = define_option current_section ["create_dir_mode"]
1309   "New directories in incoming_directories are created with these rights (in octal)"
1310     string_option "755"
1311
1312 let create_file_sparse = define_option current_section ["create_file_sparse"]
1313   "Create new files as sparse, only valid on MinGW for files on NTFS drives"
1314     bool_option true
1315
1316 let hdd_temp_minfree = define_option current_section ["hdd_temp_minfree"]
1317   "Mininum free space in MB on temp_directory, minimum 50"
1318     int_option 50
1319
1320 let hdd_temp_stop_core = define_option current_section ["hdd_temp_stop_core"]
1321   "If true core shuts down when free space on temp dir is below hdd_temp_minfree,
1322   otherwise all downloads are paused and a warning email is sent."
1323     bool_option false
1324
1325 let hdd_coredir_minfree = define_option current_section ["hdd_coredir_minfree"]
1326   "Mininum free space in MB on core directory, minimum 20"
1327     int_option 50
1328
1329 let hdd_coredir_stop_core = define_option current_section ["hdd_coredir_stop_core"]
1330   "If true core shuts down when free space on core dir is below hdd_coredir_minfree,
1331   otherwise all downloads are paused and a warning email is sent."
1332     bool_option true
1333
1334 let hdd_send_warning_interval = define_option current_section ["hdd_send_warning_interval"]
1335   "Send a warning mail each <interval> hours for each directory, 0 to deactivate mail warnings."
1336     int_option 1
1337
1338 let previewer = define_expert_option current_section ["previewer"]
1339   "Name of program used for preview (first arg is local filename, second arg
1340   is name of file as searched on eDonkey"
1341     string_option "mldonkey_previewer"
1342
1343 let mldonkey_bin = define_expert_option current_section ["mldonkey_bin"]
1344   "Directory where mldonkey binaries are installed"
1345     string_option bin_dir
1346
1347 let mldonkey_gui = define_expert_option current_section ["mldonkey_gui"]
1348   "Name of GUI to start"
1349     string_option (Filename.concat bin_dir "mlgui")
1350
1351
1352
1353
1354 (*************************************************************************)
1355 (*                                                                       *)
1356 (*                         Security section                              *)
1357 (*                                                                       *)
1358 (*************************************************************************)
1359
1360 let current_section = security_section
1361
1362 let allowed_commands = define_option current_section ["allowed_commands"]
1363   "Commands that you are allowed to be call from the interface. These
1364   commands should short, so that the core is not blocked more than necessary."
1365     (list_option (tuple2_option (string_option, string_option)))
1366     [ "df", "df";
1367       "ls", "ls incoming";
1368     ]
1369
1370 let allow_any_command = define_option current_section ["allow_any_command"]
1371   "Allow you to use any command with ! in the interface instead of only the
1372   ones in allowed_commands"
1373     bool_option false
1374
1375 let allow_browse_share = define_option current_section ["allow_browse_share"]
1376   "Allow others to browse our share list (0: none, 1: friends only, 2: everyone"
1377     allow_browse_share_option 1
1378
1379 let messages_filter = define_option current_section ["messages_filter"]
1380   "Regexp of messages to filter out, example: string1|string2|string3"
1381     string_option "DI-Emule|ZamBoR|Ketamine|eMule FX|AUTOMATED MESSAGE|Hi Honey!|Do you live in my area|download HyperMule"
1382
1383 let comments_filter = define_option current_section ["comments_filter"]
1384   "Regexp of comments to filter out, example: string1|string2|string3"
1385     string_option "http://|https://|www\\."
1386
1387
1388
1389
1390 (*************************************************************************)
1391 (*                                                                       *)
1392 (*                         Other section                                 *)
1393 (*                                                                       *)
1394 (*************************************************************************)
1395
1396 let current_section = other_section
1397
1398 let save_results = define_option current_section ["save_results"]
1399   "(experimental)"
1400     int_option 0
1401
1402 let buffer_writes = define_option current_section ["buffer_writes"]
1403   "Buffer writes and flush after buffer_writes_delay seconds (experimental)"
1404     bool_option false
1405
1406 let buffer_writes_delay = define_expert_option current_section ["buffer_writes_delay"]
1407   ~restart: true
1408   "Buffer writes and flush after buffer_writes_delay seconds (experimental)"
1409     float_option 30.
1410
1411 let buffer_writes_threshold = define_expert_option current_section ["buffer_writes_threshold"]
1412   "Flush buffers if buffers exceed buffer_writes_threshold kB (experimental)"
1413     int_option 1024
1414
1415 let emule_mods_count = define_option current_section ["emule_mods_count"]
1416   "build statistics about eMule mods"
1417     bool_option false
1418
1419 let emule_mods_showall = define_option current_section ["emule_mods_showall"]
1420   "show all eMule mods in statistics"
1421     bool_option false
1422
1423 let backup_options_delay = define_option current_section ["backup_options_delay"]
1424   "How often (in hours) should a backup of the ini files be written into old_config.
1425   A value of zero means that a backup is written only when the core shuts down."
1426     int_option 0
1427
1428 let backup_options_generations = define_option current_section ["backup_options_generations"]
1429   "Define the total number of options archives in old_config."
1430     int_option 10
1431
1432 let backup_options_format = define_option current_section ["backup_options_format"]
1433   "Define the format of the archive, zip or tar.gz are valid."
1434     string_option "tar.gz"
1435
1436 let shutdown_timeout = define_option current_section ["shutdown_timeout"]
1437   "The maximum time in seconds to wait for networks to cleanly shutdown."
1438     int_option 3
1439
1440
1441 (*************************************************************************)
1442 (*                                                                       *)
1443 (*                         EXPERT OPTIONS                                *)
1444 (*                                                                       *)
1445 (*************************************************************************)
1446
1447 let safe_utf8 s =
1448   if Charset.is_utf8 s
1449   then s
1450   else failwith (Printf.sprintf "%s is not an UTF-8 string.\n" s)
1451
1452 let value_to_utf8 v =
1453   let s = Options.value_to_string v in
1454   safe_utf8 s
1455
1456 let utf8_to_value s =
1457   let s = safe_utf8 s in
1458   Options.string_to_value s
1459
1460 let utf8_option =
1461   define_option_class "Utf8"
1462   value_to_utf8 utf8_to_value
1463
1464 let utf8_filename_conversions = define_expert_option current_section ["utf8_filename_conversions"]
1465   "The conversions to apply on Unicode characters"
1466     (list_option (tuple2_option (int_option, utf8_option))) []
1467
1468 let interface_buffer = define_expert_option current_section ["interface_buffer"]
1469   "The size of the buffer between the client and its GUI. Can be useful
1470   to increase when the connection between them has a small bandwith"
1471     int_option 1000000
1472
1473 let max_name_len = define_expert_option current_section ["max_name_len"]
1474   "The size long names will be shortened to in the interface"
1475     int_option 50
1476
1477 let max_filenames = define_expert_option current_section ["max_filenames"]
1478   "The maximum number of different filenames used by MLDonkey"
1479     int_option 50
1480
1481 let max_client_name_len = define_expert_option current_section ["max_client_name_len"]
1482   "The size long client names will be shortened to in the interface"
1483     int_option 25
1484
1485 let term_ansi = define_expert_option current_section ["term_ansi"]
1486   "Is the default terminal an ANSI terminal (escape sequences can be used)"
1487     bool_option true
1488
1489 let update_gui_delay = define_expert_option current_section ["update_gui_delay"]
1490    "Delay between updates to the GUI"
1491      float_option 1.
1492
1493 let http_realm = define_expert_option current_section ["http_realm"]
1494   "The realm shown when connecting with a WEB browser"
1495     string_option "MLdonkey"
1496
1497 let html_frame_border = define_expert_option current_section ["html_frame_border"]
1498   "This option controls whether the WEB interface should show frame borders or not"
1499     bool_option true
1500
1501 let commands_frame_height = define_expert_option current_section ["commands_frame_height"]
1502   "The height of the command frame in pixel (depends on your screen and browser sizes)"
1503     int_option 46
1504
1505 let motd_html = define_expert_option current_section ["motd_html"]
1506   "Message printed at startup additional to welcome text"
1507     string_option ""
1508
1509 let compaction_delay = define_expert_option current_section ["compaction_delay"]
1510   "Force compaction every <n> hours (in [1..24])"
1511     int_option 2
1512
1513 let vd_reload_delay = define_expert_option current_section ["vd_reload_delay"]
1514   "The delay between reloads of the vd output in the WEB interface"
1515     int_option 120
1516
1517 let client_bind_addr = define_option current_section ["client_bind_addr"]
1518   ~restart: true
1519   "The IP address used to bind the p2p clients"
1520     Ip.option (Ip.of_inet_addr Unix.inet_addr_any)
1521
1522 let _ =
1523   option_hook client_bind_addr (fun _ ->
1524       TcpBufferedSocket.bind_address := Ip.to_inet_addr !!client_bind_addr
1525   )
1526
1527 let _ =
1528   option_hook copy_read_buffer (fun _ ->
1529       TcpBufferedSocket.copy_read_buffer := !!copy_read_buffer
1530   )
1531
1532 let () =
1533   option_hook create_file_mode (fun _ ->
1534       Unix32.create_file_mode := Misc.int_of_octal_string !!create_file_mode
1535   );
1536   option_hook create_dir_mode (fun _ ->
1537       Unix32.create_dir_mode := Misc.int_of_octal_string !!create_dir_mode
1538   )
1539
1540 let create_mlsubmit = define_expert_option current_section ["create_mlsubmit"]
1541   "Should the MLSUBMIT.REG file be created"
1542     bool_option true
1543
1544 let minor_heap_size = define_expert_option current_section ["minor_heap_size"]
1545   "Size of the minor heap in kB"
1546     int_option 32
1547
1548 let relevant_queues = define_expert_option current_section ["relevant_queues"]
1549   "The source queues to display in source lists (see 'sources' command)"
1550     int_list_option [0;1;2;3;4;5;6;8;9;10]
1551
1552 let min_reask_delay = define_expert_option current_section ["min_reask_delay"]
1553   "The minimal delay between two connections to the same client (in seconds)"
1554     int_option 600
1555
1556 let display_downloaded_results = define_expert_option current_section ["display_downloaded_results"]
1557   "Whether to display results already downloaded"
1558     bool_option true
1559
1560 let filter_table_threshold = define_expert_option current_section ["filter_table_threshold"]
1561   "Minimal number of results for filter form to appear"
1562     int_option 50
1563
1564 let client_buffer_size = define_expert_option current_section ["client_buffer_size"]
1565   "Maximal size in byte of the buffers of a client, minimum 50.000 byte.
1566 For high-volume links raise this value to 1.000.000 or higher."
1567     int_option 500000
1568
1569 let save_options_delay = define_expert_option current_section ["save_options_delay"]
1570   ~restart: true
1571   "The delay between two saves of the 'downloads.ini' file (default is 15 minutes).
1572   Changes to this option require a core restart."
1573     float_option 900.0
1574
1575 let server_connection_timeout = define_expert_option current_section ["server_connection_timeout"]
1576   "timeout when connecting to a server"
1577     float_option 30.
1578
1579 let download_sample_rate = define_expert_option current_section ["download_sample_rate"]
1580   ~restart: true
1581   "The delay between one glance at a file and another"
1582     float_option 1.
1583
1584 let download_sample_size = define_expert_option current_section ["download_sample_size"]
1585   "How many samples go into an estimate of transfer rates"
1586     int_option 100
1587
1588 let calendar = define_expert_option current_section ["calendar"]
1589   "This option defines a set of date at which some commands have to be executed.
1590   For each tuple, the first argument is a list of week days (from 0 to 6),
1591   the second is a list of hours (from 0 to 23) and the last one a command to
1592   execute. Can be used with 'pause all' and 'resume all' for example to
1593   resume and pause downloads automatically for the night."
1594     (list_option (tuple3_option (list_option int_option,list_option int_option, string_option)))
1595     []
1596
1597 let compaction_overhead = define_expert_option current_section ["compaction_overhead"]
1598   "The percentage of free memory before a compaction is triggered"
1599     int_option 25
1600
1601 let space_overhead = define_expert_option current_section ["space_overhead"]
1602   "The major GC speed is computed from this parameter. This is the memory
1603   that will be \"wasted\" because the GC does not immediatly collect
1604   unreachable blocks. It is expressed as a percentage of the memory used
1605   for live data. The GC will work more (use more CPU time and collect
1606   blocks more eagerly) if space_overhead is smaller."
1607     percent_option 80
1608
1609 let max_displayed_results = define_expert_option current_section ["max_displayed_results"]
1610   "Maximal number of results displayed for a search"
1611     int_option 1000
1612
1613 let options_version = define_expert_option current_section ["options_version"]
1614   ~internal: true
1615   "(internal option)"
1616     int_option 20
1617
1618 let max_comments_per_file = define_expert_option current_section ["max_comments_per_file"]
1619   "Maximum number of comments per file"
1620   int_option 100
1621
1622 let max_comment_length = define_expert_option current_section ["max_comment_length"]
1623   "Maximum length of file comments"
1624   int_option 256
1625
1626
1627 (*************************************************************************)
1628 (*                                                                       *)
1629 (*                         Debug section                                 *)
1630 (*                                                                       *)
1631 (*************************************************************************)
1632
1633 let current_section = debug_section
1634
1635 let allow_local_network = define_expert_option current_section ["allow_local_network"]
1636   "If this option is set, IP addresses on the local network are allowed
1637   (only for debugging)"
1638      bool_option false
1639
1640 let log_size = define_expert_option current_section ["log_size"]
1641   "size of log in number of records"
1642     int_option 300
1643
1644 let log_file_size = define_expert_option current_section ["log_file_size"]
1645    "Maximum size of log_file in MB, this value is only checked on startup,
1646    log_file will be deleted if its bigger than log_file_size."
1647      int_option 2
1648
1649 let log_file = define_expert_option current_section ["log_file"]
1650   "The file in which you want mldonkey to log its debug messages. If you
1651   set this option, mldonkey will log this info in the file until you use the
1652   'close_log' command. The log file may become very large. You can
1653   also enable logging in a file after startup using the 'log_file' command."
1654     string_option "mlnet.log"
1655
1656 let log_to_syslog = define_expert_option current_section ["log_to_syslog"]
1657   "Post log messages to syslog. This setting is independent of log_file
1658   and its associated commands, therefore close_log does not stop log to syslog.
1659   Its therefore possible to log to syslog and log_file at the same time."
1660     bool_option false
1661
1662 let gui_log_size = define_expert_option current_section ["gui_log_size"]
1663   "number of lines for GUI console messages"
1664     int_option 30
1665
1666
1667
1668
1669 (*************************************************************************)
1670 (*                                                                       *)
1671 (*                         HOOKS On options                              *)
1672 (*                                                                       *)
1673 (*************************************************************************)
1674
1675 let current_section = other_section
1676
1677 let last_high_id = ref Ip.null
1678
1679 let client_ip sock =
1680   if !!force_client_ip then !!set_client_ip
1681   else
1682     if !last_high_id <> Ip.null then
1683       begin
1684         if Ip.usable !last_high_id && !!set_client_ip <> !last_high_id then
1685           set_client_ip =:= !last_high_id;
1686         !last_high_id
1687       end
1688     else
1689       match sock with
1690         None -> !!set_client_ip
1691       | Some sock ->
1692           let ip = TcpBufferedSocket.my_ip sock in
1693           if Ip.usable ip && !!set_client_ip <> ip then
1694             set_client_ip =:= ip;
1695           ip
1696
1697 let start_running_plugins = ref false
1698
1699 let filter_search_delay = 5.0
1700
1701 (* Infer which nets to start depending on the name used *)
1702 let _ =
1703   let name = String.lowercase (Filename.basename Sys.argv.(0)) in
1704   let name = try
1705       let pos = String.index name '+' in
1706       String.sub name 0 pos
1707     with _ -> name in
1708   let name = try
1709       let pos = String.index name '.' in
1710       String.sub name 0 pos
1711     with _ -> name in
1712
1713   match name with
1714   | "mldc" -> enable_directconnect =:= true
1715   | "mlgnut" -> enable_gnutella =:= true
1716   | "mldonkey" -> enable_donkey =:= true; enable_overnet =:= true
1717   | "mlslsk" -> enable_soulseek =:= true
1718   | "mlbt" -> enable_bittorrent =:= true
1719   | "mlnap" -> enable_opennap =:= true
1720   | _ ->
1721 (* default *)
1722       enable_donkey =:= true;
1723       enable_overnet =:= true;
1724       enable_bittorrent =:= true
1725
1726 let win_message =
1727 "\n\nNEVER close this window with the close button
1728 on the top right corner of this window!
1729 Instead use the kill command in Telnet or HTML,
1730 the kill function of a GUI or CTRL+C.\n\n"
1731
1732 let real_max_indirect_connections = ref 0
1733
1734 let calc_real_max_indirect_connections () =
1735   real_max_indirect_connections :=
1736     !!max_opened_connections * !!max_indirect_connections / 100
1737
1738 let _ =
1739   option_hook max_indirect_connections (fun _ ->
1740     begin
1741       if !!max_indirect_connections > 70 then max_indirect_connections =:= 70
1742       else if !!max_indirect_connections < 30 then max_indirect_connections =:= 30
1743     end;
1744     calc_real_max_indirect_connections ()
1745   );
1746   option_hook min_reask_delay (fun _ ->
1747     if !!min_reask_delay < 600 then min_reask_delay =:= 600
1748   );
1749   option_hook share_scan_interval (fun _ ->
1750     if !!share_scan_interval < 5 && !!share_scan_interval <> 0 then share_scan_interval =:= 5
1751   );
1752   option_hook global_login (fun _ ->
1753       let len = String.length !!global_login in
1754       let prefix = "mldonkey_" in
1755       let prefix_len = String.length prefix in
1756       if len > prefix_len &&
1757         String.sub !!global_login 0 prefix_len = prefix then
1758         global_login =:= new_name ()
1759   );
1760
1761   let lprintf_to_file = ref false in
1762   option_hook log_file (fun _ ->
1763       if !!log_file <> "" then
1764         try
1765     if Unix32.file_exists !!log_file then
1766       if (Unix32.getsize !!log_file)
1767        > (Int64ops.megabytes !!log_file_size) then begin
1768         Sys.remove !!log_file;
1769               lprintf_nl (_b "Logfile %s reset: bigger than %d MB") !!log_file !!log_file_size
1770       end;
1771           let oc = open_out_gen [Open_creat; Open_wronly; Open_append] 0o644 !!log_file in
1772           lprintf_to_file := true;
1773           if Autoconf.system = "cygwin" then lprintf "%s" win_message;
1774           lprintf_nl (_b "Logging in %s") ( Filename.concat file_basedir !!log_file);
1775           log_to_file oc;
1776     lprintf_nl "Started logging..."
1777         with e ->
1778             lprintf_nl "Exception %s while opening log file: %s"
1779               (Printexc2.to_string e) !!log_file
1780       else
1781         if !lprintf_to_file then begin
1782           lprintf_to_file := false;
1783           close_log ()
1784         end
1785   );
1786   option_hook max_upload_slots (fun _ ->
1787       if !!max_upload_slots < 3 then
1788         max_upload_slots =:= 3);
1789   option_hook buffer_writes_threshold (fun _ ->
1790       Unix32.max_buffered := Int64.of_int (1024 * !!buffer_writes_threshold));
1791   option_hook log_size (fun _ ->
1792       lprintf_max_size := !!log_size
1793   );
1794   option_hook hdd_temp_minfree (fun _ ->
1795       if !!hdd_temp_minfree < 50 then
1796         hdd_temp_minfree =:= 50);
1797   option_hook hdd_coredir_minfree (fun _ ->
1798       if !!hdd_coredir_minfree < 20 then
1799         hdd_coredir_minfree =:= 20);
1800   option_hook compaction_overhead (fun _ ->
1801       let gc_control = Gc.get () in
1802       Gc.set { gc_control with Gc.max_overhead = !!compaction_overhead };
1803   );
1804   option_hook space_overhead (fun _ ->
1805       let gc_control = Gc.get () in
1806       Gc.set { gc_control with Gc.space_overhead = !!space_overhead };
1807   );
1808   option_hook tcpip_packet_size (fun _ ->
1809       TcpBufferedSocket.ip_packet_size := !!tcpip_packet_size
1810   );
1811   option_hook mtu_packet_size (fun _ ->
1812       TcpBufferedSocket.mtu_packet_size := !!mtu_packet_size
1813   );
1814   option_hook minimal_packet_size (fun _ ->
1815       TcpBufferedSocket.minimal_packet_size := !!minimal_packet_size
1816   );
1817   option_hook minor_heap_size (fun _ ->
1818       let gc_control = Gc.get () in
1819       Gc.set { gc_control with Gc.minor_heap_size =
1820         (!!minor_heap_size * 1024) };
1821   );
1822   option_hook client_buffer_size (fun _ ->
1823       TcpBufferedSocket.max_buffer_size := max 50000 !!client_buffer_size
1824   );
1825   if Autoconf.has_gd then begin
1826     option_hook html_mods_vd_gfx_png (fun _ ->
1827       if not Autoconf.has_gd_png && !!html_mods_vd_gfx_png then html_mods_vd_gfx_png =:= false;
1828       if not Autoconf.has_gd_jpg && not !!html_mods_vd_gfx_png then html_mods_vd_gfx_png =:= true
1829         );
1830         option_hook html_mods_vd_gfx_h_intervall (fun _ ->
1831         let values = [1; 2; 3; 4; 5; 10; 15; 20; 30; 60] in
1832         let v = List.find ((<=) (min !!html_mods_vd_gfx_h_intervall 60)) values in
1833         if v <> !!html_mods_vd_gfx_h_intervall then html_mods_vd_gfx_h_intervall =:= v
1834     )
1835         end
1836
1837 let verbose_msg_clients = ref false
1838 let verbose_msg_raw = ref false
1839 let verbose_msg_clienttags = ref false
1840 let verbose_msg_servers = ref false
1841 let verbose = ref false
1842 let verbose_sources = ref 0
1843 let verbose_download = ref false
1844 let verbose_no_login = ref false
1845 let verbose_upload = ref false
1846 let verbose_unknown_messages = ref false
1847 let verbose_overnet = ref false
1848 let verbose_location = ref false
1849 let verbose_share = ref false
1850 let verbose_md4 = ref false
1851 let verbose_connect = ref false
1852 let verbose_udp = ref false
1853 let verbose_supernode = ref false
1854 let verbose_swarming = ref false
1855 let verbose_activity = ref false
1856 let verbose_user_commands = ref false
1857 let verbose_geoip = ref false
1858 let verbose_unexpected_messages = ref false
1859
1860 let set_all v =
1861   verbose_msg_clients := v;
1862   verbose_msg_raw := v;
1863   verbose_msg_clienttags := v;
1864   verbose_msg_servers := v;
1865   verbose := v;
1866   BasicSocket.debug := v;
1867   TcpServerSocket.debug := v;
1868   UdpSocket.debug := v;
1869   Unix32.verbose := v;
1870   GuiProto.verbose_gui_decoding := v;
1871   verbose_download := v;
1872   verbose_upload := v;
1873   verbose_no_login := v;
1874   verbose_unknown_messages := v;
1875   verbose_overnet := v;
1876   verbose_location := v;
1877   verbose_share := v;
1878   verbose_md4 := v;
1879   verbose_connect := v;
1880   verbose_udp := v;
1881   verbose_supernode := v;
1882   verbose_swarming := v;
1883   Http_client.verbose := v;
1884   Http_server.verbose := v;
1885   verbose_activity := v;
1886   verbose_user_commands := v;
1887   Geoip.verbose := v;
1888   verbose_unexpected_messages := v
1889
1890 let _ =
1891   option_hook verbosity (fun _ ->
1892       BasicSocket.verbose_bandwidth := 0;
1893       verbose_sources := 0;
1894       set_all false;
1895       List.iter (fun s ->
1896           match s with
1897           | "mc" -> verbose_msg_clients := true
1898           | "mr" | "raw" -> verbose_msg_raw := true
1899           | "mct" -> verbose_msg_clienttags := true
1900           | "ms" -> verbose_msg_servers := true
1901           | "verb" -> verbose := true
1902           | "sm" -> incr verbose_sources
1903           | "net" -> BasicSocket.debug := true; TcpServerSocket.debug := true; UdpSocket.debug := true
1904           | "file" -> Unix32.verbose := true
1905           | "gui" -> GuiProto.verbose_gui_decoding := true
1906           | "no-login" -> verbose_no_login := true
1907           | "do" -> verbose_download := true
1908           | "up" -> verbose_upload := true
1909           | "unk" -> verbose_unknown_messages := true
1910           | "ov" -> verbose_overnet := true
1911           | "loc" -> verbose_location := true
1912           | "share" -> verbose_share := true
1913           | "md4" -> verbose_md4 := true
1914           | "connect" -> verbose_connect := true
1915           | "udp" -> verbose_udp := true
1916           | "ultra" | "super" -> verbose_supernode := true
1917           | "swarming" -> verbose_swarming := true
1918           | "hc" -> Http_client.verbose := true
1919           | "hs" -> Http_server.verbose := true
1920           | "act" -> verbose_activity := true
1921           | "bw" -> incr BasicSocket.verbose_bandwidth
1922           | "unexp" -> verbose_unexpected_messages := true
1923           | "com" -> verbose_user_commands := true
1924           | "geo" -> Geoip.verbose := true
1925
1926           | "all" ->
1927
1928               verbose_sources := 1;
1929               set_all true;
1930
1931           | _ -> lprintf_nl "Unknown verbosity tag: %s" s
1932
1933       ) (String2.split_simplify !!verbosity ' ')
1934   )
1935
1936
1937 let _ =
1938   option_hook log_to_syslog (fun _ ->
1939     match !Printf2.syslog_oc with
1940       None ->
1941         if !!log_to_syslog then
1942           begin
1943             Printf2.syslog_oc := (
1944               try
1945                 Some (Syslog.openlog (Filename.basename Sys.argv.(0)))
1946               with e -> log_to_syslog =:= false;
1947                 lprintf_nl "error while opening syslog %s" (Printexc2.to_string e); None);
1948             lprintf_nl "activated syslog"
1949           end
1950     | Some oc ->
1951         if not !!log_to_syslog then
1952           begin
1953             lprintf_nl "deactivated syslog";
1954             Syslog.closelog oc;
1955             Printf2.syslog_oc := None
1956           end
1957   );
1958   option_hook loop_delay (fun _ ->
1959      BasicSocket.loop_delay := (float_of_int !!loop_delay) /. 1000.;
1960   );
1961   option_hook socket_keepalive (fun _ ->
1962       BasicSocket.socket_keepalive := !!socket_keepalive
1963   )
1964
1965 (* convert "|" to "\|" and "\|" to "|" *)
1966 let quote_unquote_bars m =
1967   let len = String.length m in
1968   let result = Buffer.create len in
1969   let rec aux i =
1970     if i = len then
1971       Buffer.contents result
1972     else match m.[i] with
1973       | '|' ->
1974     Buffer.add_string result "\\|";
1975     aux (i+1)
1976       | '\\' ->
1977     aux_escaped (i+1)
1978       | _ ->
1979     Buffer.add_char result m.[i];
1980     aux (i+1)
1981   and aux_escaped i =
1982     if i = len then begin
1983       Buffer.add_char result '\\';
1984       Buffer.contents result
1985     end else match m.[i] with
1986       | '|' ->
1987     Buffer.add_char result '|';
1988     aux (i+1)
1989       | _ ->
1990     Buffer.add_char result '\\';
1991     aux i
1992   in aux 0
1993
1994 let _ =
1995   let regex_fun str =
1996     if str <> "" then
1997       let r = Str.regexp_case_fold (quote_unquote_bars str) in
1998       (fun s ->
1999         try
2000               ignore (Str.search_forward r s 0);
2001               false
2002         with Not_found -> true
2003       )
2004     else (fun _ -> true)
2005   in
2006
2007   option_hook messages_filter (fun _ ->
2008       is_not_spam := regex_fun !!messages_filter
2009   );
2010
2011   option_hook comments_filter (fun _ ->
2012       is_not_comment_spam := regex_fun !!comments_filter
2013   )
2014
2015 let http_proxy = ref None
2016
2017 let http_proxy_tcp_update _ =
2018   if !!http_proxy_tcp then
2019     TcpBufferedSocket.http_proxy := !http_proxy
2020   else
2021     TcpBufferedSocket.http_proxy := None
2022
2023 let _ =
2024   let proxy_update _ =
2025     http_proxy :=
2026     (match !!http_proxy_server with
2027         "" -> None
2028       | _  -> Some (!!http_proxy_server, !!http_proxy_port));
2029     http_proxy_tcp_update ()
2030   in
2031   option_hook http_proxy_server proxy_update;
2032   option_hook http_proxy_port proxy_update;
2033   option_hook http_proxy_tcp http_proxy_tcp_update
2034
2035 let _ =
2036   option_hook allow_local_network (fun _ ->
2037       Ip.allow_local_network := !!allow_local_network)
2038
2039 let web_infos_table = Hashtbl.create 10
2040
2041 exception Found_web_infos of web_infos
2042
2043 let web_infos_find url =
2044   let found = ref None in
2045   (try
2046     Hashtbl.iter (fun key w ->
2047       if w.url = url then raise (Found_web_infos w)
2048     ) web_infos_table
2049   with Found_web_infos w -> found := Some w);
2050   !found
2051
2052 let web_infos_remove url =
2053   let delete_list = ref [] in
2054   Hashtbl.iter (fun key w ->
2055     if w.url = url then delete_list := !delete_list @ [key]
2056   ) web_infos_table;
2057   List.iter (fun key -> Hashtbl.remove web_infos_table key) !delete_list
2058
2059 let web_infos_add kind period url =
2060   (match web_infos_find url with
2061   | None -> ()
2062   | Some w -> web_infos_remove w.url);
2063   Hashtbl.add web_infos_table (kind, period, url)
2064     {
2065       kind = kind;
2066       period = period;
2067       url = url;
2068       state = None;
2069     }
2070
2071 let _ =
2072 (* convert list option web_infos to a hashtable for better usage *)
2073   set_after_load_hook downloads_ini (fun _ ->
2074     List.iter (fun (kind, period, url) ->
2075       web_infos_add kind period url
2076     ) !!web_infos;
2077     web_infos =:= []
2078   );
2079   set_before_save_hook downloads_ini (fun _ ->
2080     Hashtbl.iter (fun _ w ->
2081       web_infos =:= !!web_infos @ [(w.kind, w.period, w.url)]
2082     ) web_infos_table
2083   );
2084   set_after_save_hook downloads_ini (fun _ ->
2085     web_infos =:= []
2086   )
2087
2088 let rec update_options () =
2089   let update v =
2090       lprintf_nl "Updating options to version %i" v;
2091       options_version =:= v;
2092       update_options ()
2093   in
2094
2095   match !!options_version with
2096     0 ->
2097       web_infos =:= List.map (fun (kind, period, url) ->
2098           kind, period * Date.day_in_hours, url
2099       ) !!web_infos;
2100       web_infos_add "rss" 6 "http://www.ed2k-it.com/forum/news_rss.php";
2101       web_infos_add "rss" 6 "http://www.torrents.co.uk/backend.php";
2102       web_infos_add "rss" 6 "http://varchars.com/rss/suprnova-movies.rss";
2103       update 1
2104
2105   | 1 ->
2106       (* 5 ms is a good unit, for measuring latency between clients. *)
2107       loop_delay =:= 5;
2108       update 2
2109
2110   | 2 ->
2111       web_infos_remove "http://www.ed2k-it.com/forum/news_rss.php";
2112       web_infos_remove "http://www.torrents.co.uk/backend.php";
2113       web_infos_remove "http://varchars.com/rss/suprnova-movies.rss";
2114       if !!min_reask_delay = 720 then min_reask_delay =:= 600;
2115       update 3
2116
2117   | 3 ->
2118       web_infos_remove "http://members.lycos.co.uk/appbyhp2/FlockHelpApp/contact-files/contact.ocl";
2119       web_infos_add "contact.dat" 168 "http://www.overnet.org/download/contact.dat";
2120       update 4
2121
2122   | 4 ->
2123       web_infos_remove "http://ocbmaurice.dyndns.org/pl/slist.pl/server.met?download/server-best.met";
2124       web_infos_add "server.met" 0 "http://www.gruk.org/server.met.gz";
2125       update 5
2126
2127   | 5 ->
2128       if !!max_indirect_connections > 50 then
2129           max_indirect_connections =:= 20;
2130       update 6
2131
2132   | 6 ->
2133       (* it's more natural to use | instead of \| for simple case *)
2134       messages_filter =:= quote_unquote_bars !!messages_filter;
2135       update 7
2136
2137   | 7 ->
2138       (* update to 20 because of dynamic_loop_delay patch *)
2139       loop_delay =:= 20;
2140       update 8
2141
2142   | 8 ->
2143       web_infos_add "geoip.dat" 0 "http://www.maxmind.com/download/geoip/database/GeoIP.dat.gz";
2144       update 9
2145
2146   | 9 ->
2147       web_infos_remove "http://www.gruk.org/server.met.gz";
2148       web_infos_add "server.met" 0 "http://www.jd2k.com/server.met";
2149       update 10
2150
2151   | 10 ->
2152       web_infos_remove "http://www.overnet.org/download/contact.dat";
2153       web_infos_add "contact.dat" 168 "http://download.overnet.org/contact.dat";
2154       update 11
2155
2156   | 11 ->
2157       web_infos_remove "http://www.bluetack.co.uk/config/antip2p.txt";
2158       web_infos_add "guarding.p2p" 0 "http://www.bluetack.co.uk/config/level1.gz";
2159       update 12
2160
2161   | 12 ->
2162       web_infos_add "nodes.gzip" 0 "http://update.kceasy.com/update/fasttrack/nodes.gzip";
2163       update 13
2164
2165   | 13 ->
2166       web_infos_remove "http://www.jd2k.com/server.met";
2167       web_infos_add "server.met" 0 "http://www.gruk.org/server.met.gz";
2168       update 14
2169
2170   | 14 ->
2171       (* set back to 5 because dynamic_loop_delay patch was removed *)
2172       loop_delay =:= 5;
2173       update 15
2174
2175   | 15 ->
2176       if !!messages_filter = "Your client is connecting too fast" then
2177         messages_filter =:= "DI-Emule|ZamBoR|Ketamine|eMule FX|AUTOMATED MESSAGE";
2178       update 16
2179
2180   | 16 ->
2181       if !!download_sample_size = 10 then download_sample_size =:= 100;
2182       update 17
2183
2184   | 17 ->
2185       web_infos_add "hublist" 0 "http://dchublist.com/hublist.config.bz2";
2186       update 18
2187
2188   | 18 ->
2189       if !!messages_filter = "DI-Emule|ZamBoR|Ketamine|eMule FX|AUTOMATED MESSAGE" then
2190         messages_filter =:= "DI-Emule|ZamBoR|Ketamine|eMule FX|AUTOMATED MESSAGE|Hi Honey!|Do you live in my area|download HyperMule";
2191       update 19
2192
2193   | 19 ->
2194       if !!share_scan_interval = 5 then share_scan_interval =:= 30;
2195       update 20
2196
2197   | _ -> ()