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