1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369
|
(***********************************************************************)
(* settings.ml - Various and sundry settings with their defaults, plus *)
(* functions for assigning new values. This is used by *)
(* the getopt routines to set preferences *)
(* *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(* 2011, 2012, 2013 Yaron Minsky and Contributors *)
(* *)
(* This file is part of SKS. SKS is free software; you can *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 of the License, or (at your option) any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU General Public License *)
(* along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>. *)
(***********************************************************************)
open StdLabels
open MoreLabels
module Unix=UnixLabels
open Printf
let n = ref 0
let set_n value = n := value
let debug = ref true
let set_debug value = debug := value
let debuglevel = ref 3
let set_debuglevel value = debuglevel := value
let mbar = ref 5
let set_mbar value = mbar := value
let bitquantum = ref 2
let set_bitquantum value = bitquantum := value
let drop = ref 10
let set_drop value = drop := value
let bytes = ref 16
let set_bytes value = bytes := value
(** maximum number of differences to recover in one go *)
let max_recover = ref 2000
let set_max_recover value = max_recover := value
let seed = ref 0
let self_seed = ref true
let set_seed value =
self_seed := false;
seed := value
let recon_port = ref 11370
let recon_address = ref "0.0.0.0 ::"
let set_recon_address value = recon_address := value
let hkp_port = ref 11371
let hkp_address = ref "0.0.0.0 ::"
let set_hkp_address value = hkp_address := value
let use_port_80 = ref false
let set_base_port value =
recon_port := value;
hkp_port := value + 1
let set_recon_port value = recon_port := value
let set_hkp_port value = hkp_port := value
let setup_RNG () =
if !self_seed
then Random.self_init ()
else Random.init !seed
let max_internal_matches = ref 20000
let set_max_internal_matches value = max_internal_matches := value
let max_matches = ref 500
let set_max_matches value = max_matches := value
let max_outstanding_recon_requests = ref 100
let set_max_outstanding_recon_requests value =
max_outstanding_recon_requests := value
let max_uid_fetches = ref 1000
let set_max_uid_fetches value = max_uid_fetches := value
let dump_new = ref false
(* whether or not to use a disk-based prefix-tree implementation *)
let disk_ptree = ref true
let max_ptree_nodes = ref 1000
let set_max_ptree_nodes value = max_ptree_nodes := value
let http_fetch_size = ref 100
let set_http_fetch_size value = http_fetch_size := value
let prob = ref 0.1
let set_prob value = prob := value
let db_sync_interval = ref (5. *. 60.)
let set_db_sync_interval value = db_sync_interval := value
let recon_sync_interval = ref (5. *. 60.)
let set_recon_sync_interval value = recon_sync_interval := value
let gossip_interval = ref 60. (* time between gossips in seconds*)
let set_gossip_interval value = gossip_interval := value *. 60.
let gossip = ref true (* whether or not to initiate gossips *)
let anonlist = ref ([] : string list)
let cache_bytes = ref (Some (20 * 1024 * 1024))
let set_cache_bytes value = cache_bytes := Some (value * 1024 * 1024)
let pagesize = ref (Some 65536)
let set_pagesize value = pagesize := Some (value * 512)
let keyid_pagesize = ref None
let set_keyid_pagesize value = keyid_pagesize := Some (value * 512)
let meta_pagesize = ref None
let set_meta_pagesize value = meta_pagesize := Some (value * 512)
let subkeyid_pagesize = ref None
let set_subkeyid_pagesize value = subkeyid_pagesize := Some (value * 512)
let time_pagesize = ref None
let set_time_pagesize value = time_pagesize := Some (value * 512)
let tqueue_pagesize = ref None
let set_tqueue_pagesize value = tqueue_pagesize := Some (value * 512)
let word_pagesize = ref None
let set_word_pagesize value = word_pagesize := Some (value * 512)
let ptree_cache_bytes = ref (Some (5 * 1024 * 1024))
let set_ptree_cache_bytes value =
ptree_cache_bytes := Some (value * 1024 * 1024)
let ptree_pagesize = ref (Some 4096)
let set_ptree_pagesize value = ptree_pagesize := Some (value * 512)
let hostname = ref (Unix.gethostname ())
let set_hostname value = hostname := value
let nodename = ref (Unix.gethostname ())
let set_nodename value = nodename := value
let server_contact = ref ""
let set_server_contact value = server_contact := value
let filelog = ref true
let transactions = ref true
let checkpoint_interval = ref (60. *. 60.)
let set_checkpoint_interval value = checkpoint_interval := value
let recon_checkpoint_interval = ref (60. *. 60.)
let set_recon_checkpoint_interval value = recon_checkpoint_interval := value
let ptree_thresh_mult = ref 10
let set_ptree_thresh_mult value = ptree_thresh_mult := value
let recon_thresh_mult = ref 30
let set_recon_thresh_mult value = recon_thresh_mult := value
let wserver_timeout = ref 180
let set_wserver_timeout value = wserver_timeout := value
let reconciliation_config_timeout = ref 45
let set_reconciliation_config_timeout value =
reconciliation_config_timeout := value
let reconciliation_timeout = ref (60 * 60)
let set_reconciliation_timeout value = reconciliation_timeout := (value * 60)
let initial_stat = ref false (* whether to calculate stats page on boot *)
let stat_calc_hour = ref 3 (* hour of the day to do stats calculation *)
let set_stat_calc_hour value = stat_calc_hour := value
(*let XXX = ref
let set_XXX value = XXX := value *)
let missing_keys_timeout = ref 180
let set_missing_keys_timeout value = missing_keys_timeout := value
let command_timeout = ref 60
let set_command_timeout value = command_timeout := value
let sendmail_cmd = ref "/usr/lib/sendmail -t -oi"
let set_sendmail_cmd value = sendmail_cmd := value
let membership_reload_time = ref (60. *. 60. *. 6.)
let set_membership_reload_time value =
membership_reload_time := value *. 60. *. 60.
(** whether to send out PKS-style mailsync messages *)
let send_mailsyncs = ref true
(** WHether to log hashes of most-recently-found diff *)
let log_diffs = ref true
let from_addr = ref None
let set_from_addr value = from_addr := Some value
let get_from_addr () =
match !from_addr with
| Some addr -> addr
| None ->
let addr = ((Unix.getpwuid (Unix.getuid ())).Unix.pw_name
^ "@" ^ !hostname)
in
from_addr := Some addr;
addr
let use_stdin = ref false
let basedir = ref ""
let base_dbdir = "/var/lib/sks/DB"
let base_ptree_dbdir = "/var/lib/sks/PTree"
let base_membership_file = "/etc/sks/membership"
let base_mailsync_file = "/etc/sks/mailsync"
let base_dumpdir = "/var/lib/sks/dump"
let base_msgdir = "/var/spool/sks/messages"
let base_failed_msgdir = "/var/spool/sks/failed_messages"
let dbdir = lazy (Filename.concat !basedir base_dbdir)
let ptree_dbdir = lazy (Filename.concat !basedir base_ptree_dbdir)
let membership_file = lazy (Filename.concat !basedir base_membership_file)
let mailsync_file = lazy (Filename.concat !basedir base_mailsync_file)
let dumpdir = lazy (Filename.concat !basedir base_dumpdir)
let msgdir = lazy (Filename.concat !basedir base_msgdir)
let failed_msgdir = lazy (Filename.concat !basedir base_failed_msgdir)
(*****************************************************************)
(** Specifies the options along with the corresponding actions.
These are used both for command-line options and the config file *)
let parse_spec =
[ ("-debug", Arg.Set debug, " debugging mode");
("-debuglevel", Arg.Int set_debuglevel,
" Debugging level -- sets verbosity of logging");
("-q", Arg.Int set_bitquantum, " number of bits defining a bin");
("-mbar", Arg.Int set_mbar, " number of errors that can be corrected " ^
"in one shot");
("-seed", Arg.Int set_seed, " Seed used by RNG");
("-hostname", Arg.String set_hostname, " current hostname");
("-nodename", Arg.String set_nodename, " current nodename");
("-d", Arg.Int set_drop, " Number of keys to drop at random " ^
"when synchronizing");
("-n", Arg.Int set_n, " Number of key dump files to load at once " ^
"when used with build, multiple of 15000 keys when used with " ^
"fastbuild.");
("-max_internal_matches", Arg.Int set_max_internal_matches,
" Maximum number of matches for most specific word in a " ^
"multi-word search");
("-max_matches", Arg.Int set_max_matches,
" Maximum number of matches that will be returned from a query");
("-max_uid_fetches", Arg.Int set_max_uid_fetches,
" Maximum number of uid fetches performed in a verbose index query");
("-pagesize", Arg.Int set_pagesize, " Pagesize in 512 byte blocks for key db");
("-keyid_pagesize", Arg.Int set_keyid_pagesize, " Pagesize in 512 byte blocks for keyid db");
("-meta_pagesize", Arg.Int set_meta_pagesize, " Pagesize in 512 byte blocks for meta db");
("-subkeyid_pagesize", Arg.Int set_subkeyid_pagesize, " Pagesize in 512 byte blocks for subkeyid db");
("-time_pagesize", Arg.Int set_time_pagesize, " Pagesize in 512 byte blocks for time db");
("-tqueue_pagesize", Arg.Int set_tqueue_pagesize, " Pagesize in 512 byte blocks for tqueue db");
("-word_pagesize", Arg.Int set_word_pagesize, " Pagesize in 512 byte blocks for word db");
("-cache", Arg.Int set_cache_bytes, " Cache size in megs for key db");
("-ptree_pagesize", Arg.Int set_ptree_pagesize,
" Pagesize in 512 byte blocks for prefix tree db");
("-ptree_cache", Arg.Int set_ptree_cache_bytes,
" Cache size in megs for prefix tree db");
("-baseport",Arg.Int set_base_port, " Set base port number");
("-logfile",Arg.String (fun _ -> ()), " DEPRECATED. Now ignored.");
("-recon_port",Arg.Int set_recon_port, " Set recon port number");
("-recon_address",Arg.String set_recon_address, " Set recon binding address by hostname or IP");
("-hkp_port",Arg.Int set_hkp_port, " Set hkp port number");
("-hkp_address",Arg.String set_hkp_address, " Set hkp binding address by hostname or IP");
("-use_port_80",Arg.Set use_port_80,
" Have the HKP interface listen on port 80, as well as the hkp_port");
("-basedir", Arg.Set_string basedir, " Base directory (Take special care if running the Debian package!)");
("-stdoutlog", Arg.Clear filelog,
" Send log messages to stdout instead of log file");
("-diskptree", Arg.Set disk_ptree,
" Use a disk-based ptree implementation. Slower, but requires far less memory");
("-nodiskptree", Arg.Clear disk_ptree, " Use in-mem ptree");
("-max_ptree_nodes", Arg.Int set_max_ptree_nodes,
" Maximum number of allowed ptree nodes. Only meaningful if -diskptree is set");
("-prob", Arg.Float set_prob, " Set probability. Used for testing code only");
("-recon_sync_interval", Arg.Float set_recon_sync_interval,
" Set sync interval for reconserver.");
("-gossip_interval", Arg.Float set_gossip_interval, " Set time between " ^
"gossips in minutes.");
("-dontgossip", Arg.Clear gossip, " Don't gossip automatically. " ^
"Host will still respond to requests from other hosts");
("-db_sync_interval", Arg.Float set_db_sync_interval,
" Set sync interval for dbserver.");
("-checkpoint_interval", Arg.Float set_checkpoint_interval,
" Time period between checkpoints");
("-recon_checkpoint_interval", Arg.Float set_recon_checkpoint_interval,
" Time period between checkpoints for reconserver");
("-ptree_thresh_mult", Arg.Int set_ptree_thresh_mult,
" Multiple of thresh which specifies minimum node size in prefix tree");
("-recon_thresh_mult", Arg.Int set_recon_thresh_mult,
" Multiple of thresh which specifies minimum node size that is " ^
"included in reconciliation");
("-max_recover", Arg.Int set_max_recover,
" Maximum number of differences to recover in one round");
("-http_fetch_size", Arg.Int set_http_fetch_size,
" Number of keys for reconserver to fetch from dbserver in one go.");
("-wserver_timeout", Arg.Int set_wserver_timeout,
" Timeout in seconds for webserver requests");
("-reconciliation_timeout", Arg.Int set_reconciliation_timeout,
" Timeout for reconciliation runs in minutes");
("-stat_hour", Arg.Int set_stat_calc_hour,
" Hour at which to run database statistics");
("-initial_stat", Arg.Set initial_stat,
" Runs database statistics calculation on boot");
("-reconciliation_config_timeout", Arg.Int set_reconciliation_config_timeout,
" Set timeout in seconds for initial exchange of config info " ^
"in reconciliation");
("-missing_keys_timeout", Arg.Int set_missing_keys_timeout,
" Timeout in seconds for get_missing_keys");
("-command_timeout", Arg.Int set_command_timeout,
" Timeout in seconds for commands set over command socket");
("-sendmail_cmd", Arg.String set_sendmail_cmd,
" Command used for sending mail");
("-from_addr", Arg.String set_from_addr,
" From address used in synchronization emails used to communicate " ^
"with PKS");
("-dump_new_only", Arg.Set dump_new,
" When doing a database dump, only dump new keys, not keys" ^
" already contained in a keydump file");
("-max_outstanding_recon_requests", Arg.Int set_max_outstanding_recon_requests,
" maximum number of outstanding requests in reconciliation");
("-membership_reload_interval", Arg.Float set_membership_reload_time,
" maximum interval (in hours) at which membership file is reloaded");
("-disable_mailsync", Arg.Clear send_mailsyncs,
" Disable sending of PKS mailsync messages. ONLY FOR STANDALONE SERVERS!");
("-disable_log_diffs", Arg.Clear log_diffs,
" Disable logging of recent hashset diffs.");
("-stdin", Arg.Set use_stdin,
" Read keyids from stdin (sksclient only)");
("-server_contact", Arg.String set_server_contact,
" Set OpenPGP KeyID of the server contact");
]
let parse_spec = Arg.align parse_spec
let anon_options option_string =
anonlist := option_string::!anonlist
let usage_string =
"sks command [-mbar mbar] [-q bitquantum] -debug (type \"sks help\" for a list of commands)"
|