├── VERSION ├── sks.mli ├── sampleWeb ├── HTML5 │ ├── robots.txt │ └── README ├── OpenPKG │ ├── robots.txt │ ├── README │ └── index.html └── XHTML+ES │ ├── robots.txt │ └── functions.es ├── .merlin ├── add_mail.mli ├── dbserver.mli ├── clean_keydb.mli ├── version.mli ├── catchup.mli ├── keyHash.mli ├── recode.mli ├── armor.mli ├── pstyle.mli ├── prime.mli ├── .bzrignore ├── bdb ├── templ.c ├── ocextr.ml ├── script.ml ├── dbstubs.h ├── bdb_stubs.h ├── db.mli ├── Makefile └── db.ml ├── Makefile.local.unused ├── reconComm.mli ├── sStream.mli ├── .gitignore ├── decode.mli ├── .hgignore ├── FILES ├── recvmail.mli ├── sampleConfig ├── aliases.sample ├── procmailrc ├── crontab.sample ├── DB_CONFIG ├── sksconf.minimal ├── mailsync ├── rc.sks ├── sksconf.typical └── membership ├── fqueue.mli ├── htmlTemplates.mli ├── request.mli ├── sks_build.bc.sh ├── recoverList.mli ├── .travis.yml ├── server.mli ├── reconCS.mli ├── ehandlers.mli ├── stats.mli ├── fixkey.mli ├── smtp_script.py ├── nbMsgContainer.mli ├── rMisc.mli ├── client.mli ├── opam ├── poly.mli ├── prefixTree.mli ├── bitstring.mli ├── reconMessages.mli ├── reconserver.mli ├── reconPTreeDb.mli ├── UPGRADING ├── parsePGP.mli ├── dbMessages.mli ├── wserver.mli ├── key.mli ├── sks_build.sh ├── reconPTreeDb.ml ├── ptscript.ml ├── mTimer.mli ├── heap.mli ├── tz.c ├── utils.mli ├── Unique_time.ml ├── recode.ml ├── common.mli ├── BUGS ├── int_comparators.ml ├── sStream.ml ├── mArray.mli ├── linearAlg.mli ├── unit_tests.ml ├── index.mli ├── dbscript.ml ├── version.ml ├── ptree_db_test.ml ├── msgContainer.ml ├── foo.ml ├── membership.mli ├── mTimer.ml ├── Unique_time.mli ├── number_test.ml ├── cMarshal.mli ├── pstyle.ml ├── crc.c ├── number.mli ├── sks_do.ml ├── logdump.ml ├── dbtest.ml ├── packet.mli ├── add_mail.ml ├── meteredChannel.ml ├── mList.mli ├── query.ml ├── keyHash.ml ├── sksclient.ml ├── ptree_replay.ml ├── ANNOUNCEMENT ├── ptree_consistency_test.ml ├── poly_test.ml ├── recvmail.ml ├── prime.ml ├── incdump.ml ├── sendmail.ml ├── tester.ml └── fqueue.ml /VERSION: -------------------------------------------------------------------------------- 1 | 1.1.6 2 | -------------------------------------------------------------------------------- /sks.mli: -------------------------------------------------------------------------------- 1 | (* This is the base sks command *) 2 | -------------------------------------------------------------------------------- /sampleWeb/HTML5/robots.txt: -------------------------------------------------------------------------------- 1 | User-agent: * 2 | Disallow: / 3 | -------------------------------------------------------------------------------- /sampleWeb/OpenPKG/robots.txt: -------------------------------------------------------------------------------- 1 | User-agent: * 2 | Disallow: / 3 | -------------------------------------------------------------------------------- /sampleWeb/XHTML+ES/robots.txt: -------------------------------------------------------------------------------- 1 | User-agent: * 2 | Disallow: / 3 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | B . 2 | B bdb 3 | S . 4 | S bdb 5 | PKG num cryptokit 6 | -------------------------------------------------------------------------------- /add_mail.mli: -------------------------------------------------------------------------------- 1 | (* This is the sks add_mail command-line tool *) 2 | -------------------------------------------------------------------------------- /dbserver.mli: -------------------------------------------------------------------------------- 1 | module F (M: sig end) : sig 2 | val run : unit -> unit 3 | end 4 | -------------------------------------------------------------------------------- /clean_keydb.mli: -------------------------------------------------------------------------------- 1 | module F (M : sig end) : sig 2 | val run : unit -> unit 3 | end 4 | -------------------------------------------------------------------------------- /version.mli: -------------------------------------------------------------------------------- 1 | (* This is a sks command for showing version information *) 2 | val run : unit -> unit -------------------------------------------------------------------------------- /catchup.mli: -------------------------------------------------------------------------------- 1 | val uninterruptable_catchup : unit -> unit 2 | val catchup : unit -> Eventloop.timed_event list 3 | val catchup_interval : float 4 | -------------------------------------------------------------------------------- /keyHash.mli: -------------------------------------------------------------------------------- 1 | val hash_bytes : int 2 | val hash : Packet.packet list -> Digest.t 3 | val hexify : string -> string 4 | val dehexify : string -> string 5 | -------------------------------------------------------------------------------- /recode.mli: -------------------------------------------------------------------------------- 1 | val limit : int 2 | val cin : Channel.sys_in_channel 3 | val cout : Channel.sys_out_channel 4 | val getkey : unit -> Packet.packet list 5 | -------------------------------------------------------------------------------- /armor.mli: -------------------------------------------------------------------------------- 1 | val encode_pubkey_string : string -> string 2 | val decode_pubkey : string -> Packet.packet list list 3 | val encode_pubkey : Packet.packet list -> string 4 | -------------------------------------------------------------------------------- /pstyle.mli: -------------------------------------------------------------------------------- 1 | val range : ?stride:int -> ?start:int -> int -> int list 2 | val ( ) : string -> int * int -> string 3 | val ( <|> ) : 'a array -> int * int -> 'a array 4 | -------------------------------------------------------------------------------- /prime.mli: -------------------------------------------------------------------------------- 1 | type result 2 | val randbits : (unit -> int) -> int -> Number.z 3 | val randint : (unit -> int) -> Number.z -> Number.z 4 | val randprime : (unit -> int) -> bits:int -> error:int -> Number.z 5 | -------------------------------------------------------------------------------- /sampleWeb/OpenPKG/README: -------------------------------------------------------------------------------- 1 | I found this one day surfing. It from the OpenPKG RPM Package Specification 2 | Copyright (c) 2000-2008 OpenPKG Foundation e.V. 3 | 4 | It is considerably barebones 5 | -------------------------------------------------------------------------------- /.bzrignore: -------------------------------------------------------------------------------- 1 | Makefile.local 2 | *.cmx 3 | *.cmo 4 | *.o 5 | *.cmxa 6 | *.cmi 7 | *.annot 8 | cryptokit-1.0 9 | lib 10 | numerix-0.22 11 | tmp 12 | bdb/ocextr 13 | sks 14 | sks_add_mail 15 | .depend 16 | prepared 17 | -------------------------------------------------------------------------------- /bdb/templ.c: -------------------------------------------------------------------------------- 1 | //+ external CAMLFUNC : TYPESIG 2 | //+ = "CFUNC" 3 | value CFUNC(VALUELIST) { 4 | CAMLparamX(VALUES); 5 | CAMLlocalX(LOCAL); 6 | 7 | CODE 8 | 9 | CAMLreturn (RVAL); 10 | } 11 | -------------------------------------------------------------------------------- /Makefile.local.unused: -------------------------------------------------------------------------------- 1 | BDBLIB=-L/usr/lib 2 | BDBINCLUDE=-I/usr/include 3 | PREFIX=/usr/local 4 | LIBDB=-ldb-4.6 5 | MANDIR=/usr/share/man 6 | export BDBLIB 7 | export BDBINCLUDE 8 | export PREFIX 9 | export LIBDB 10 | export MANDIR 11 | -------------------------------------------------------------------------------- /reconComm.mli: -------------------------------------------------------------------------------- 1 | val send_dbmsg : DbMessages.msg -> DbMessages.msg 2 | val send_dbmsg_noreply : DbMessages.msg -> unit 3 | val fetch_filters : unit -> string list 4 | val get_keystrings_via_http : UnixLabels.sockaddr -> string list -> string list 5 | -------------------------------------------------------------------------------- /sStream.mli: -------------------------------------------------------------------------------- 1 | type 'a sstream = { mutable first : 'a option; next : unit -> 'a option; } 2 | val make : ?first:'a -> (unit -> 'a option) -> 'a sstream 3 | val next : 'a sstream -> 'a option 4 | val peek : 'a sstream -> 'a option 5 | val junk : 'a sstream -> unit 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile.local 2 | *.cmx 3 | *.cmo 4 | *.cma 5 | *.o 6 | *.cmxa 7 | *.cmi 8 | *.cmt 9 | *.cmti 10 | *.annot 11 | *.bc 12 | *.gz 13 | tmp 14 | bdb/bdb.ml 15 | bdb/ocextr 16 | sks 17 | sks_add_mail 18 | .depend 19 | prepared 20 | *~ 21 | *.a 22 | /doc 23 | -------------------------------------------------------------------------------- /decode.mli: -------------------------------------------------------------------------------- 1 | exception Low_mbar 2 | exception Interpolation_failure 3 | val interpolate : 4 | values:ZZp.zz array -> points:ZZp.zz array -> d:int -> Poly.t * Poly.t 5 | val factor : Poly.t -> ZZp.Set.t 6 | val reconcile : 7 | values:ZZp.zz array -> points:ZZp.zz array -> d:int -> ZZp.Set.t * ZZp.Set.t 8 | -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | syntax: glob 2 | Makefile.local 3 | *.cmx 4 | *.cmo 5 | *.cma 6 | *.o 7 | *.cmxa 8 | *.cmi 9 | *.cmt 10 | *.cmti 11 | *.annot 12 | *.bc 13 | *.gz 14 | cryptokit-1.7/ 15 | lib 16 | numerix-0.22 17 | tmp 18 | bdb/bdb.ml 19 | bdb/ocextr 20 | sks 21 | sks_add_mail 22 | .depend 23 | prepared 24 | *~ 25 | *.a 26 | 27 | -------------------------------------------------------------------------------- /FILES: -------------------------------------------------------------------------------- 1 | ANNOUNCEMENT 2 | BUGS 3 | CHANGELOG 4 | LICENSE 5 | FILES 6 | README.md 7 | TODO 8 | UPGRADING 9 | VERSION 10 | Makefile 11 | Makefile.local.unused 12 | sks_build.sh 13 | bdb/*.ml 14 | bdb/*.mli 15 | bdb/Makefile 16 | bdb/*.c 17 | bdb/*.h 18 | *.ml 19 | *.mli 20 | *.c 21 | *.patch 22 | sampleConfig/* 23 | sampleWeb/* 24 | sks.pod 25 | -------------------------------------------------------------------------------- /recvmail.mli: -------------------------------------------------------------------------------- 1 | val whitespace : Str.regexp 2 | val eol : Str.regexp 3 | val parse_header_line : string -> (string * string) option 4 | val parse_header : 5 | string list -> 6 | (string * string) list -> (string * string) list * string list 7 | val simplify_headers : (string * string) list -> (string * string) list 8 | val parse : string -> Sendmail.msg 9 | -------------------------------------------------------------------------------- /sampleWeb/HTML5/README: -------------------------------------------------------------------------------- 1 | This is just a prettified index.html in HTML5. 2 | 3 | It uses elements of HTML5 boilerplate 1.0 4 | 5 | The link to SKS points to the https://github.com/SKS-Keyserver/sks-keyserver 6 | 7 | The submission links are relative to minimize having to search and replace 8 | on installation. 9 | 10 | Comments welcome. 11 | 12 | Submitted by samir@samirnassar.com. 13 | -------------------------------------------------------------------------------- /sampleConfig/aliases.sample: -------------------------------------------------------------------------------- 1 | # handle incoming keyserver mail. Use one or the oyher of these but NOT both 2 | # If you define pgp-public-keys to a user, that user must have an appropriate 3 | # .procmailrc or other forwarding directive in its $HOME, preferrably the same 4 | # directory as SKS's base_dir 5 | # 6 | #pgp-public-keys: "|/usr/bin/sks_add_mail /var/sks/messages" 7 | #pgp-public-keys: sks 8 | -------------------------------------------------------------------------------- /fqueue.mli: -------------------------------------------------------------------------------- 1 | exception Empty 2 | type 'a t = { inlist : 'a list; outlist : 'a list; length : int; } 3 | val empty : 'a t 4 | val push : 'a -> 'a t -> 'a t 5 | val enq : 'a -> 'a t -> 'a t 6 | val top : 'a t -> 'a 7 | val pop : 'a t -> 'a * 'a t 8 | val discard : 'a t -> 'a t 9 | val deq : 'a t -> 'a * 'a t 10 | val to_list : 'a t -> 'a list 11 | val length : 'a t -> int 12 | val is_empty : 'a t -> bool 13 | -------------------------------------------------------------------------------- /htmlTemplates.mli: -------------------------------------------------------------------------------- 1 | val html_quote : string -> string 2 | val page : title:string -> body:string -> string 3 | val link : 4 | op:string -> hash:bool -> fingerprint:bool -> keyid:string -> string 5 | val keyinfo_header : string 6 | val keyinfo_pks : 7 | Packet.pubkeyinfo -> 8 | bool -> keyid:string -> link:string -> userids:string list -> string 9 | val fingerprint : fp:string -> string 10 | val hash_link : hash:string -> string 11 | val hash : hash:string -> string 12 | val preformat_list : string list -> string -------------------------------------------------------------------------------- /request.mli: -------------------------------------------------------------------------------- 1 | val amp : Str.regexp 2 | val chsplit : char -> string -> string * string 3 | val eqsplit : string -> string * string 4 | type request_kind = VIndex | Index | Get | HGet | Stats 5 | type request = { 6 | kind : request_kind; 7 | search : string list; 8 | fingerprint : bool; 9 | hash : bool; 10 | exact : bool; 11 | machine_readable : bool; 12 | clean : bool; 13 | limit : int; 14 | } 15 | val default_request : request 16 | val comma_rxp : Str.regexp 17 | val request_of_oplist : ?request:request -> (string * string) list -> request 18 | -------------------------------------------------------------------------------- /sks_build.bc.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # SKS build script. 4 | # cd to directory with "dump" subdirectory, and run 5 | # You might want to edit this file to reduce or increase memory usage 6 | # depending on your system 7 | 8 | fail() { echo Command failed unexpectedly. Bailing out; exit -1; } 9 | SKS=sks.bc 10 | 11 | echo === Running fastbuild... === 12 | if ! $SKS fastbuild -n 10 -cache 100; then fail; fi 13 | echo === Cleaning key database... === 14 | if ! $SKS cleandb; then fail; fi 15 | echo === Building ptree database... === 16 | if ! $SKS pbuild -cache 20 -ptree_cache 70; then fail; fi 17 | echo === Done! === 18 | -------------------------------------------------------------------------------- /sampleConfig/procmailrc: -------------------------------------------------------------------------------- 1 | #!/usr/bin/procmail 2 | # 3 | # - .procmailrc 4 | 5 | # Environment 6 | SHELL=/bin/bash 7 | UMASK=0177 8 | LINEBUF=4096 9 | LOGFILE=/var/log/procmail.log 10 | VERBOSE=off 11 | DEFAULT=/dev/null 12 | PATH=/usr/bin 13 | 14 | # Bounce and loop detection 15 | :0 16 | * ^FROM_DAEMON 17 | * ^X-Loop:.*pgp-public-keys@gingerbear.net 18 | $DEFAULT 19 | 20 | # Handle your keysync mails (optional) 21 | :0 22 | * ^Subject.*incremental 23 | | /usr/bin/sks_add_mail /var/sks/ 24 | 25 | # Anything leftover 26 | :0 27 | $DEFAULT 28 | -------------------------------------------------------------------------------- /recoverList.mli: -------------------------------------------------------------------------------- 1 | type recover_element = string list * UnixLabels.sockaddr 2 | val hash_bundle_size : int 3 | val recover_list : recover_element Queue.t 4 | val gossip_disabled_var : bool ref 5 | val gossip_disabled : unit -> bool 6 | val disable_gossip : unit -> unit 7 | val enable_gossip : unit -> unit 8 | val n_split : 'a list -> int -> 'a list * 'a list 9 | val size_split : 'a list -> int -> 'a list list 10 | val print_hashes : string -> string list -> unit 11 | val hashconvert : ZZp.zz list -> string list 12 | val log_diffs : string -> string list -> unit 13 | val update_recover_list : ZZp.zz list -> UnixLabels.sockaddr -> unit 14 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 4 | script: bash -ex .travis-opam.sh 5 | matrix: 6 | include: 7 | - env: OCAML_VERSION=4.08 8 | os: osx 9 | - env: OCAML_VERSION=4.02 10 | os: linux 11 | - env: OCAML_VERSION=4.03 12 | os: linux 13 | - env: OCAML_VERSION=4.04 14 | os: linux 15 | - env: OCAML_VERSION=4.05 16 | os: linux 17 | - env: OCAML_VERSION=4.06 18 | os: linux 19 | - env: OCAML_VERSION=4.07 20 | os: linux 21 | - env: OCAML_VERSION=4.08 22 | os: linux 23 | - env: OCAML_VERSION=4.09 24 | os: linux 25 | - env: OCAML_VERSION=4.10 26 | os: linux 27 | -------------------------------------------------------------------------------- /bdb/ocextr.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open MoreLabels 3 | open Printf 4 | 5 | let fname = try Sys.argv.(1) with _ -> 6 | eprintf "No file specified\n"; 7 | exit (-1) 8 | 9 | let file = open_in fname 10 | let () = 11 | try 12 | while true do 13 | let line = input_line file in 14 | let length = String.length line in 15 | if length >= 3 && 16 | String.sub line ~pos:0 ~len:3 = "//+" 17 | then 18 | if length = 3 then print_string "\n" 19 | else 20 | if line.[3] = ' ' then 21 | printf "%s\n" (String.sub line ~pos:4 ~len:(length - 4)) 22 | else 23 | printf "%s\n" (String.sub line ~pos:3 ~len:(length - 3)) 24 | done 25 | with 26 | End_of_file -> () 27 | -------------------------------------------------------------------------------- /server.mli: -------------------------------------------------------------------------------- 1 | exception Bug of string 2 | val solving : float ref 3 | val lookup : float ref 4 | val flushtime : float ref 5 | val unmarsh_time : float ref 6 | val solve : 7 | remote_size:int -> 8 | local_size:int -> 9 | remote_samples:ZZp.mut_array -> 10 | local_samples:ZZp.mut_array -> 11 | points:ZZp.zz array -> (ZZp.Set.t * ZZp.Set.t) option 12 | val handle_one : 13 | 'a PrefixTree.tree -> 14 | < read_int : int; read_string : int -> string; .. > -> 15 | < flush : 'b; outchan : out_channel; write_int : int -> 'c; .. > -> 16 | bool * ZZp.Set.t 17 | val recover_timeout : int 18 | val handle : 19 | 'a PrefixTree.tree -> 20 | < read_int : int; read_string : int -> string; .. > -> 21 | < flush : 'b; outchan : out_channel; write_int : int -> 'c; .. > -> ZZp.Set.t 22 | -------------------------------------------------------------------------------- /bdb/script.ml: -------------------------------------------------------------------------------- 1 | open Db3 2 | open Printf 3 | 4 | (* let _ = popt (Some 8) 5 | let _ = popt None *) 6 | 7 | (* let _ = Dbenv.sopen dbe "DBTEST" 8 | [Dbenv.DB_CREATE ; Dbenv.DB_INIT_MPOOL] 0o777 *) 9 | 10 | let db = Db.sopen "testdb" Db.BTREE [Db.CREATE] 0o777 11 | let _ = 12 | (try 13 | let rval = Db.get db "foobar" [] in 14 | printf "Result unexpectedly found: %s\n" rval 15 | with 16 | Not_found -> printf "Not_found\n"); 17 | Db.put db ~key:"foo" ~data:"bar" []; 18 | let data = Db.get db "foo" [] in 19 | printf "key: %s, data: %s\n" "foo" data; 20 | Db.del db "foo"; 21 | (try 22 | let rval = Db.get db "foobar" [] in 23 | printf "Result unexpectedly found: %s\n" rval 24 | with 25 | Not_found -> printf "Not_found\n") 26 | 27 | 28 | -------------------------------------------------------------------------------- /reconCS.mli: -------------------------------------------------------------------------------- 1 | val connect : 2 | 'a PrefixTree.tree -> 3 | filters:string list -> 4 | partner:UnixLabels.addr_info -> ZZp.Set.t * UnixLabels.sockaddr 5 | val handle_connection : 6 | 'a PrefixTree.tree -> 7 | filters:string list -> 8 | partner:UnixLabels.sockaddr -> 9 | < fd : UnixLabels.file_descr; read_int : int; 10 | read_string : int -> string; .. > -> 11 | < flush : 'b; outchan : out_channel; upcast : #Channel.out_channel_obj; 12 | write_byte : int -> unit; write_char : char -> unit; 13 | write_float : float -> unit; write_int : int -> unit; 14 | write_int32 : int32 -> unit; write_int64 : int64 -> unit; 15 | write_string : string -> unit; 16 | write_string_pos : buf:string -> pos:int -> len:int -> unit; .. > -> 17 | ZZp.Set.t * UnixLabels.sockaddr 18 | -------------------------------------------------------------------------------- /ehandlers.mli: -------------------------------------------------------------------------------- 1 | val repeat_until : 2 | redo_timeout:float -> 3 | full_timeout:float -> 4 | test:(unit -> bool) -> 5 | init:(unit -> 'a) -> 6 | request:(unit -> Eventloop.timed_event list) -> 7 | success:(unit -> Eventloop.timed_event list) -> 8 | failure:(unit -> Eventloop.timed_event list) -> Eventloop.timed_event list 9 | val float_incr : float -> float 10 | val float_decr : float -> float 11 | val strftime : float -> string 12 | val repeat_forever : 13 | ?jitter:float -> 14 | ?start:float -> float -> Eventloop.callback -> Eventloop.timed_event list 15 | val repeat_forever_simple : 16 | float -> (unit -> 'a) -> Eventloop.timed_event list 17 | val incr_day : float -> float 18 | val set_hour : float -> int -> float 19 | val repeat_at_hour : 20 | int -> (unit -> Eventloop.timed_event list) -> Eventloop.timed_event list 21 | -------------------------------------------------------------------------------- /stats.mli: -------------------------------------------------------------------------------- 1 | val last : 'a list -> 'a 2 | type histogram_entry = { 3 | upper : float; 4 | lower : float; 5 | mutable num_adds : int; 6 | mutable num_dels : int; 7 | } 8 | external get_tzname : unit -> string * string = "caml_get_tzname" 9 | val time_to_tz_string : float -> string 10 | val time_to_string : float -> string 11 | val time_to_date : float -> string 12 | val time_to_hour : float -> string 13 | val round_up_to_day : float -> float 14 | val round_up_to_hour : float -> float 15 | val histogram_log : 16 | now:float -> float -> (float * Common.event) array -> histogram_entry array 17 | val histogram_to_table : (float -> string) -> histogram_entry array -> string 18 | val info_tables : unit -> string 19 | val generate_html_stats_page : (float * Common.event) list -> int -> string 20 | val generate_html_stats_page_nostats : unit -> string 21 | -------------------------------------------------------------------------------- /fixkey.mli: -------------------------------------------------------------------------------- 1 | exception Bad_key 2 | exception Standalone_revocation_certificate 3 | val filters : string list 4 | val get_keypacket : KeyMerge.pkey -> Packet.packet 5 | val ( |= ) : ('a, 'b) PMap.Map.t -> 'a -> 'b 6 | val ( |< ) : ('a, 'b) PMap.Map.t -> 'a * 'b -> ('a, 'b) PMap.Map.t 7 | val join_by_keypacket : KeyMerge.pkey list -> KeyMerge.pkey list list 8 | val merge_pkeys : KeyMerge.pkey list -> KeyMerge.pkey 9 | val compute_merge_replacements : 10 | Packet.packet list list -> 11 | (Packet.packet list list * Packet.packet list) list 12 | val canonicalize : Packet.packet list -> Packet.packet list 13 | val good_key : Packet.packet -> bool 14 | val good_signature : Packet.packet -> bool 15 | val drop_bad_sigs : Packet.packet list -> Packet.packet list 16 | val sig_filter_sigpair : 17 | 'a * Packet.packet list -> ('a * Packet.packet list) option 18 | val presentation_filter : Packet.packet list -> Packet.packet list option 19 | -------------------------------------------------------------------------------- /smtp_script.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python2 2 | 3 | # Simple script for sending out messages via smtp. 4 | # This is an alternative to using sendmail 5 | 6 | import smtplib 7 | import os 8 | import sys 9 | import string 10 | 11 | msg = [ line for line in sys.stdin ] 12 | msgtext = string.join([line[:-1] for line in msg],sep="\n") 13 | 14 | def get_headers(msg): 15 | i = 0 16 | headers = {} 17 | while i < len(msg): 18 | line = msg[i] 19 | line = line[:-1] 20 | if line == "": break 21 | (field,data) = line.split(":",1) 22 | field = field.lower().strip() 23 | data = data.strip() 24 | if field == "from": 25 | headers["from"] = data 26 | elif field == "to": 27 | headers["to"] = [ addr.strip() for addr in data.split(",") ] 28 | i = i + 1 29 | return headers 30 | 31 | headers = get_headers(msg) 32 | smtp = smtplib.SMTP("smtp.earthlink.net") 33 | smtp.sendmail(headers["from"],headers["to"],msgtext) 34 | -------------------------------------------------------------------------------- /nbMsgContainer.mli: -------------------------------------------------------------------------------- 1 | module type MsgMarshal = 2 | sig 3 | type msg_t 4 | val marshal : Channel.out_channel_obj -> msg_t -> unit 5 | val unmarshal : Channel.in_channel_obj -> msg_t 6 | val to_string : msg_t -> string 7 | val print : string -> unit 8 | end 9 | module Container : 10 | functor (Msg : MsgMarshal) -> 11 | sig 12 | val bufc : Channel.buffer_out_channel 13 | type msg_container = { msg : Msg.msg_t; } 14 | val marshal_noflush : 15 | < outchan : out_channel; write_int : int -> 'a; .. > -> 16 | Msg.msg_t -> unit 17 | val marshal : 18 | < flush : 'a; outchan : out_channel; write_int : int -> 'b; .. > -> 19 | Msg.msg_t -> 'a 20 | val last_length : int option ref 21 | val try_unmarshal : 22 | < fd : Unix.file_descr; read_int : int; read_string : int -> string; 23 | .. > -> 24 | msg_container option 25 | val unmarshal : 26 | < read_int : int; read_string : int -> string; .. > -> msg_container 27 | end 28 | -------------------------------------------------------------------------------- /rMisc.mli: -------------------------------------------------------------------------------- 1 | val det_rng : Random.State.t 2 | val stringset_to_string : string PSet.Set.t -> string 3 | val digest_stringset : string PSet.Set.t -> Digest.t 4 | val print_lengths : string list -> unit 5 | val random_string : (unit -> int) -> int -> string 6 | val conv_chans : 7 | in_channel * out_channel -> 8 | MeteredChannel.metered_in_channel * MeteredChannel.metered_out_channel 9 | val add_random : (unit -> int) -> int -> string PSet.Set.t -> string PSet.Set.t 10 | val add_n_random : 11 | (unit -> int) -> int -> n:int -> string PSet.Set.t -> string PSet.Set.t 12 | val det_string_set : bytes:int -> size:int -> string PSet.Set.t 13 | val rand_string_set : bytes:int -> size:int -> string PSet.Set.t 14 | val localize_string_set : 15 | bytes:int -> diff:int -> string PSet.Set.t -> string PSet.Set.t 16 | val pad : string -> int -> string 17 | val padset : string PSet.Set.t -> int -> string PSet.Set.t 18 | val truncate : string -> int -> string 19 | val truncset : string PSet.Set.t -> int -> string PSet.Set.t 20 | val order_string : string 21 | -------------------------------------------------------------------------------- /client.mli: -------------------------------------------------------------------------------- 1 | exception Bug of string 2 | type 'a bottomQ_entry 3 | type reconbound 4 | exception Continue 5 | val send_request : 6 | < outchan : out_channel; write_int : int -> 'a; .. > -> 7 | 'b PrefixTree.tree -> 8 | bottomQ:(PrefixTree.node * Bitstring.t) bottomQ_entry Queue.t -> 9 | PrefixTree.node * Bitstring.t -> unit 10 | val handle_reply : 11 | < outchan : out_channel; write_int : int -> 'a; .. > -> 12 | 'b PrefixTree.tree -> 13 | requestQ:(PrefixTree.node * Bitstring.t) Queue.t -> 14 | ReconMessages.msg_container -> 15 | PrefixTree.node * Bitstring.t -> ZZp.Set.t ref -> unit 16 | val connection_manager : 17 | < fd : UnixLabels.file_descr; read_int : int; 18 | read_string : int -> string; .. > -> 19 | < flush : 'a; outchan : out_channel; write_int : int -> 'b; .. > -> 20 | 'c PrefixTree.tree -> PrefixTree.node * Bitstring.t -> ZZp.Set.t 21 | val handle : 22 | 'a PrefixTree.tree -> 23 | < fd : UnixLabels.file_descr; read_int : int; 24 | read_string : int -> string; .. > -> 25 | < flush : 'b; outchan : out_channel; write_int : int -> 'c; .. > -> 26 | ZZp.Set.t 27 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "sks" 3 | maintainer: "ygrek@autistici.org" 4 | homepage: "https://github.com/SKS-Keyserver/sks-keyserver" 5 | synopsis: "OpenPGP keyserver" 6 | license: "GPL2" 7 | authors: [ 8 | "Yaron Minsky" 9 | "Kristian Fiskerstrand" 10 | "John Clizbe" 11 | ] 12 | doc: [ "https://github.com/SKS-Keyserver/sks-keyserver/wiki" ] 13 | bug-reports: "https://github.com/SKS-Keyserver/sks-keyserver/issues" 14 | dev-repo: "git+https://github.com/SKS-Keyserver/sks-keyserver" 15 | build: [ 16 | [make "dep"] 17 | [make "LIBDB=-ldb-5.3" "all"] { os != "macos" } 18 | [make "LIBDB=-ldb-4.8" "BDBINCLUDE=-I/usr/local/opt/berkeley-db@4/include" "BDBLIB=-L/usr/local/opt/berkeley-db@4/lib" "all"] { os = "macos" } 19 | [make "doc"] {with-doc} 20 | ] 21 | #install: [ 22 | # [make "PREFIX=%{prefix}%" "install"] 23 | #] 24 | run-test: [ 25 | ["./sks" "unit_test"] 26 | ] 27 | depends: [ 28 | "ocamlfind" {build} 29 | "base-unix" 30 | "base-bytes" 31 | "cryptokit" 32 | "num" 33 | ] 34 | depexts: [ 35 | ["libdb5.3-dev"] {os-family = "debian"} 36 | ["berkeley-db@4"] {os-distribution = "homebrew" & os = "macos"} 37 | ] 38 | -------------------------------------------------------------------------------- /poly.mli: -------------------------------------------------------------------------------- 1 | val rfind : f:(int -> bool) -> int -> int -> int 2 | type t = { a : ZZp.zz array; degree : int; } 3 | val compute_degree : ZZp.zz array -> int 4 | val init : int -> f:(int -> ZZp.zz) -> t 5 | val make : int -> ZZp.zz -> t 6 | val zero : t 7 | val one : t 8 | val degree : t -> int 9 | val length : t -> int 10 | val copy : t -> t 11 | val to_string : t -> string 12 | val splitter : Str.regexp 13 | val parse_digit : string -> int * ZZp.zz 14 | val map_keys : ('a, 'b) PMap.Map.t -> 'a list 15 | val of_string : string -> t 16 | val print : t -> unit 17 | exception NotEqual 18 | val eq : t -> t -> bool 19 | val of_array : ZZp.zz array -> t 20 | val term : int -> ZZp.zz -> t 21 | val set_length : int -> t -> t 22 | val to_array : t -> ZZp.zz array 23 | val is_monic : t -> bool 24 | val eval : t -> ZZp.zz -> ZZp.zz 25 | val mult : t -> t -> t 26 | val scmult : t -> ZZp.zz -> t 27 | val add : t -> t -> t 28 | val neg : t -> t 29 | val sub : t -> t -> t 30 | val divmod : t -> t -> t * t 31 | val modulo : t -> t -> t 32 | val div : t -> t -> t 33 | val const_coeff : t -> ZZp.zz 34 | val nth_coeff : t -> int -> ZZp.zz 35 | val const : ZZp.zz -> t 36 | val gcd_rec : t -> t -> t 37 | val gcd : t -> t -> t 38 | -------------------------------------------------------------------------------- /prefixTree.mli: -------------------------------------------------------------------------------- 1 | type 'a tree 2 | type node 3 | type 'a db 4 | type 'a disk 5 | 6 | val create : 7 | ?db:(string -> string) * ('a option -> key:string -> data:string -> unit) * 8 | ('a option -> string -> unit) * 9 | ((unit -> 'a option) * ('a option -> unit) * ('a option -> unit)) * 10 | int -> 11 | txn:'a option -> 12 | num_samples:int -> bitquantum:int -> thresh:int -> unit -> 'a tree 13 | val child_keys : 'a tree -> Bitstring.t -> Bitstring.t list 14 | val get_zzp_elements : 'a tree -> node -> ZZp.Set.t 15 | val clean : 'a option -> 'a tree -> unit 16 | val points : 'a tree -> ZZp.zz array 17 | val get_node_key : ?sef:bool -> 'a tree -> Bitstring.t -> node 18 | val svalues : node -> ZZp.mut_array 19 | val size : node -> int 20 | val is_leaf : node -> bool 21 | val num_elements : 'a -> node -> int 22 | val elements : 'a tree -> node -> ZZp.Set.t 23 | val root : 'a tree -> node 24 | val get_random : 'a tree -> node -> string 25 | 26 | val set_synctime : 'a tree -> float -> unit 27 | val get_synctime : 'a tree -> float 28 | 29 | val insert_str : 'a tree -> 'a option -> string -> unit 30 | val delete_str : 'a tree -> 'a option -> string -> unit 31 | 32 | val set_maxnodes : 'a tree -> 'a option -> int -> unit 33 | -------------------------------------------------------------------------------- /bitstring.mli: -------------------------------------------------------------------------------- 1 | exception Error of string 2 | exception LengthError of string 3 | val width : int 4 | type t 5 | val bytelength : int -> int 6 | val create : int -> t 7 | val get : t -> int -> int 8 | val lget : t -> int -> bool 9 | val flip : t -> int -> unit 10 | val set : t -> int -> unit 11 | val unset : t -> int -> unit 12 | val setval : t -> int -> bool -> unit 13 | val print : t -> unit 14 | val hexprint : t -> unit 15 | val to_bool_array : t -> bool array 16 | val to_string : t -> string 17 | val to_bytes : t -> string 18 | val of_bytes : string -> int -> t 19 | val of_byte : int -> t 20 | val of_bytes_all : string -> t 21 | val of_int : int -> t 22 | val of_bytes_nocopy : string -> int -> t 23 | val of_bytes_all_nocopy : string -> t 24 | val to_bytes_nocopy : t -> string 25 | val copy : t -> t 26 | val copy_len : t -> int -> t 27 | val shift_pair_left : char -> char -> int -> char 28 | val shift_pair_right : char -> char -> int -> char 29 | val shift_left_small : t -> int -> unit 30 | val shift_right_small : t -> int -> unit 31 | val shift_left : t -> int -> unit 32 | val shift_right : t -> int -> unit 33 | val num_bits : t -> int 34 | val num_bytes : t -> int 35 | val rmasks : int array 36 | val blit : src:t -> dst:t -> len:int -> unit 37 | val zero_out : t -> unit 38 | -------------------------------------------------------------------------------- /reconMessages.mli: -------------------------------------------------------------------------------- 1 | type recon_rqst_poly = { 2 | rp_prefix : Bitstring.t; 3 | rp_size : int; 4 | rp_samples : ZZp.mut_array; 5 | } 6 | 7 | type recon_rqst_full = { rf_prefix : Bitstring.t; rf_elements : ZZp.Set.t; } 8 | 9 | type configdata = (string, string) PMap.Map.t 10 | 11 | type msg = 12 | | ReconRqst_Poly of recon_rqst_poly 13 | | ReconRqst_Full of recon_rqst_full 14 | | Elements of ZZp.Set.t 15 | | FullElements of ZZp.Set.t 16 | | SyncFail 17 | | Done 18 | | Flush 19 | | Error of string 20 | | DbRqst of string 21 | | DbRepl of string 22 | | Config of configdata 23 | 24 | val msg_to_string : msg -> string 25 | 26 | module M : sig 27 | type msg_container = { msg : msg; } 28 | end 29 | type msg_container = M.msg_container = { msg : msg; } 30 | val marshal_noflush : 31 | < outchan : out_channel; write_int : int -> 'a; .. > -> msg -> unit 32 | val marshal : 33 | < flush : 'a; outchan : out_channel; write_int : int -> 'b; .. > -> 34 | msg -> 'a 35 | val try_unmarshal : 36 | < fd : UnixLabels.file_descr; read_int : int; 37 | read_string : int -> string; .. > -> 38 | msg_container option 39 | val unmarshal : 40 | < read_int : int; read_string : int -> string; .. > -> msg_container 41 | val sockaddr_to_string : Unix.sockaddr -> string 42 | -------------------------------------------------------------------------------- /reconserver.mli: -------------------------------------------------------------------------------- 1 | module F : 2 | functor (M : sig end) -> 3 | sig 4 | val settings : PTreeDB.ptree_settings 5 | val reconsocks : Unix.file_descr list 6 | val comsock : Unix.file_descr 7 | val filters : string list option ref 8 | val get_filters : unit -> string list 9 | val eventify_handler : 10 | ('a -> Channel.sys_in_channel -> Channel.sys_out_channel -> 'b) -> 11 | 'a -> in_channel -> out_channel -> 'b 12 | val choose_partner : unit -> PTreeDB.Unix.addr_info 13 | val missing_keys_timeout : int 14 | val get_missing_keys : unit -> Eventloop.timed_event list 15 | val sockaddr_to_name : PTreeDB.Unix.sockaddr -> string 16 | val recon_handler : 17 | UnixLabels.sockaddr -> 18 | in_channel -> out_channel -> Eventloop.timed_event list 19 | val initiate_recon : unit -> Eventloop.timed_event list 20 | val command_handler : 21 | 'a -> 22 | < upcast : Channel.in_channel_obj; .. > -> 23 | < flush : 'b; upcast : Channel.out_channel_obj; .. > -> 24 | Eventloop.timed_event list 25 | val sync_interval : float 26 | val sync_tree : unit -> unit 27 | val checkpoint_interval : float 28 | val prepare : unit -> unit 29 | val run : unit -> unit 30 | end 31 | -------------------------------------------------------------------------------- /reconPTreeDb.mli: -------------------------------------------------------------------------------- 1 | module PTree : 2 | sig 3 | type 'a tree = 'a PrefixTree.tree 4 | type node = PrefixTree.node 5 | type 'a db = 'a PrefixTree.db 6 | type 'a disk = 'a PrefixTree.disk 7 | val create : 8 | ?db:(string -> string) * 9 | ('a option -> key:string -> data:string -> unit) * 10 | ('a option -> string -> unit) * 11 | ((unit -> 'a option) * ('a option -> unit) * ('a option -> unit)) * 12 | int -> 13 | txn:'a option -> 14 | num_samples:int -> bitquantum:int -> thresh:int -> unit -> 'a tree 15 | val child_keys : 'a tree -> Bitstring.t -> Bitstring.t list 16 | val get_zzp_elements : 'a tree -> node -> ZZp.Set.t 17 | val clean : 'a option -> 'a tree -> unit 18 | val points : 'a tree -> ZZp.zz array 19 | val get_node_key : ?sef:bool -> 'a tree -> Bitstring.t -> node 20 | val svalues : node -> ZZp.mut_array 21 | val size : node -> int 22 | val is_leaf : node -> bool 23 | val num_elements : 'a -> node -> int 24 | val elements : 'a tree -> node -> ZZp.Set.t 25 | val root : 'a tree -> node 26 | val get_random : 'a tree -> node -> string 27 | val set_synctime : 'a tree -> float -> unit 28 | val get_synctime : 'a tree -> float 29 | val insert_str : 'a tree -> 'a option -> string -> unit 30 | val delete_str : 'a tree -> 'a option -> string -> unit 31 | val set_maxnodes : 'a tree -> 'a option -> int -> unit 32 | end 33 | -------------------------------------------------------------------------------- /UPGRADING: -------------------------------------------------------------------------------- 1 | In general, it is possible to upgrade a database to a new version of 2 | Berkeley DB without rebuilding as most upgrades of bdb only require a 3 | change to the log file. 4 | 5 | For example, if one wishes to upgrade sks and bdb from db51 to db53: 6 | 7 | 8 | cd /var/sks # default location 9 | for DB in KDB PTree 10 | do 11 | db51_recover -eh $DB # feels extra, some Oracle docs recommend 12 | db51_recover -h $DB # run again, this time removing DB env 13 | db51_checkpoint -1h $DB # checkpoint with old version 14 | done 15 | # 16 | 18 | # 19 | for DB in KDB PTree 20 | do 21 | db53_checkpoint -1h $DB # checkpoint and convert the log 22 | db53_recover -eh $DB # run db_recover and recreate env 23 | db53_archive -dh $DB # remove old log files 24 | done 25 | # 26 | 28 | 29 | 30 | see http://docs.oracle.com/cd/E17275_01/html/programmer_reference/upgrade_process.html 31 | as well as the release notes for the new version of bdb being installed 32 | 33 | Help is, as usual, available from the Sks-devel mailing list, 34 | Sks-devel@nongnu.org. https://lists.nongnu.org/mailman/listinfo/sks-devel 35 | 36 | -------------------------------------------------------------------------------- /parsePGP.mli: -------------------------------------------------------------------------------- 1 | exception Overlong_mpi 2 | exception Partial_body_length of int 3 | val parse_new_packet_length : < read_byte : int; .. > -> int 4 | val read_packet : 5 | < read_byte : int; read_string : int -> string; .. > -> Packet.packet 6 | val offset_read_packet : 7 | < inchan : in_channel; read_byte : int; read_string : int -> string; .. > -> 8 | int64 * Packet.packet 9 | val offset_length_read_packet : 10 | < inchan : in_channel; read_byte : int; read_string : int -> string; .. > -> 11 | Packet.packet * int * int 12 | val read_mpi : 13 | < read_byte : int; read_string : int -> string; .. > -> Packet.mpi 14 | val read_mpis : 15 | < read_byte : int; read_string : int -> string; .. > -> Packet.mpi list 16 | val parse_pubkey_info : Packet.packet -> Packet.pubkeyinfo 17 | val parse_sigsubpacket_length : < read_byte : int; .. > -> int 18 | val read_sigsubpacket : 19 | < read_byte : int; read_string : int -> string; .. > -> Packet.sigsubpacket 20 | val get_hashed_subpacket_string : 21 | < read_byte : int; read_int_size : int -> 'a; read_string : 'a -> 'b; .. > -> 22 | 'b 23 | val read_subpackets : 24 | < read_string : 'a -> string; .. > -> 'a -> Packet.sigsubpacket list 25 | val parse_signature : Packet.packet -> Packet.signature 26 | val ssp_ctime_id : int 27 | val ssp_exptime_id : int 28 | val int32_of_string : string -> int32 29 | val int64_of_string : string -> int64 30 | val get_times : Packet.signature -> int64 option * int64 option 31 | val get_key_exptimes : Packet.signature -> int64 option * int64 option 32 | -------------------------------------------------------------------------------- /dbMessages.mli: -------------------------------------------------------------------------------- 1 | type configvar = 2 | [ `float of float | `int of int | `none | `string of string ] 3 | 4 | type msg = 5 | WordQuery of string list 6 | | LogQuery of (int * Common.timestamp) 7 | | HashRequest of string list 8 | | LogResp of (Common.timestamp * Common.event) list 9 | | Keys of Packet.key list 10 | | KeyStrings of string list 11 | | Ack of int 12 | | MissingKeys of (string list * Unix.sockaddr) 13 | | Synchronize 14 | | RandomDrop of int 15 | | ProtocolError 16 | | DeleteKey of string 17 | | Config of (string * configvar) 18 | | Filters of string list 19 | 20 | val marshal_msg : 21 | < upcast : #Channel.out_channel_obj; write_byte : int -> unit; 22 | write_char : char -> unit; write_float : Common.timestamp -> unit; 23 | write_int : int -> unit; write_int32 : int32 -> unit; 24 | write_int64 : int64 -> unit; write_string : string -> unit; 25 | write_string_pos : buf:string -> pos:int -> len:int -> unit; .. > -> 26 | msg -> unit 27 | val unmarshal_msg : 28 | < read_byte : int; read_float : Common.timestamp; read_int : int; 29 | read_string : int -> string; .. > -> 30 | msg 31 | val sockaddr_to_string : Unix.sockaddr -> string 32 | val msg_to_string : msg -> string 33 | module M : sig 34 | type msg_container = { msg : msg; } 35 | end 36 | type msg_container = M.msg_container = { msg : msg; } 37 | val marshal_noflush : < upcast : Channel.out_channel_obj; .. > -> msg -> unit 38 | val marshal : 39 | < flush : 'a; upcast : Channel.out_channel_obj; .. > -> msg -> 'a 40 | val unmarshal : < upcast : Channel.in_channel_obj; .. > -> msg_container 41 | -------------------------------------------------------------------------------- /wserver.mli: -------------------------------------------------------------------------------- 1 | exception Page_not_found of string 2 | exception No_results of string 3 | exception Not_implemented of string 4 | exception Bad_request of string 5 | exception Entity_too_large of string 6 | exception Misc_error of string 7 | val ( |= ) : ('a, 'b) PMap.Map.t -> 'a -> 'b 8 | val ( |< ) : ('a, 'b) PMap.Map.t -> 'a * 'b -> ('a, 'b) PMap.Map.t 9 | val hexa_digit : int -> char 10 | val hexa_val : char -> int 11 | val decode : string -> string 12 | val special : char -> bool 13 | val encode : string -> string 14 | val stripchars : char PSet.Set.t 15 | val strip : string -> string 16 | type 'a request = 17 | | GET of (string * (string, string) PMap.Map.t) 18 | | POST of (string * (string, string) PMap.Map.t * 'a) 19 | val whitespace : Str.regexp 20 | val eol : Str.regexp 21 | val get_all : in_channel -> string 22 | val get_lines : in_channel -> string list 23 | val max_post_length : int 24 | val parse_post : (string, string) PMap.Map.t -> in_channel -> string 25 | val is_blank : string -> bool 26 | val parse_headers : 27 | (string, string) PMap.Map.t -> in_channel -> (string, string) PMap.Map.t 28 | val parse_request : in_channel -> string request 29 | val headers_to_string : (string, string) PMap.Map.t -> string 30 | val request_to_string : 'a request -> string 31 | val request_to_string_short : 'a request -> string 32 | val send_result : 33 | out_channel -> 34 | ?error_code:int -> ?content_type:string -> ?count:int -> string -> unit 35 | val accept_connection : 36 | ('a -> string request -> Channel.out_channel_obj -> string * int) -> 37 | recover_timeout:int -> 'a -> in_channel -> out_channel -> 'b list 38 | -------------------------------------------------------------------------------- /key.mli: -------------------------------------------------------------------------------- 1 | exception Bug of string 2 | val pos_next_rec : 3 | ('a * Packet.packet) SStream.sstream -> 4 | Packet.packet list -> Packet.packet list option 5 | val pos_next : 6 | ('a * Packet.packet) SStream.sstream -> ('a * Packet.packet list) option 7 | val pos_get : ('a * Packet.packet) SStream.sstream -> 'a * Packet.packet list 8 | val pos_next_of_channel : 9 | < inchan : in_channel; read_byte : int; read_string : int -> string; .. > -> 10 | unit -> (int64 * Packet.packet list) option 11 | val pos_get_of_channel : 12 | < inchan : in_channel; read_byte : int; read_string : int -> string; .. > -> 13 | unit -> int64 * Packet.packet list 14 | val next_rec : 15 | Packet.packet SStream.sstream -> 16 | Packet.packet list -> Packet.packet list option 17 | val next : Packet.packet SStream.sstream -> Packet.packet list option 18 | val get : Packet.packet SStream.sstream -> Packet.packet list 19 | val next_of_channel : 20 | < read_byte : int; read_string : int -> string; .. > -> 21 | unit -> Packet.packet list option 22 | val get_of_channel : 23 | < read_byte : int; read_string : int -> string; .. > -> 24 | unit -> Packet.packet list 25 | val get_ids : Packet.packet list -> string list 26 | val write : 27 | Packet.packet list -> 28 | < write_byte : int -> 'a; write_int : int -> 'b; 29 | write_string : string -> unit; .. > -> 30 | unit 31 | val to_string : Packet.packet list -> string 32 | val of_string : string -> Packet.packet list 33 | val of_string_multiple : string -> Packet.packet list list 34 | val to_string_multiple : Packet.packet list list -> string 35 | val to_words : Packet.packet list -> string list 36 | -------------------------------------------------------------------------------- /sampleWeb/OpenPKG/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | SKS OpenPGP Public Key Server 7 | 8 | 9 |

SKS OpenPGP Public Key Server

10 |
11 |

12 | Extracting a OpenPGP Key 13 |

14 |
15 |

Index: 16 | 17 | Verbose Index: 18 | 19 |

20 |

Search String: 21 | 22 |

23 |

24 | 25 | Show OpenPGP "fingerprints" for keys

26 |

27 | 28 | Only return exact matches

29 |

30 | 31 | 32 | 33 |

34 |
35 |
36 |

37 | Submitting a new OpenPGP Key 38 |

39 |
40 |

Enter ASCII-armored OpenPGP key here:

41 |

42 | 43 |

44 |

45 | 46 | 47 | 48 |

49 |
50 |
51 | 52 | 53 | -------------------------------------------------------------------------------- /sks_build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # SKS build script. 4 | # cd to directory with "dump" subdirectory, and run 5 | # You might want to edit this file to reduce or increase memory usage 6 | # depending on your system 7 | 8 | trap ignore_signal USR1 USR2 9 | 10 | ignore_signal() { 11 | echo "Caught user signal 1 or 2, ignoring" 12 | } 13 | 14 | ask_mode() { 15 | echo "Please select the mode in which you want to import the keydump:" 16 | echo "" 17 | echo "1 - fastbuild" 18 | echo " only an index of the keydump is created and the keydump cannot be" 19 | echo " removed." 20 | echo "" 21 | echo "2 - normalbuild" 22 | echo "" 23 | echo " all the keydump will be imported in a new database. It takes longer" 24 | echo " time and more disk space, but the server will run faster (depending" 25 | echo " from the source/age of the keydump)." 26 | echo " The keydump can be removed after the import." 27 | echo "" 28 | echo -n "Enter enter the mode (1/2): " 29 | read 30 | case "$REPLY" in 31 | 1) 32 | mode="fastbuild" 33 | ;; 34 | 2) 35 | mode="build /var/lib/sks/dump/*.pgp" 36 | ;; 37 | *) 38 | echo "Option unknown. bye!" 39 | exit 1 40 | ;; 41 | esac 42 | } 43 | 44 | fail() { echo Command failed unexpectedly. Bailing out; exit -1; } 45 | 46 | ask_mode 47 | 48 | echo "=== Running (fast)build... ===" 49 | if ! /usr/sbin/sks $mode -n 10 -cache 100; then fail; fi 50 | echo === Cleaning key database... === 51 | if ! /usr/sbin/sks cleandb; then fail; fi 52 | echo === Building ptree database... === 53 | if ! /usr/sbin/sks pbuild -cache 20 -ptree_cache 70; then fail; fi 54 | echo === Done! === 55 | -------------------------------------------------------------------------------- /reconPTreeDb.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* reconPTreeDb.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | open Common 26 | module PTree = PrefixTree 27 | 28 | -------------------------------------------------------------------------------- /ptscript.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* ptscript.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open PdiskTest 24 | open PTree 25 | 26 | let () = 27 | Settings.prob := 0.0 28 | 29 | let () = 30 | runtest 100 31 | 32 | -------------------------------------------------------------------------------- /sampleConfig/crontab.sample: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* sample.crontab - Using SIGUSR2 to generate on-demand statistics *# 3 | #* USR1 checkpoints the databases *# 4 | #* HUP reopens the log files - useful for logrotate *# 5 | #* *# 6 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 7 | #* *# 8 | #* This file is part of SKS. SKS is free software; you can *# 9 | #* redistribute it and/or modify it under the terms of the GNU General *# 10 | #* Public License as published by the Free Software Foundation; either *# 11 | #* version 2 of the License, or (at your option) any later version. *# 12 | #* *# 13 | #* This program is distributed in the hope that it will be useful, but *# 14 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 15 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 16 | #* General Public License for more details. *# 17 | #* *# 18 | #* You should have received a copy of the GNU General Public License *# 19 | #* along with this program; if not, write to the Free Software *# 20 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 21 | #* USA or see . *# 22 | #************************************************************************# 23 | 24 | # SKS stats on the hour 25 | 0 * * * * pkill -USR2 sks || exit 1 26 | 27 | -------------------------------------------------------------------------------- /mTimer.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* mTimer.mli - Simple timer module *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | type t 24 | val create : unit -> t 25 | val start : t -> unit 26 | val stop : t -> unit 27 | val reset : t -> unit 28 | val read : t -> float 29 | val read_us : t -> float 30 | val read_ms : t -> float 31 | -------------------------------------------------------------------------------- /sampleConfig/DB_CONFIG: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* DB_CONFIG - Sample Berkeley DB tunables for use with SKS *# 3 | #* *# 4 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 5 | #* *# 6 | #* This file is part of SKS. SKS is free software; you can *# 7 | #* redistribute it and/or modify it under the terms of the GNU General *# 8 | #* Public License as published by the Free Software Foundation; either *# 9 | #* version 2 of the License, or (at your option) any later version. *# 10 | #* *# 11 | #* This program is distributed in the hope that it will be useful, but *# 12 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 13 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 14 | #* General Public License for more details. *# 15 | #* *# 16 | #* You should have received a copy of the GNU General Public License *# 17 | #* along with this program; if not, write to the Free Software *# 18 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 19 | #* USA or see . *# 20 | #************************************************************************# 21 | 22 | set_mp_mmapsize 268435456 23 | set_cachesize 0 134217728 1 24 | set_flags DB_LOG_AUTOREMOVE 25 | set_lg_regionmax 1048576 26 | set_lg_max 104857600 27 | set_lg_bsize 2097152 28 | set_lk_detect DB_LOCK_DEFAULT 29 | set_tmp_dir /tmp 30 | set_lock_timeout 1000 31 | set_txn_timeout 1000 32 | mutex_set_max 65536 33 | -------------------------------------------------------------------------------- /heap.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* heap.mli - Simple heap implementation, adapted from CLR *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | type ('key,'data) heap 24 | val length : ('key,'data) heap -> int 25 | val top : ('key,'data) heap -> 'key * 'data 26 | val pop : ('key,'data) heap -> 'key * 'data 27 | val push : ('key,'data) heap -> key:'key -> data:'data -> unit 28 | val empty : ('key -> 'key -> bool) -> int -> ('key,'data) heap 29 | -------------------------------------------------------------------------------- /tz.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************) 2 | (* tz.c - Simple timezone calculations *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************/ 22 | 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | #include 31 | #define CRC24_INIT 0xb704ceL 32 | 33 | // Simple timezone calculations 34 | 35 | -------------------------------------------------------------------------------- /sampleConfig/sksconf.minimal: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* sksconf.minimal - minimal settings for a SKS server *# 3 | #* *# 4 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 5 | #* *# 6 | #* This file is part of SKS. SKS is free software; you can *# 7 | #* redistribute it and/or modify it under the terms of the GNU General *# 8 | #* Public License as published by the Free Software Foundation; either *# 9 | #* version 2 of the License, or (at your option) any later version. *# 10 | #* *# 11 | #* This program is distributed in the hope that it will be useful, but *# 12 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 13 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 14 | #* General Public License for more details. *# 15 | #* *# 16 | #* You should have received a copy of the GNU General Public License *# 17 | #* along with this program; if not, write to the Free Software *# 18 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 19 | #* USA or see . *# 20 | #************************************************************************# 21 | # 22 | # sksconf sample for keyserver.foo.bar 23 | # ------------------------------------ 24 | # debuglevel 3 is default (max. debuglevel is 10) 25 | debuglevel: 3 26 | 27 | # set the hostname of your server 28 | hostname: keyserver.foo.bar 29 | 30 | # set short, long, or fpr of contact's OpenPGP key 31 | server_contact: 0xDECAFBADDEADBEEF 32 | 33 | # EOF 34 | -------------------------------------------------------------------------------- /bdb/dbstubs.h: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* Objective Caml */ 4 | /* */ 5 | /* Francois Rouaix, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1996 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file ../../LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | #define Max_dballoc 1000000 15 | 16 | 17 | struct camldbenv { 18 | final_fun f; 19 | DBENV *dbenv; 20 | int closed; 21 | } 22 | 23 | #define Camldbenv_wosize \ 24 | ((sizeof(struct camldbenv) + sizeof(value) - 1) / sizeof(value)) 25 | 26 | #define Camldbenv_dbenv(v) (((struct camldbenv *)(Bp_val(v)))->dbenv) 27 | #define Camldbenv_closed(v) (((struct camldbenv *)(Bp_val(v)))->closed) 28 | 29 | #define Is_string(v) (Is_block(v) && (Tag_val(v) == String_tag)) 30 | 31 | 32 | /* A DB is a finalized value containing 33 | * a pointer to the DB, 34 | * a pointer to the openstruct 35 | * (this could be removed if we were sure that the library doesn't keep 36 | * a pointer to it !) 37 | */ 38 | struct camldb { 39 | final_fun f; 40 | DB *db; 41 | // BTREEINFO *info; 42 | int closed; 43 | }; 44 | 45 | 46 | #define Camldb_wosize \ 47 | ((sizeof(struct camldb) + sizeof(value) - 1) / sizeof(value)) 48 | 49 | #define Camldb_db(v) (((struct camldb *)(Bp_val(v)))->db) 50 | #define Camldb_closed(v) (((struct camldb *)(Bp_val(v)))->closed) 51 | 52 | #define Is_string(v) (Is_block(v) && (Tag_val(v) == String_tag)) 53 | -------------------------------------------------------------------------------- /utils.mli: -------------------------------------------------------------------------------- 1 | val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b 2 | val iceil : float -> int 3 | val ifloor : float -> int 4 | val bsearch : f:(int -> int) -> low:int -> high:int -> int 5 | val bsearch_val : f:(int -> int * 'a) -> low:int -> high:int -> int * 'a 6 | val is_alnum : char -> bool 7 | val extract_words_rec : 8 | string -> start:int -> len:int -> string PSet.Set.t -> string PSet.Set.t 9 | val extract_word_set : string -> string PSet.Set.t 10 | val extract_words : string -> string list 11 | val ptest : string -> bool -> unit 12 | val for_loop : int -> int -> 'a -> (int -> 'a -> 'a) -> 'a 13 | val pair_loop : ('a * 'a -> 'b -> 'b) -> 'b -> 'a list -> 'b 14 | val for_all_pairs : ('a -> 'a -> bool) -> 'a list -> bool 15 | val neq_test : 'a * 'a -> bool -> bool 16 | val time : (unit -> 'a) -> float 17 | val random_int : int -> int -> int 18 | val char_width : int 19 | val hexstring : string -> string 20 | val int_from_bstring_rec : string -> pos:int -> len:int -> int -> int 21 | val int_from_bstring : string -> pos:int -> len:int -> int 22 | val bstring_of_int : int -> bytes 23 | val apply : int -> ('a -> 'a) -> 'a -> 'a 24 | val get_bit : pos:int -> int -> int 25 | val create_rand_bits : unit -> unit -> int 26 | val rbit : unit -> int 27 | exception FinalDouble of exn * exn 28 | exception Final of exn 29 | val try_finally : f:(unit -> 'a) -> finally:(unit -> 'b) -> 'a 30 | val rfold : f:('a -> int -> 'a) -> int -> int -> init:'a -> 'a 31 | val random_string : (unit -> int) -> int -> string 32 | val dedup : 'a list -> 'a list 33 | val unit_memoize : (unit -> 'a) -> unit -> 'a 34 | val memoize : ('a -> 'b) -> 'a -> 'b 35 | val initdbconf : string -> string -> unit 36 | class ['a] memo : 37 | 'a -> 38 | object 39 | constraint 'a = 'b -> 'c 40 | val store : ('b, 'c) MoreLabels.Hashtbl.t 41 | method apply : 'b -> 'c 42 | method clear : unit 43 | end 44 | val filter_map : f:('a -> 'b option) -> 'a list -> 'b list 45 | val bytes_uppercase : bytes -> bytes 46 | val bytes_lowercase : bytes -> bytes 47 | val lowercase : string -> string 48 | val uppercase : string -> string 49 | -------------------------------------------------------------------------------- /Unique_time.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* Unique_time.ml - Module to return unique time *) 3 | (* @author Yaron M. Minsky *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | let most_recent_unique_time : float ref = ref 0. 24 | 25 | let timestamp_delta = 0.000001 26 | 27 | let get nil = 28 | let candidate = Unix.gettimeofday() in 29 | let final = 30 | match candidate > !most_recent_unique_time with 31 | true -> candidate 32 | | false -> !most_recent_unique_time +. timestamp_delta 33 | in 34 | most_recent_unique_time := final; 35 | final 36 | -------------------------------------------------------------------------------- /recode.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* recode.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open Printf 24 | open StdLabels 25 | open MoreLabels 26 | 27 | open Packet 28 | 29 | let limit = try int_of_string Sys.argv.(1) with _ -> 10 30 | let cin = new Channel.sys_in_channel stdin 31 | let cout = new Channel.sys_out_channel stdout 32 | let getkey = Key.get_of_channel cin 33 | 34 | let _ = 35 | let count = ref 0 in 36 | ( try 37 | while !count < limit do 38 | Key.write (getkey ()) cout; 39 | incr count 40 | done 41 | with 42 | Not_found -> () ) 43 | -------------------------------------------------------------------------------- /common.mli: -------------------------------------------------------------------------------- 1 | exception Bug of string 2 | exception Transaction_aborted of string 3 | exception Argument_error of string 4 | exception Unit_test_failure of string 5 | val ( |< ) : ('a, 'b) PMap.Map.t -> 'a -> 'b -> ('a, 'b) PMap.Map.t 6 | val ( |= ) : ('a, 'b) PMap.Map.t -> 'a -> 'b 7 | val ( |! ) : 'a -> ('a -> 'b) -> 'b 8 | val enforced_filters : string list 9 | val version_tuple : int * int * int 10 | val version_suffix : string 11 | val compatible_version_tuple : int * int * int 12 | val version : string 13 | val compatible_version_string : string 14 | val period_regexp : Str.regexp 15 | val parse_version_string : string -> int * int * int 16 | val err_to_string : exn -> string 17 | val logfile : out_channel ref 18 | val stored_logfile_name : string option ref 19 | val plerror : int -> ('a, unit, string, unit) format4 -> 'a 20 | val set_logfile : string -> unit 21 | val reopen_logfile : unit -> unit 22 | val perror : ('a, unit, string, unit) format4 -> 'a 23 | val eplerror : int -> exn -> ('a, unit, string, unit) format4 -> 'a 24 | val eperror : exn -> ('a, unit, string, unit) format4 -> 'a 25 | val catch_break : bool ref 26 | val handle_interrupt : 'a -> unit 27 | val set_catch_break : bool -> unit 28 | val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a 29 | val fprotect : f:(unit -> 'a) -> finally:(unit -> unit) -> unit -> 'a 30 | val filter_opts : 'a option list -> 'a list 31 | val decomment : string -> string 32 | val strip_opt : 'a option list -> 'a list 33 | val apply_opt : f:('a -> 'b) -> 'a option -> 'b option 34 | type event = Add of string | Delete of string 35 | type timestamp = float 36 | val whitespace : Str.regexp 37 | val make_addr_list : string -> int -> Unix.sockaddr list 38 | val recon_port : int 39 | val recon_address : string 40 | val http_port : int 41 | val http_address : string 42 | val db_command_name : string 43 | val recon_command_name : string 44 | val db_command_addr : Unix.sockaddr 45 | val recon_command_addr : Unix.sockaddr 46 | val recon_addr_to_http_addr : Unix.sockaddr -> Unix.sockaddr 47 | val get_client_recon_addr : unit -> Unix.sockaddr list 48 | val match_client_recon_addr : Unix.sockaddr -> Unix.sockaddr 49 | -------------------------------------------------------------------------------- /BUGS: -------------------------------------------------------------------------------- 1 | * Some keyids don't come up when they should. 2 | The following link comes up when you look for "minsky", but the link itself 3 | doesn't work. 4 | 5 | http://sks.dnsalias.net:11371/pks/lookup?op=get&search=0x0D4F313F 6 | 7 | ---------FIXED----------------- 8 | 9 | * GPG querying is broken: 10 | 11 | $ gpg --keyserver sks.dnsalias.net --recv-key 8B4CBC9C 12 | gpg: requesting key 8B4CBC9C from HKP keyserver sks.dnsalias.net 13 | gpg: [fd 3]: read error: Connection reset by peer 14 | gpg: no valid OpenPGP data found. 15 | gpg: premature eof while reading hashed signature data 16 | gpg: key 8B4CBC9C: not changed 17 | gpg: Total number processed: 1 18 | gpg: unchanged: 1 19 | 20 | ---------FIXED----------------- 21 | 22 | * Possible DDOS on input socket. Issue is being worked on. 23 | Workaround: use reverse proxy in Apache or nginx to feed traffic to 24 | localhost:11371 25 | 26 | sksconf 27 | hkp_address: 127.0.0.1 28 | 29 | Apache Example from Peter Kornherr: 30 | 31 | ServerName 32 | ServerAdmin 33 | 34 | Order deny,allow 35 | Allow from all 36 | 37 | ProxyPass / http://127.0.0.1:11371/ 38 | ProxyPassReverse / http://127.0.0.1:11371/ 39 | SetEnv proxy-nokeepalive 1 40 | 41 | 42 | nginx example from Daniel Kahn Gillmor 43 | ------------------- 44 | server { 45 | listen 209.234.253.170:11371; 46 | listen 80; 47 | server_name keys.mayfirst.org; 48 | access_log off; 49 | location / { 50 | proxy_pass http://localhost:11371/; 51 | } 52 | } 53 | server { 54 | listen 443; 55 | server_name zimmermann.mayfirst.org; 56 | ssl on; 57 | ssl_certificate /etc/ssl/keys-m.o.crt; 58 | ssl_certificate_key /etc/ssl/private/keys.m.o-key.pem; 59 | ssl_ciphers HIGH:MEDIUM:!ADH; 60 | access_log off; 61 | location / { 62 | proxy_pass http://localhost:11371/; 63 | } 64 | } 65 | ------------------- 66 | 67 | -------------------------------------------------------------------------------- /int_comparators.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* int_comparators.ml - rename the polymorphic comparators, then *) 3 | (* constraint the usual ones to ints *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | (* rename the polymorphic comparators *) 25 | let ( <>: ) = ( <> ) 26 | let ( =: ) = ( = ) 27 | let ( <: ) = ( < ) 28 | let ( >: ) = ( > ) 29 | let ( <=: ) = ( <= ) 30 | let ( >=: ) = ( >= ) 31 | 32 | (* and then constraint the usual ones to ints *) 33 | let ( <> ) (x :int) y : bool = x <> y 34 | let ( = ) (x :int) y : bool = x = y 35 | let ( < ) (x :int) y : bool = x < y 36 | let ( > ) (x :int) y : bool = x > y 37 | let ( <= ) (x :int) y : bool = x <= y 38 | let ( >= ) (x :int) y : bool = x >= y 39 | -------------------------------------------------------------------------------- /sStream.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* sStream.ml - simple stream with 1-step lookahead. *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | type 'b sstream = { mutable first: 'b option; 24 | next: unit -> 'b option; 25 | } 26 | 27 | let make ?first next = { first = first; 28 | next = next; 29 | } 30 | 31 | let next s = 32 | match s.first with 33 | None -> s.next () 34 | | v -> 35 | s.first <- None; 36 | v 37 | 38 | let peek s = 39 | if s.first = None 40 | then s.first <- s.next (); 41 | s.first 42 | 43 | let junk s = 44 | if s.first = None 45 | then ignore (s.next ()) 46 | else s.first <- None 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /mArray.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* mArray.mli - Various array operations *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | val to_string : f:('a -> string) -> 'a array -> string 24 | val print : f:('a -> 'b) -> 'a array -> unit 25 | 26 | val all_true : bool array -> bool 27 | val for_all : f:('a -> bool) -> 'a array -> bool 28 | val exists : f:('a -> bool) -> 'a array -> bool 29 | val mem : 'a -> 'a array -> bool 30 | val choose_best : ('a -> 'a -> 'a) -> 'a array -> 'a 31 | val max : 'a array -> 'a 32 | val min : 'a array -> 'a 33 | val count : f:('a -> bool) -> 'a array -> int 34 | val count_true : bool array -> int 35 | val average : float array -> float 36 | val iaverage : int array -> float 37 | val median : 'a array -> 'a 38 | val zip : 'a array -> 'b array -> ('a * 'b) array 39 | -------------------------------------------------------------------------------- /linearAlg.mli: -------------------------------------------------------------------------------- 1 | exception Bug of string 2 | exception LayoutMismatch 3 | val riter : f:(int -> 'a) -> int -> int -> unit 4 | val rfind : f:(int -> bool) -> int -> int -> int 5 | module MatrixSlow : 6 | sig 7 | type t = { columns : int; rows : int; array : ZZp.zz array; } 8 | val columns : t -> int 9 | val rows : t -> int 10 | val dims : t -> int * int 11 | val copy : t -> t 12 | val make : columns:int -> rows:int -> ZZp.zz -> t 13 | val init : columns:int -> rows:int -> f:(int -> int -> ZZp.zz) -> t 14 | val get : t -> int -> int -> ZZp.zz 15 | val set : t -> int -> int -> ZZp.zz -> unit 16 | val scmult_ip : t -> ZZp.zz -> unit 17 | val scmult : t -> ZZp.zz -> t 18 | val scmult_row : t -> int -> ZZp.zz -> unit 19 | val swap_rows : t -> int -> int -> unit 20 | val add_ip : t -> t -> unit 21 | val add : t -> t -> t 22 | val idot_rec : 23 | t -> t -> i:int -> pos1:int -> pos2:int -> ZZp.zz -> ZZp.zz 24 | val idot : t -> t -> int -> int -> ZZp.zz 25 | val mult : t -> t -> t 26 | val transpose : t -> t 27 | val rowadd : t -> src:int -> dst:int -> scmult:ZZp.zz -> unit 28 | val rowsub : t -> src:int -> dst:int -> scmult:ZZp.zz -> unit 29 | val print : t -> unit 30 | end 31 | module Matrix : 32 | sig 33 | type t = { columns : int; rows : int; array : ZZp.zzref array; } 34 | val columns : t -> int 35 | val rows : t -> int 36 | val dims : t -> int * int 37 | val copy : t -> t 38 | val init : columns:int -> rows:int -> f:(int -> int -> ZZp.zz) -> t 39 | val make : columns:int -> rows:int -> ZZp.zz -> t 40 | val lget : t -> int -> int -> ZZp.zz 41 | val rget : t -> int -> int -> ZZp.zzref 42 | val get : t -> int -> int -> ZZp.zz 43 | val set : t -> int -> int -> ZZp.zz -> unit 44 | val scmult_row : ?scol:int -> t -> int -> ZZp.zz -> unit 45 | val swap_rows : t -> int -> int -> unit 46 | val transpose : t -> t 47 | val rowsub : 48 | ?scol:int -> t -> src:int -> dst:int -> scmult:ZZp.zz -> unit 49 | val print : t -> unit 50 | end 51 | val process_row : Matrix.t -> int -> unit 52 | val process_row_forward : Matrix.t -> int -> unit 53 | val backsubstitute : Matrix.t -> int -> unit 54 | val greduce : Matrix.t -> unit 55 | val reduce : Matrix.t -> unit 56 | -------------------------------------------------------------------------------- /unit_tests.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* unit_tests.ml - perform simple unit tests *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open Printf 24 | open Common 25 | 26 | let run () = 27 | printf "Running Decode unit tests:%!"; 28 | begin 29 | try Decode_test.run () 30 | with Unit_test_failure s -> 31 | printf "\nUnit test failure: %s\n%!" s 32 | end; 33 | printf "Done\n%!"; 34 | 35 | printf "Running Number unit tests:%!"; 36 | begin 37 | try Number_test.run () 38 | with Unit_test_failure s -> 39 | printf "\nUnit test failure: %s\n%!" s 40 | end; 41 | printf "Done\n%!"; 42 | 43 | printf "Running Poly unit tests:%!"; 44 | begin 45 | try Poly_test.run () 46 | with Unit_test_failure s -> 47 | printf "\nUnit test failure: %s\n%!" s 48 | end; 49 | printf "Done\n%!"; 50 | 51 | -------------------------------------------------------------------------------- /sampleConfig/mailsync: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* mailsync - servers that should receive email updates from SKS *# 3 | #* *# 4 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 5 | #* *# 6 | #* This file is part of SKS. SKS is free software; you can *# 7 | #* redistribute it and/or modify it under the terms of the GNU General *# 8 | #* Public License as published by the Free Software Foundation; either *# 9 | #* version 2 of the License, or (at your option) any later version. *# 10 | #* *# 11 | #* This program is distributed in the hope that it will be useful, but *# 12 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 13 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 14 | #* General Public License for more details. *# 15 | #* *# 16 | #* You should have received a copy of the GNU General Public License *# 17 | #* along with this program; if not, write to the Free Software *# 18 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 19 | #* USA or see . *# 20 | #************************************************************************# 21 | # 22 | # The mailsync should contains a list of email addresses of PKS 23 | # keyservers, one per line. This file is important, because it ensures 24 | # that keys submitted directly to an SKS keyserver are also forwarded 25 | # to PKS keyservers. 26 | # 27 | # Empty lines and whitespace-only lines are ignored, as are lines 28 | # whose first non-whitespace character is a `#'. 29 | # 30 | # IMPORTANT: don't add someone to your mailsync file without getting 31 | # their permission first! 32 | # 33 | # Hironobu Suzuki operates the OpenPKSD server 34 | #pgp-public-keys@pgp.nic.ad.jp 35 | # 36 | # Jonathon McDowell openrates the ONAK server 37 | # http://www.earth.li/projectpurple/progs/onak.html 38 | #pgp-public-keys@the.earth.li 39 | # 40 | # V. Alex Brennen operates the CKS (CrytptNet) servers 41 | -------------------------------------------------------------------------------- /index.mli: -------------------------------------------------------------------------------- 1 | type siginfo 2 | val empty_siginfo : unit -> siginfo 3 | val keyinfo_header : Request.request -> string 4 | val sig_to_siginfo : Packet.packet -> siginfo 5 | val sort_siginfo_list : siginfo list -> siginfo list 6 | val is_selfsig : keyid:string -> siginfo -> bool 7 | val is_primary : keyid:string -> Packet.packet * siginfo list -> bool 8 | val max_selfsig_time : keyid:string -> 'a * siginfo list -> float 9 | val split_list : f:('a -> bool) -> 'a list -> 'a list * 'a list 10 | val move_primary_to_front : 11 | keyid:string -> 12 | (Packet.packet * siginfo list) list -> (Packet.packet * siginfo list) list 13 | val convert_sigpair : 'a * Packet.packet list -> 'a * siginfo list 14 | val blank_datestr : string 15 | val no_datestr : string 16 | val datestr_of_int64 : int64 -> string 17 | val siginfo_to_lines : 18 | get_uid:(string -> string option) -> 19 | ?key_creation_time:int64 -> 20 | Request.request -> string -> float -> siginfo -> string list 21 | val selfsigs_to_lines : 22 | Request.request -> 23 | int64 -> string -> Packet.packet list -> float -> string list 24 | val uid_to_lines : 25 | get_uid:(string -> string option) -> 26 | Request.request -> 27 | int64 -> string -> float -> Packet.packet * siginfo list -> string list 28 | val uids_to_lines : 29 | get_uid:(string -> string option) -> 30 | Request.request -> 31 | int64 -> 32 | string -> (Packet.packet * siginfo list) list -> float -> string list 33 | val key_packet_to_line : 34 | is_subkey:bool -> Packet.pubkeyinfo -> string -> string * string 35 | val subkey_to_lines : 36 | Request.request -> float -> Packet.packet * siginfo list -> string list 37 | val subkeys_to_lines : 38 | Request.request -> 39 | (Packet.packet * siginfo list) list -> float -> string list 40 | val extract : f:('a -> bool) -> 'a list -> 'a option * 'a list 41 | val move_to_front : f:('a -> bool) -> 'a list -> 'a list 42 | val get_uid : 43 | (string -> (Packet.packet * Packet.packet list) list) -> 44 | string -> string option 45 | val get_extra_lines : 46 | Request.request -> 'a -> string -> Fingerprint.result -> string list 47 | val key_to_lines_verbose : 48 | get_uids:(string -> (Packet.packet * Packet.packet list) list) -> 49 | Request.request -> Packet.packet list -> string -> string list 50 | val sig_is_revok : siginfo -> bool 51 | val is_revoked : Packet.packet list -> bool 52 | val key_to_lines_normal : 53 | Request.request -> Packet.packet list -> string -> string list 54 | -------------------------------------------------------------------------------- /dbscript.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* dbscript.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | open Printf 26 | open Common 27 | open Packet 28 | 29 | module Kdb = Keydb.MakeUnrestricted( 30 | struct 31 | let withtxn = !Settings.transactions 32 | and cache_bytes = !Settings.cache_bytes 33 | and pagesize = !Settings.pagesize 34 | and dbdir = "/usr/share/keyfiles/sks_the_2/KDB" 35 | and dumpdir = "/usr/share/keyfiles/sks_the_2/dump" 36 | end 37 | ) 38 | 39 | 40 | 41 | (* 42 | let unwrap x = match x with Some x -> x | None -> failwith "unwrapping None" 43 | let () = Keydb.open_dbs () 44 | let (stream,close) = Keydb.create_hashstream () 45 | 46 | 47 | let weirdhash_str = "C2A6E1C3749690E04AC6AFC2A2679A4E" 48 | let weirdhash = KeyHash.dehexify weirdhash_str 49 | let last = ref "" 50 | let x = 51 | while 52 | last := (unwrap (SStream.next stream)); 53 | !last < weirdhash 54 | do () done 55 | *) 56 | -------------------------------------------------------------------------------- /sampleConfig/rc.sks: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* rc.sks - sample script to start and stop the SKS processes *# 3 | #* *# 4 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 5 | #* *# 6 | #* This file is part of SKS. SKS is free software; you can *# 7 | #* redistribute it and/or modify it under the terms of the GNU General *# 8 | #* Public License as published by the Free Software Foundation; either *# 9 | #* version 2 of the License, or (at your option) any later version. *# 10 | #* *# 11 | #* This program is distributed in the hope that it will be useful, but *# 12 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 13 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 14 | #* General Public License for more details. *# 15 | #* *# 16 | #* You should have received a copy of the GNU General Public License *# 17 | #* along with this program; if not, write to the Free Software *# 18 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 19 | #* USA or see . *# 20 | #************************************************************************# 21 | # 22 | #! /bin/sh 23 | # 24 | CLIENT=/usr/bin/sks 25 | DIR=/var/sks 26 | STARTOPTS= 27 | #STARTOPTS will need to be in quotes if it has white space in it 28 | 29 | test -e $CLIENT || exit 0 30 | 31 | test -d $DIR || exit 0 32 | 33 | case "$1" in 34 | start) 35 | cd $DIR 36 | echo -n "Starting SKS:" 37 | echo -n \ sks_db 38 | $CLIENT db & 39 | echo -n \ sks_recon 40 | $CLIENT recon & 41 | echo "." 42 | ;; 43 | stop) 44 | echo -n "Stopping SKS:" 45 | killall sks 46 | while [ "`pidof sks`" ]; do sleep 1; done # wait until SKS processes have exited 47 | echo "." 48 | ;; 49 | restart|force-reload) 50 | $0 stop 51 | sleep 1 52 | $0 start 53 | ;; 54 | *) 55 | echo "Usage: $0 {start|stop|reload|restart|force-reload}" 56 | exit 1 57 | ;; 58 | esac 59 | 60 | exit 0 61 | -------------------------------------------------------------------------------- /bdb/bdb_stubs.h: -------------------------------------------------------------------------------- 1 | /*****************************************************************/ 2 | /** DBENV *******************************************************/ 3 | /*****************************************************************/ 4 | 5 | struct camldbenv { 6 | DB_ENV *dbenv; 7 | int closed; 8 | }; 9 | 10 | /*****************************************************************/ 11 | /*** DB ********************************************************/ 12 | /*****************************************************************/ 13 | 14 | struct camldb { 15 | DB *db; 16 | int closed; 17 | }; 18 | 19 | /*****************************************************************/ 20 | /*** DB_CURSOR *************************************************/ 21 | /*****************************************************************/ 22 | 23 | struct camlcursor { 24 | DBC *cursor; 25 | int closed; 26 | }; 27 | 28 | /*****************************************************************/ 29 | /*** DB_TXN ****************************************************/ 30 | /*****************************************************************/ 31 | 32 | struct camltxn { 33 | DB_TXN *txn; 34 | int closed; 35 | }; 36 | 37 | /*****************************************************************/ 38 | /** DB and DBENV macros ****************************************/ 39 | /*****************************************************************/ 40 | 41 | // datatype syzes 42 | #define Camldbenv_wosize (sizeof(struct camldbenv)) 43 | #define Camldb_wosize (sizeof(struct camldb)) 44 | #define Camlcursor_wosize (sizeof(struct camlcursor)) 45 | #define Camltxn_wosize (sizeof(struct camltxn)) 46 | 47 | // Unwrapping functions 48 | #define UW_dbenv(v) (((struct camldbenv *)Data_custom_val(v))->dbenv) 49 | #define UW_dbenv_closed(v) (((struct camldbenv *)Data_custom_val(v))->closed) 50 | 51 | #define UW_db(v) (((struct camldb *)Data_custom_val(v))->db) 52 | #define UW_db_closed(v) (((struct camldb *)Data_custom_val(v))->closed) 53 | 54 | #define UW_cursor(v) (((struct camlcursor *)Data_custom_val(v))->cursor) 55 | #define UW_cursor_closed(v) (((struct camlcursor *)Data_custom_val(v))->closed) 56 | 57 | #define UW_txn(v) (((struct camltxn *)Data_custom_val(v))->txn) 58 | #define UW_txn_closed(v) (((struct camltxn *)Data_custom_val(v))->closed) 59 | 60 | #define Is_string(v) (Is_block(v) && (Tag_val(v) == String_tag)) 61 | #define Is_None(v) (!Is_block(v)) 62 | #define Is_Some(v) (Is_block(v)) 63 | #define Some_val(v) (Field(v,0)) 64 | #define Flag_val(vflag,flags) (flags[Long_val(vflag)]) 65 | -------------------------------------------------------------------------------- /version.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* version.ml - Executable: Show version information *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open Printf 24 | 25 | let run () = 26 | let bdb_version = Bdb.version () in 27 | let dbstats_dir = 28 | let split = Str.regexp_string "." in 29 | let major_minor_string major minor = 30 | sprintf "Further details about the BDB environment can be seen by \ 31 | executing\ndb%s.%s_stat -x in the KDB and Ptree directories\n" major minor 32 | in 33 | match Str.split split bdb_version with 34 | | major :: minor :: _ -> major_minor_string major minor 35 | | [] | _ :: [] -> major_minor_string "X" "Y" 36 | in 37 | printf "SKS version %s%s\n" 38 | Common.version Common.version_suffix; 39 | 40 | printf "Compiled with Ocaml version %s and BDB version %s\n" 41 | Sys.ocaml_version bdb_version; 42 | 43 | printf "This SKS version has a minimum compatibility \ 44 | requirement for recon of SKS %s\n" 45 | Common.compatible_version_string; 46 | 47 | printf "%s" dbstats_dir 48 | 49 | -------------------------------------------------------------------------------- /ptree_db_test.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* ptree_db_test.ml - Checks whether the memory-bounds on a ptree are *) 3 | (* in force. Test for verifying consistency of *) 4 | (* prefix tree data structure. *) 5 | (* *) 6 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 7 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 8 | (* *) 9 | (* This file is part of SKS. SKS is free software; you can *) 10 | (* redistribute it and/or modify it under the terms of the GNU General *) 11 | (* Public License as published by the Free Software Foundation; either *) 12 | (* version 2 of the License, or (at your option) any later version. *) 13 | (* *) 14 | (* This program is distributed in the hope that it will be useful, but *) 15 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 16 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 17 | (* General Public License for more details. *) 18 | (* *) 19 | (* You should have received a copy of the GNU General Public License *) 20 | (* along with this program; if not, write to the Free Software *) 21 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 22 | (* USA or see . *) 23 | (***********************************************************************) 24 | 25 | (* #directory "/home/yminsky/Work/projects/keyserver/sks";; 26 | let () = Sys.chdir "/usr/share/keyfiles/sks_the";; 27 | #load "reconPTreeDb.cmo";; 28 | *) 29 | 30 | open Printf 31 | open StdLabels 32 | open MoreLabels 33 | module Set = PSet.Set 34 | 35 | open Common 36 | 37 | open ReconPTreeDb 38 | open ReconPTreeDb.PDb 39 | 40 | let root = (!ptree).PTree.root 41 | 42 | let random_probe () = 43 | let zzs = PTree.get_random !ptree root in 44 | let depth = ref 0 in 45 | while 46 | let node = PTree.get_node_str !ptree zzs !depth in 47 | if PTree.is_leaf node then false 48 | else true 49 | do incr depth done 50 | 51 | 52 | 53 | let inmem_count () = 54 | match !ptree.PTree.db with 55 | None -> failwith "DB expected" 56 | | Some db -> db.PTree.inmem_count 57 | -------------------------------------------------------------------------------- /msgContainer.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* msgContainer.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | module Unix=UnixLabels 26 | 27 | open Printf 28 | 29 | module type MsgMarshal = 30 | sig 31 | type msg_t 32 | val marshal: Channel.out_channel_obj -> msg_t -> unit 33 | val unmarshal: Channel.in_channel_obj -> msg_t 34 | val to_string: msg_t -> string 35 | val print: string -> unit 36 | end 37 | 38 | module Container = 39 | functor (Msg:MsgMarshal) -> 40 | struct 41 | 42 | type msg_container = 43 | { msg: Msg.msg_t; 44 | (* nonce: int; *) 45 | } 46 | 47 | let marshal_noflush cout msg = 48 | Msg.print (sprintf "Marshalling: %s" (Msg.to_string msg)); 49 | Msg.marshal cout#upcast msg 50 | 51 | let marshal cout msg = 52 | marshal_noflush cout msg; 53 | cout#flush 54 | 55 | let unmarshal cin = 56 | let msg = Msg.unmarshal cin#upcast in 57 | Msg.print (sprintf "Unmarshalling: %s" (Msg.to_string msg)); 58 | { msg = msg; } 59 | 60 | end 61 | 62 | 63 | -------------------------------------------------------------------------------- /foo.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* foo.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open Printf 25 | open ZZp 26 | open Number.Infix 27 | 28 | 29 | let rec gcd_ex' a b = 30 | if b =! zero then (one,zero,a) 31 | else 32 | let (q,r) = quomod_big_int a b in 33 | let (u',v',gcd) = gcd_ex' b r in 34 | (v',u' -! v' *! q, gcd) 35 | 36 | let gcd_ex a b = 37 | if b <=! a then gcd_ex' a b 38 | else 39 | let (u,v,gcd) = gcd_ex' b a in 40 | (v,u,gcd) 41 | 42 | let gcd_ex_test a b = 43 | let (a,b) = (big_int_of_int a,big_int_of_int b) in 44 | let (u,v,gcd) = gcd_ex a b in 45 | if (u *! a +! v *! b <>! gcd) 46 | then failwith (sprintf "gcd_ex failed on %s and %s" 47 | (string_of_big_int a) (string_of_big_int b)) 48 | 49 | 50 | let run_test () = 51 | begin 52 | gcd_ex_test 95 25; 53 | gcd_ex_test 25 95; 54 | gcd_ex_test 1 95; 55 | gcd_ex_test 95 1; 56 | gcd_ex_test 22 21; 57 | gcd_ex_test 21 22; 58 | gcd_ex_test 12 6; 59 | gcd_ex_test 6 12; 60 | gcd_ex_test 6 12; 61 | end 62 | -------------------------------------------------------------------------------- /membership.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* membership.mli - Module for tracking gossip membership and mailsync *) 3 | (* peers *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | (** Reset the last time the mtime was read to zero, to force the *) 25 | (** membership file to be reloaded from disk *) 26 | val reset_membership_time : unit -> unit 27 | 28 | (** Get human-readable names of gossip peers. *) 29 | val get_names : unit -> string array 30 | 31 | (** Picks single gossip partner from list of possible partners, and *) 32 | (** returns list of all known addresses for that host *) 33 | val choose : unit -> UnixLabels.addr_info list 34 | 35 | (** Returns true iff the address in question belongs to one of the *) 36 | (** hosts on the gossip membership list. *) 37 | val test : UnixLabels.sockaddr -> bool 38 | 39 | (** Returns the list of email addresses for use in PKS-style key *) 40 | (** distribution *) 41 | val get_mailsync_partners : unit -> string list 42 | -------------------------------------------------------------------------------- /mTimer.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* mTimer.ml - Simple timer module *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | 26 | type t = { mutable start_time : float; 27 | mutable stop_time : float; 28 | mutable running : bool; 29 | } 30 | 31 | let create () = { start_time = 0.0; 32 | stop_time = 0.0; 33 | running = false; 34 | } 35 | 36 | let reset timer = 37 | timer.start_time <- 0.0; 38 | timer.stop_time <- 0.0; 39 | timer.running <- false 40 | 41 | let start timer = 42 | ( timer.start_time <- Unix.gettimeofday (); 43 | timer.running <- true ) 44 | 45 | let stop timer = 46 | if not timer.running then failwith "Timer stopped when not running." 47 | else ( timer.stop_time <- Unix.gettimeofday (); 48 | timer.running <- false ) 49 | 50 | let read timer = 51 | if timer.running 52 | then failwith "Timer read at wrong time" 53 | else timer.stop_time -. timer.start_time 54 | 55 | let read_ms timer = 1000.0 *. (read timer) 56 | let read_us timer = (1000.0 *. 1000.0) *. (read timer) 57 | 58 | -------------------------------------------------------------------------------- /Unique_time.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* Unique_time.mli - Module to return unique time *) 3 | (* @author Yaron M. Minsky *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | (* An interface to Unix.gettimeofday() which enforces that time always goes 25 | * up and never repeats. 26 | * get() returns seconds & microseconds, so minimum meaningful 27 | * increment is 1 microsecond; OCaml uses IEEE 754 double-precision floats, 28 | * which gives 53 bits of mantissa. Assuming 32 bits for time until 32-bit 29 | * time_t overflows, we can knock bits off 21 bits depending upon when we want 30 | * the overflow/rollover to occur, and whatever's left is available for delta 31 | * even at the end of the lifetime of the code; as that fateful day approaches, 32 | * lower the granularity of this delay accordly 33 | * we don't use epsilon_float, as that's only guaranteed to give a different 34 | * result when added to 1.0, not for other numbers. 35 | * If wallclock time goes backwards, we won't, but time will appear to go 36 | * forward very very slowly until wallclock catches back up 37 | *) 38 | 39 | val get : 'a -> float 40 | -------------------------------------------------------------------------------- /number_test.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* number_test.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open Big_int 24 | open StdLabels 25 | open MoreLabels 26 | open Printf 27 | open Number 28 | open Number.Infix 29 | open Common 30 | 31 | (** Unit tests for number.ml *) 32 | 33 | let rand_int = Random.State.int RMisc.det_rng 34 | let rand_bits () = Random.State.bits RMisc.det_rng 35 | 36 | let ctr = ref 0 37 | let test cond = 38 | printf ".%!"; 39 | incr ctr; 40 | if not cond then raise (Unit_test_failure (sprintf "Number test %d failed" !ctr)) 41 | 42 | 43 | let conversion_test () = 44 | let nbits = rand_int 400 + 1 in 45 | let nbytes = nbits / 8 + (if nbits mod 8 = 0 then 0 else 1) in 46 | let x = Prime.randbits rand_bits nbits in 47 | let xstr = to_bytes ~nbytes x in 48 | test (of_bytes xstr =! x) 49 | 50 | let powmod_test () = 51 | let x = Prime.randbits rand_bits (rand_int 12 + 1) in 52 | let y = Prime.randbits rand_bits (rand_int 12 + 1) in 53 | let m = Prime.randbits rand_bits (rand_int 12 + 1) in 54 | test (powmod x y m =! dumb_powmod x y m) 55 | 56 | 57 | let run () = 58 | for i = 1 to 100 do conversion_test () done; 59 | for i = 1 to 100 do powmod_test () done; 60 | -------------------------------------------------------------------------------- /cMarshal.mli: -------------------------------------------------------------------------------- 1 | val marshal_string : 2 | < upcast : #Channel.out_channel_obj; write_byte : int -> unit; 3 | write_char : char -> unit; write_float : float -> unit; 4 | write_int : int -> unit; write_int32 : int32 -> unit; 5 | write_int64 : int64 -> unit; write_string : string -> unit; 6 | write_string_pos : buf:string -> pos:int -> len:int -> unit; .. > -> 7 | string -> unit 8 | val unmarshal_string : < read_int : 'a; read_string : 'a -> 'b; .. > -> 'b 9 | val marshal_list : 10 | f:((< write_int : int -> 'b; .. > as 'a) -> 'c -> unit) -> 11 | 'a -> 'c list -> unit 12 | val unmarshal_list : 13 | f:((< read_int : int; .. > as 'a) -> 'b) -> 'a -> 'b list 14 | val marshal_lstring : < write_string : 'a -> 'b; .. > -> 'a -> 'b 15 | val unmarshal_lstring : 'a -> < read_string : 'a -> 'b; .. > -> 'b 16 | val marshal_array : 17 | f:((< write_int : int -> 'b; .. > as 'a) -> 'c -> unit) -> 18 | 'a -> 'c array -> unit 19 | val unmarshal_array : 20 | f:((< read_int : int; .. > as 'a) -> 'b) -> 'a -> 'b array 21 | val marshal_bitstring : 22 | < upcast : #Channel.out_channel_obj; write_byte : int -> unit; 23 | write_char : char -> unit; write_float : float -> unit; 24 | write_int : int -> unit; write_int32 : int32 -> unit; 25 | write_int64 : int64 -> unit; write_string : string -> unit; 26 | write_string_pos : buf:string -> pos:int -> len:int -> unit; .. > -> 27 | Bitstring.t -> unit 28 | val unmarshal_bitstring : 29 | < read_int : int; read_string : int -> string; .. > -> Bitstring.t 30 | val marshal_fixed_sarray : 31 | < write_int : int -> 'a; write_string : string -> unit; .. > -> 32 | string array -> unit 33 | val unmarshal_fixed_sarray : 34 | < read_int : int; read_string : int -> 'a; .. > -> 'b -> 'a array 35 | val marshal_set : 36 | f:((< write_int : int -> 'b; .. > as 'a) -> ZZp.zz -> unit) -> 37 | 'a -> ZZp.Set.t -> unit 38 | val unmarshal_set : 39 | f:((< read_int : int; .. > as 'a) -> ZZp.zz) -> 'a -> ZZp.Set.t 40 | val marshal_sockaddr : 41 | < upcast : #Channel.out_channel_obj; write_byte : int -> unit; 42 | write_char : char -> unit; write_float : float -> unit; 43 | write_int : int -> unit; write_int32 : int32 -> unit; 44 | write_int64 : int64 -> unit; write_string : string -> unit; 45 | write_string_pos : buf:string -> pos:int -> len:int -> unit; .. > -> 46 | Unix.sockaddr -> unit 47 | val unmarshal_sockaddr : 48 | < read_byte : int; read_int : int; read_string : int -> string; .. > -> 49 | Unix.sockaddr 50 | val marshal_to_string : 51 | f:(Channel.buffer_out_channel -> 'a -> 'b) -> 'a -> string 52 | val unmarshal_from_string : 53 | f:(Channel.string_in_channel -> 'a) -> string -> 'a 54 | val int_to_string : int -> string 55 | val int_of_string : string -> int 56 | -------------------------------------------------------------------------------- /pstyle.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* pstyle.ml - Allows for some python-like tricks, at the expense of *) 3 | (* some performance and indirection *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | 27 | module Array = 28 | struct 29 | include Array 30 | let normalize ar i = if i < 0 then length ar + i else i 31 | let get ar i = get ar (normalize ar i) 32 | let slice start stop ar = 33 | let stop = if stop = 0 then length ar else stop in 34 | let pos = normalize ar start in 35 | let len = (normalize ar stop) - pos in 36 | sub ar ~pos ~len 37 | end 38 | 39 | module String = 40 | struct 41 | include String 42 | let normalize str i = if i < 0 then length str + i else i 43 | let get str i = get str (normalize str i) 44 | let slice start stop str = 45 | let stop = if stop = 0 then length str else stop in 46 | let pos = normalize str start in 47 | let len = (normalize str stop) - pos in 48 | sub str ~pos ~len 49 | end 50 | 51 | let rec range ?(stride=1) ?(start=0) stop = 52 | if start >= stop then [] 53 | else start::(range ~stride ~start:(start+stride) stop) 54 | 55 | 56 | let ( ) string (start,stop) = String.slice start stop string 57 | let ( <|> ) ar (start,stop) = Array.slice start stop ar 58 | -------------------------------------------------------------------------------- /bdb/db.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Objective Caml *) 4 | (* *) 5 | (* Francois Rouaix, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file ../../LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: db.mli,v 1.1.1.1 2002/10/01 00:10:14 yminsky Exp $ *) 15 | 16 | (* Module [Db]: interface to the DB databases of type btree. Cf dbopen(3) *) 17 | 18 | (* this collides with Unix *) 19 | type open_flag = 20 | O_CREAT 21 | | O_EXCL 22 | | O_RDONLY 23 | | O_RDWR 24 | | O_TRUNC 25 | 26 | type routine_flag = 27 | R_CURSOR 28 | | R_FIRST 29 | | R_LAST 30 | | R_NEXT 31 | | R_NOOVERWRITE 32 | | R_PREV 33 | | R_SETCURSOR 34 | 35 | (* All other fields have default values *) 36 | type btree_flag = 37 | Duplicates (* means R_DUP *) 38 | | Cachesize of int 39 | 40 | type file_perm = int 41 | 42 | exception DB_error of string 43 | (* Raised by the following functions when an error is encountered. *) 44 | 45 | type key = string 46 | type data = string 47 | 48 | type t 49 | 50 | (* Raw access *) 51 | external dbopen : 52 | string -> open_flag list -> file_perm -> btree_flag list -> t 53 | = "caml_db_open" 54 | (* [dbopen file flags mode] *) 55 | 56 | (* The common subset of available primitives *) 57 | external close : t -> unit 58 | = "caml_db_close" 59 | 60 | external del : t -> key -> routine_flag list -> unit 61 | = "caml_db_del" 62 | (* raise Not_found if the key was not in the file *) 63 | 64 | external get : t -> key -> routine_flag list -> data 65 | = "caml_db_get" 66 | (* raise Not_found if the key was not in the file *) 67 | 68 | external put : t -> key:key -> data:data -> routine_flag list -> unit 69 | = "caml_db_put" 70 | 71 | external seq : t -> key -> routine_flag list -> (key * data) 72 | = "caml_db_seq" 73 | 74 | external sync : t -> unit 75 | = "caml_db_sync" 76 | 77 | 78 | val add : t -> key:key -> data:data -> unit 79 | val find : t -> key -> data 80 | val find_all : t -> key -> data list 81 | val remove : t -> key -> unit 82 | val iter : f:(key:string -> data:string -> unit) -> t -> unit 83 | -------------------------------------------------------------------------------- /crc.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************) 2 | (* crc.c *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************/ 22 | 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #include 29 | #include 30 | #include 31 | #define CRC24_INIT 0xb704ceL 32 | #define CRC24_POLY 0x1864cfbL 33 | 34 | typedef long crc24; 35 | crc24 crc_octets(unsigned const char *octets, size_t len) { 36 | crc24 crc = CRC24_INIT; 37 | int i; 38 | 39 | while (len--) { 40 | crc ^= (*octets++) << 16; 41 | for (i = 0; i < 8; i++) { 42 | crc <<= 1; 43 | if (crc & 0x1000000) 44 | crc ^= CRC24_POLY; 45 | } 46 | } 47 | return crc & 0xffffffL; 48 | } 49 | 50 | value caml_crc_octets(value data) { 51 | CAMLparam1(data); 52 | CAMLlocal1(rval); 53 | unsigned const char *octets = String_val(data); 54 | size_t len = string_length(data); 55 | long crc = crc_octets(octets,len); 56 | 57 | rval = Val_int(crc); 58 | CAMLreturn(rval); 59 | } 60 | 61 | 62 | value caml_get_tzname(value none) { 63 | CAMLparam1(none); 64 | CAMLlocal1(rval); 65 | tzset(); 66 | rval = alloc_tuple(2); 67 | Store_field(rval,0,copy_string(tzname[0])); 68 | Store_field(rval,1,copy_string(tzname[1])); 69 | CAMLreturn(rval); 70 | } 71 | -------------------------------------------------------------------------------- /number.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* number.mli - Basic operations and definitions for multi-precision *) 3 | (* integers *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | type z 25 | module Infix : 26 | sig 27 | val two : z 28 | val one : z 29 | val zero : z 30 | val neg_one : z 31 | val ( *! ) : z -> z -> z 32 | val ( +! ) : z -> z -> z 33 | val ( -! ) : z -> z -> z 34 | val ( %! ) : z -> z -> z 35 | val ( /! ) : z -> z -> z 36 | val ( **! ) : z -> int -> z 37 | val ( <>! ) : z -> z -> bool 38 | val ( =! ) : z -> z -> bool 39 | val ( z -> bool 40 | val ( >! ) : z -> z -> bool 41 | val ( <=! ) : z -> z -> bool 42 | val ( >=! ) : z -> z -> bool 43 | end 44 | val width : int 45 | val width_pow : z 46 | val nbits : z -> int 47 | val nth_bit : z -> int -> bool 48 | val print_bits : z -> unit 49 | val squaremod : z -> z -> z 50 | val powmod : z -> z -> z -> z 51 | val dumb_powmod : z -> z -> z -> z 52 | val gcd_ex : z -> z -> z * z * z 53 | 54 | val int_mult : int -> z -> z 55 | val int_posint_power : int -> int -> z 56 | 57 | (** conversion functions *) 58 | 59 | val to_bytes : nbytes:int -> z -> string 60 | val of_bytes : string -> z 61 | val of_int : int -> z 62 | val to_int : z -> int 63 | val to_string : z -> string 64 | val of_string : string -> z 65 | val compare : z -> z -> int 66 | -------------------------------------------------------------------------------- /sampleConfig/sksconf.typical: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* sksconf.typical - Typical configuration settings for a SKS server *# 3 | #* *# 4 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 5 | #* *# 6 | #* This file is part of SKS. SKS is free software; you can *# 7 | #* redistribute it and/or modify it under the terms of the GNU General *# 8 | #* Public License as published by the Free Software Foundation; either *# 9 | #* version 2 of the License, or (at your option) any later version. *# 10 | #* *# 11 | #* This program is distributed in the hope that it will be useful, but *# 12 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 13 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 14 | #* General Public License for more details. *# 15 | #* *# 16 | #* You should have received a copy of the GNU General Public License *# 17 | #* along with this program; if not, write to the Free Software *# 18 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 19 | #* USA or see . *# 20 | #************************************************************************# 21 | 22 | # sksconf -- SKS main configuration 23 | # 24 | basedir: /var/sks 25 | 26 | # debuglevel 3 is default (max. debuglevel is 10) 27 | debuglevel: 3 28 | 29 | hostname: keyserver.example.tld 30 | hkp_port: 11371 31 | recon_port: 11370 32 | # 33 | server_contact: 0xDECAFBADDEADBEEF 34 | from_addr: pgp-public-keys@example.tld 35 | sendmail_cmd: /usr/sbin/sendmail -t -oi 36 | # 37 | initial_stat: 38 | membership_reload_interval: 1 39 | stat_hour: 17 40 | # 41 | # set DB file pagesize as recommended by db_tuner 42 | # pagesize is (n * 512) bytes 43 | # NOTE: These must be set _BEFORE_ [fast]build & pbuild and remain set 44 | # for the life of the database files. To change a value requires recreating 45 | # the database from a dump 46 | # 47 | # KDB/key 65536 48 | pagesize: 128 49 | # 50 | # KDB/keyid 32768 51 | keyid_pagesize: 64 52 | # 53 | # KDB/meta 512 54 | meta_pagesize: 1 55 | # KDB/subkeyid 65536 56 | subkeyid_pagesize: 128 57 | # 58 | # KDB/time 65536 59 | time_pagesize: 128 60 | # 61 | # KDB/tqueue 512 62 | tqueue_pagesize: 1 63 | # 64 | # KDB/word - db_tuner suggests 512 bytes. This locked the build process 65 | # Better to use a default of 8 (4096 bytes) for now 66 | #word_pagesize: 8 67 | # 68 | # PTree/ptree 4096 69 | ptree_pagesize: 8 70 | -------------------------------------------------------------------------------- /sks_do.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* sks_do.ml - simple command-line tool for sending actions directly *) 3 | (* to sks_db and sks_recon processes *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | open Printf 27 | open Common 28 | open Packet 29 | open DbMessages 30 | module Unix = UnixLabels 31 | module PTree = PrefixTree 32 | module Map = PMap.Map 33 | 34 | let fail reason = 35 | printf "%s\n" reason; 36 | flush stdout; 37 | exit (-1) 38 | 39 | let send_dbmsg msg = 40 | let s = Unix.socket (Unix.domain_of_sockaddr db_command_addr) Unix.SOCK_STREAM 0 in 41 | protect ~f:(fun () -> 42 | Unix.connect s db_command_addr; 43 | let cin = Channel.sys_in_from_fd s in 44 | let cout = Channel.sys_out_from_fd s in 45 | marshal cout msg; 46 | let reply = (unmarshal cin).msg in 47 | reply 48 | ) 49 | ~finally:(fun () -> Unix.close s) 50 | 51 | 52 | let drop () = 53 | match !Settings.anonlist with 54 | | [hash_string] -> 55 | if String.length hash_string <> 32 then 56 | fail "hash should be exactly 32 characters long"; 57 | let hash = KeyHash.dehexify hash_string in 58 | ignore (send_dbmsg (DeleteKey hash)) 59 | | _ -> fail "Wrong number of arguments: must specify exactly 1 hash" 60 | 61 | -------------------------------------------------------------------------------- /logdump.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* logdump.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | open Printf 26 | open Common 27 | open Packet 28 | module Unix = UnixLabels 29 | open Unix 30 | open DbMessages 31 | 32 | module Keydb = Keydb.Make(struct 33 | let withtxn = !Settings.transactions 34 | and cache_bytes = !Settings.cache_bytes 35 | and pagesize = !Settings.pagesize 36 | and dbdir = !Settings.dbdir 37 | and dumpdir = !Settings.dumpdir 38 | end) 39 | 40 | let print_entry (time,event) = 41 | let tm = Unix.localtime time in 42 | printf "%04d-%02d-%02d %02d:%02d:%02d " 43 | (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) 44 | tm.Unix.tm_mday (* date *) 45 | tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec; 46 | (match event with 47 | | Add hash -> printf "Add %s" (KeyHash.hexify hash) 48 | | Delete hash -> printf "Del %s" (KeyHash.hexify hash) 49 | ); 50 | printf "\n" 51 | 52 | let rec last list = match list with 53 | [] -> raise Not_found 54 | | [x] -> x 55 | | hd::tl -> last tl 56 | 57 | let rec printlog ts = 58 | let entries = Keydb.logquery ts in 59 | if entries = [] then () 60 | else 61 | let (new_ts,_) = last entries in 62 | List.iter entries ~f:print_entry; 63 | printlog new_ts 64 | 65 | 66 | let () = 67 | Keydb.open_dbs (); 68 | printlog 0. 69 | -------------------------------------------------------------------------------- /dbtest.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* dbtest.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | open Printf 26 | open Common 27 | open Packet 28 | 29 | module Kdb = Keydb.Unsafe 30 | 31 | let settings = { 32 | Keydb.withtxn = !Settings.transactions; 33 | Keydb.cache_bytes = !Settings.cache_bytes; 34 | Keydb.pagesize = !Settings.pagesize; 35 | Keydb.dbdir = "/usr/share/keyfiles/sks_blackhole/KDB"; 36 | Keydb.dumpdir = "/usr/share/keyfiles/sks_blackhole/dump"; 37 | } 38 | let () = Kdb.open_dbs settings 39 | 40 | let rec strip_opt list = match list with 41 | [] -> [] 42 | | None::tl -> strip_opt tl 43 | | (Some hd)::tl -> hd::(strip_opt tl) 44 | 45 | 46 | let rec beginning n list = 47 | if n = 0 then [] 48 | else match list with 49 | [] -> [] 50 | | hd::tl -> hd::(beginning (n-1) tl) 51 | 52 | let merge_all keys = 53 | let keys = Array.to_list keys in 54 | match keys with 55 | hd::tl -> 56 | List.fold_left ~init:hd tl 57 | ~f:(fun key1 key2 -> match KeyMerge.merge key1 key2 with 58 | None -> failwith "hit unparseable key" 59 | | Some key -> key) 60 | | [] -> failwith "List too short" 61 | 62 | let mergeable key1 key2 = 63 | match KeyMerge.merge key1 key2 with 64 | None -> false 65 | | Some key -> true 66 | 67 | exception KeyFail of string 68 | 69 | let ctr = ref 0 70 | let click () = 71 | incr ctr; 72 | if !ctr mod 100 = 0 73 | then ( 74 | printf "%d\n" !ctr; 75 | flush stdout; 76 | ) 77 | 78 | -------------------------------------------------------------------------------- /packet.mli: -------------------------------------------------------------------------------- 1 | type ptype = 2 | Reserved 3 | | Public_Key_Encrypted_Session_Key_Packet 4 | | Signature_Packet 5 | | Symmetric_Key_Encrypted_Session_Key_Packet 6 | | One_Pass_Signature_Packet 7 | | Secret_Key_Packet 8 | | Public_Key_Packet 9 | | Secret_Subkey_Packet 10 | | Compressed_Data_Packet 11 | | Symmetrically_Encrypted_Data_Packet 12 | | Marker_Packet 13 | | Literal_Data_Packet 14 | | Trust_Packet 15 | | User_ID_Packet 16 | | User_Attribute_Packet 17 | | Sym_Encrypted_and_Integrity_Protected_Data_Packet 18 | | Modification_Detection_Code_Packet 19 | | Public_Subkey_Packet 20 | | Private_or_Experimental_ptype 21 | | Unexpected_ptype 22 | type packet = { 23 | content_tag : int; 24 | packet_type : ptype; 25 | packet_length : int; 26 | packet_body : string; 27 | } 28 | type sigsubpacket = { ssp_length : int; ssp_type : int; ssp_body : string; } 29 | val ssp_type_to_string : int -> string 30 | type key = packet list 31 | val sigtype_to_string : int -> string 32 | val content_tag_to_ptype : int -> ptype 33 | val ptype_to_string : ptype -> string 34 | type mpi = { mpi_bits : int; mpi_data : string; } 35 | val pubkey_algorithm_string : int -> string 36 | type pubkeyinfo = { 37 | pk_version : int; 38 | pk_ctime : int64; 39 | pk_expiration : int option; 40 | pk_alg : int; 41 | pk_keylen : int; 42 | } 43 | type sigtype = 44 | Signature_of_a_binary_document 45 | | Signature_of_a_canonical_text_document 46 | | Standalone_signature 47 | | Generic_certification_of_a_User_ID_and_Public_Key_packet 48 | | Persona_certification_of_a_User_ID_and_Public_Key_packet 49 | | Casual_certification_of_a_User_ID_and_Public_Key_packet 50 | | Positive_certification_of_a_User_ID_and_Public_Key_packet 51 | | Subkey_Binding_Signature 52 | | Signature_directly_on_a_key 53 | | Key_revocation_signature 54 | | Subkey_revocation_signature 55 | | Certification_revocation_signature 56 | | Timestamp_signature 57 | | Unexpected_sigtype 58 | type v3sig = { 59 | v3s_sigtype : int; 60 | v3s_ctime : int64; 61 | v3s_keyid : string; 62 | v3s_pk_alg : int; 63 | v3s_hash_alg : int; 64 | v3s_hash_value : string; 65 | v3s_mpis : mpi list; 66 | } 67 | type v4sig = { 68 | v4s_sigtype : int; 69 | v4s_pk_alg : int; 70 | v4s_hashed_subpackets : sigsubpacket list; 71 | v4s_unhashed_subpackets : sigsubpacket list; 72 | v4s_hash_value : string; 73 | v4s_mpis : mpi list; 74 | } 75 | type signature = V3sig of v3sig | V4sig of v4sig 76 | val int_to_sigtype : int -> sigtype 77 | val content_tag_to_string : int -> string 78 | val print_packet : packet -> unit 79 | val write_packet_new : 80 | packet -> 81 | < write_byte : int -> 'a; write_int : int -> 'b; 82 | write_string : string -> 'c; .. > -> 83 | 'c 84 | val pk_alg_to_ident : int -> string 85 | val write_packet_old : 86 | packet -> 87 | < write_byte : int -> 'a; write_int : int -> 'b; 88 | write_string : string -> 'c; .. > -> 89 | 'c 90 | val write_packet : 91 | packet -> 92 | < write_byte : int -> 'a; write_int : int -> 'b; 93 | write_string : string -> 'c; .. > -> 94 | 'c 95 | -------------------------------------------------------------------------------- /sampleConfig/membership: -------------------------------------------------------------------------------- 1 | #************************************************************************# 2 | #* membership - list of servers to peer with along with optional *# 3 | #* administrative contact information *# 4 | #* *# 5 | #* Copyright (C) 2011, 2012, 2013 John Clizbe *# 6 | #* *# 7 | #* This file is part of SKS. SKS is free software; you can *# 8 | #* redistribute it and/or modify it under the terms of the GNU General *# 9 | #* Public License as published by the Free Software Foundation; either *# 10 | #* version 2 of the License, or (at your option) any later version. *# 11 | #* *# 12 | #* This program is distributed in the hope that it will be useful, but *# 13 | #* WITHOUT ANY WARRANTY; without even the implied warranty of *# 14 | #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *# 15 | #* General Public License for more details. *# 16 | #* *# 17 | #* You should have received a copy of the GNU General Public License *# 18 | #* along with this program; if not, write to the Free Software *# 19 | #* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *# 20 | #* USA or see . *# 21 | #************************************************************************# 22 | 23 | # 24 | # With SKS, two hosts can efficiently compare their databases then 25 | # repair whatever differences are found. In order to set up 26 | # reconciliation, you first need to find other SKS servers that will 27 | # agree to gossip with you. The hostname and port of the server that 28 | # has agreed to do so should be added to this file. 29 | # 30 | # Empty lines and whitespace-only lines are ignored, as are lines 31 | # whose first non-whitespace character is a `#'. Comments preceded by '#' 32 | # are allowed at the ends of lines 33 | # 34 | # Example: 35 | # keyserver.linux.it 11370 36 | # 37 | # The following operators have agreed to have their peering info included in this sample file. 38 | # NOTE: This does NOT mean you may uncomment the lines and have peers. First you must contact the 39 | # server owner and ask permission. You should include a line styled like these for your own server. 40 | # Until two SKS membership files contain eact others peering info, they will not gossip. 41 | # 42 | #yourserver.example.net 11370 # Your full name 0xPreferrefPGPkey 43 | #keyserver.gingerbear.net 11370 # John P. Clizbe 0xD6569825 44 | #sks.keyservers.net 11370 # John P. Clizbe 0xD6569825 45 | #keyserver.rainydayz.org 11370 # Andy Ruddock 0xEEC3AFB3 46 | #keyserver.computer42.org 11370 # H.-Dirk Schmitt 0x6A017B17 47 | -------------------------------------------------------------------------------- /bdb/Makefile: -------------------------------------------------------------------------------- 1 | ######################################################################### 2 | # # 3 | # Objective Caml # 4 | # # 5 | # Xavier Leroy, projet Cristal, INRIA Rocquencourt # 6 | # # 7 | # Copyright 1999 Institut National de Recherche en Informatique et # 8 | # en Automatique. All rights reserved. This file is distributed # 9 | # under the terms of the GNU Library General Public License, with # 10 | # the special exception on linking described in file ../../LICENSE. # 11 | # # 12 | ######################################################################### 13 | 14 | # $Id: Makefile,v 1.6 2003/07/05 15:16:29 yminsky Exp $ 15 | -include ../Makefile.local 16 | 17 | CINCLUDES=-I`ocamlc -where` $(BDBINCLUDE) 18 | CFLAGS+=-O3 -Werror-implicit-function-declaration $(CINCLUDES) $(BDBLIB) -I . 19 | CXXFLAGS+=-O3 $(CINCLUDES) $(BDBLIB) -I . 20 | 21 | MKLIB=ocamlmklib 22 | RANLIB=ranlib 23 | OCAMLDEP=ocamldep $(PP) 24 | CAMLINCLUDE= 25 | COMMONCAMLFLAGS= $(CAMLINCLUDE) $(PP) #-thread 26 | CAMLLIBS=unix.cma str.cma mylibs.cma 27 | OCAMLFLAGS=$(COMMONCAMLFLAGS) -g 28 | OCAMLOPTFLAGS=$(COMMONCAMLFLAGS) -inline 40 29 | 30 | ifndef LIBDB 31 | LIBDB=-ldb-4.6 32 | endif 33 | 34 | COBJS = bdb_stubs.o 35 | 36 | ocextr: ocextr.ml 37 | $(OCAMLC) -o ocextr ocextr.ml 38 | 39 | libbdb.a: $(COBJS) 40 | $(MKLIB) -custom -o bdb $(COBJS) 41 | 42 | bdb_stubs.o: bdb_stubs.h bdb_stubs.c 43 | 44 | bdb.ml: ocextr bdb_stubs.c 45 | ./ocextr bdb_stubs.c > bdb.ml 46 | 47 | bdb.cma: bdb.cmo libbdb.a 48 | $(MKLIB) -custom -o bdb bdb.cmo -lbdb $(LIBDB) 49 | 50 | bdb.cmxa: bdb.cmx libbdb.a 51 | $(MKLIB) -custom -o bdb bdb.cmx -lbdb $(LIBDB) 52 | 53 | bdbcaml: bdb.cma 54 | ocamlmktop -o bdbcaml -custom unix.cma bdb.cma $^ 55 | 56 | partialclean: 57 | rm -f *.cm* *.annot 58 | 59 | clean: partialclean 60 | rm -f *.a *.o 61 | rm -f bdb.ml 62 | rm -f ocextr 63 | 64 | install: 65 | cp libmldb.a $(LIBDIR)/libmldb.a 66 | cd $(LIBDIR); $(RANLIB) libmldb.a 67 | cp db.cma db.cmi bdb.mli db.mli $(LIBDIR) 68 | 69 | installopt: 70 | cp db.cmx db.cmxa db.a $(LIBDIR) 71 | cd $(LIBDIR); $(RANLIB) db.a 72 | 73 | 74 | 75 | # Common rules 76 | .SUFFIXES: .ml .mli .cmo .cmi .cmx 77 | 78 | .ml.o: 79 | $(OCAMLOPT) -output-obj $(OCAMLOPTFLAGS) $< 80 | 81 | .cpp.o: 82 | $(CXX) $(CXXFLAGS) -c $< 83 | 84 | .c.o: 85 | $(CC) $(CFLAGS) -c $< 86 | 87 | .c.obj: 88 | $(CC) $(CFLAGS) /c $< 89 | 90 | .ml.cmo: 91 | $(OCAMLC) $(OCAMLFLAGS) -c $< 92 | 93 | .mli.cmi: 94 | $(OCAMLC) $(OCAMLFLAGS) -c $< 95 | 96 | .ml.cmx: 97 | $(OCAMLOPT) $(OCAMLOPTFLAGS) -c $< 98 | 99 | # Dependencies 100 | #dep: 101 | # $(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend 102 | 103 | #include .depend 104 | 105 | 106 | # DO NOT DELETE 107 | -------------------------------------------------------------------------------- /add_mail.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* add_mail.ml - Executable: interprets stdin as mail message and *) 3 | (* posts content to specified HTTP address *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | open Printf 27 | module Unix = UnixLabels 28 | module Map = PMap.Map 29 | module Set = PSet.Set 30 | 31 | (** Argument parsing *) 32 | 33 | let anonymous = ref [] 34 | 35 | let usage_string = 36 | Sys.argv.(0) ^ " sks_directory_name" 37 | 38 | let anon_options option = 39 | anonymous := option::!anonymous 40 | 41 | let parse_spec = [ ] 42 | 43 | let dirname = 44 | Arg.parse parse_spec anon_options usage_string; 45 | if List.length !anonymous <> 1 46 | then ( 47 | printf "Wrong number (%d) of arguments given. %s\n" 48 | (List.length !anonymous) 49 | usage_string; 50 | exit (-1) 51 | ) else 52 | Filename.concat (List.hd !anonymous) "messages" 53 | 54 | (** dumps contents of one file into another *) 55 | let pipe_file = 56 | let blocksize = 100 * 1024 in 57 | let buf = Bytes.create blocksize in 58 | let rec pipe_file file1 file2 = 59 | let bytes_read = input file1 buf 0 blocksize in 60 | if bytes_read <> 0 then ( 61 | output file2 buf 0 bytes_read; 62 | pipe_file file1 file2 63 | ) 64 | in 65 | pipe_file 66 | 67 | let run () = 68 | if not (Sys.file_exists dirname) 69 | then Unix.mkdir dirname 0o700; 70 | let fname = sprintf "msg-%08d" (Random.int 100000000) in 71 | let fname = Filename.concat dirname fname in 72 | let f = open_out fname in 73 | pipe_file stdin f; 74 | close_out f; 75 | Sys.rename fname (fname ^ ".ready") 76 | 77 | let () = 78 | Random.self_init (); 79 | run () 80 | -------------------------------------------------------------------------------- /meteredChannel.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* meteredChannel.ml - Version of the [Channel] objects that keeps *) 3 | (* track of the number of bytes sent through them. *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | module Unix=UnixLabels 27 | 28 | 29 | class metered_out_channel outc = 30 | object (self) 31 | inherit Channel.out_channel_obj 32 | 33 | val mutable count = 0 34 | 35 | method private incr c = count <- count + c 36 | 37 | method write_string str = 38 | outc#write_string str; 39 | self#incr (String.length str) 40 | 41 | method write_string_pos ~buf ~pos ~len = 42 | outc#write_string_pos ~buf ~pos ~len; 43 | self#incr len 44 | 45 | method write_char char = 46 | outc#write_char char; 47 | self#incr 1 48 | 49 | method write_byte byte = 50 | outc#write_byte byte; 51 | self#incr 1 52 | 53 | method flush : unit = outc#flush 54 | method upcast = (self :> Channel.out_channel_obj) 55 | method reset = count <- 0 56 | method bytes = count 57 | 58 | end 59 | 60 | 61 | class metered_in_channel inc = 62 | object (self) 63 | inherit Channel.in_channel_obj 64 | 65 | val mutable count = 0 66 | 67 | method private incr c = count <- count + c 68 | 69 | method read_string len = 70 | self#incr len; 71 | inc#read_string len 72 | 73 | method read_string_pos ~buf ~pos ~len = 74 | self#incr len; 75 | inc#read_string_pos ~buf ~pos ~len 76 | 77 | method read_char = 78 | self#incr 1; 79 | inc#read_char 80 | 81 | method read_byte = 82 | self#incr 1; 83 | inc#read_byte 84 | 85 | method upcast = (self :> Channel.in_channel_obj) 86 | method reset = count <- 0 87 | method bytes = count 88 | 89 | end 90 | -------------------------------------------------------------------------------- /mList.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* mList.mli - Various list operations *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | val average : float list -> float 24 | val iaverage : int list -> float 25 | val init : int -> f:(int -> 'a) -> 'a list 26 | val init_by_value : int -> value:'a -> 'a list 27 | 28 | val to_string : f:('a -> string) -> 'a list -> string 29 | val print_int_list : int list -> unit 30 | val print : f:('a -> 'b) -> 'a list -> unit 31 | val print2 : f:('a -> 'b) -> 'a list -> unit 32 | 33 | val swap_pairs_rec : ('a * 'b) list -> ('b * 'a) list -> ('b * 'a) list 34 | val swap_pairs : ('a * 'b) list -> ('b * 'a) list 35 | val range : int -> int -> int list 36 | val srange : ?step:int -> int -> int -> int list 37 | val rand_elem : 'a list -> 'a 38 | val omit_first : 'a list -> 'a list 39 | val drop_kth : k:int -> 'a list -> 'a list 40 | val first_k : k:int -> 'a list -> 'a list 41 | val k_split : k:int -> list:'a list -> 'a list * 'a list 42 | val last_elem : 'a list -> 'a 43 | val last_k : k:int -> 'a list -> 'a list 44 | val drop_k : k:int -> 'a list -> 'a list 45 | val drop_last_k : k:int -> 'a list -> 'a list 46 | val drop_last : 'a list -> 'a list 47 | val all_true : bool list -> bool 48 | val pri_split : 'a -> ('a * 'b) list -> ('a * 'b) list * ('a * 'b) list * ('a * 'b) list 49 | val has_dups : 'a list -> bool 50 | val dedup : 'a list -> 'a list 51 | val choose_best : f:('a -> 'a -> 'a) -> 'a list -> 'a 52 | val count_true : bool list -> int 53 | val max : 'a list -> 'a 54 | val min : 'a list -> 'a 55 | 56 | val iteri : f:(i:int -> 'a -> 'b) -> 'a list -> unit 57 | val mapi : f:(i:int -> 'a -> 'b) -> 'a list -> 'b list 58 | val map : f:('a -> 'b) -> 'a list -> 'b list 59 | val filteri : f:(i:int -> 'a -> bool) -> 'a list -> 'a list 60 | 61 | val find_index : 'a -> 'a list -> int 62 | val cons_opt : 'a option -> 'a list -> 'a list 63 | val strip_opt : 'a option list -> 'a list 64 | val reduce : f : ( 'a -> 'a -> 'a ) -> 'a list -> 'a 65 | -------------------------------------------------------------------------------- /query.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* query.ml - Executable: Simple tool for direct querying key db. *) 3 | (* Should not be used while dbserver is running *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | open Printf 27 | open Arg 28 | open Packet 29 | 30 | module Keydb = Keydb.Make(struct 31 | let withtxn = false 32 | and cache_bytes = !Settings.cache_bytes 33 | and pagesize = !Settings.pagesize 34 | and dbdir = !Settings.dbdir 35 | and dumpdir = !Settings.dumpdir 36 | end) 37 | 38 | 39 | let dbdir = !Settings.dbdir 40 | 41 | let _ = 42 | Keydb.open_dbs () 43 | 44 | let _ = 45 | try 46 | while true do 47 | let line = try read_line () with End_of_file -> raise Exit in 48 | try 49 | let words = Keydb.extract_words line in 50 | 51 | print_string " Query words: "; 52 | MList.print ~f:(fun s -> printf "\"%s\"" s) words; 53 | print_newline (); 54 | 55 | let keylist = Keydb.get_by_words ~max:200 words in 56 | List.iter ~f:(fun key -> 57 | try 58 | let keyid = Fingerprint.keyid_from_key key in 59 | let keyidstr = Fingerprint.keyid_to_string 60 | ~short:true keyid in 61 | printf "0x%s: %s\n" 62 | keyidstr (List.hd (Key.get_ids key)) 63 | with 64 | Not_found -> 65 | printf "Failure to extract key\n"; 66 | ) 67 | keylist; 68 | with 69 | e -> raise e 70 | done 71 | 72 | with 73 | | Exit -> Keydb.close_dbs (); print_string "Exiting.\n" 74 | | e -> Keydb.close_dbs (); 75 | print_string "Exiting by exception.\n"; 76 | raise e 77 | 78 | -------------------------------------------------------------------------------- /keyHash.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* keyHash.ml - Sorts key and generates MD5 hash of sorted key *) 3 | (* Note that hash should not depend on whether old or *) 4 | (* new-style packets are used, although for nested *) 5 | (* packets, packet format will make a difference. *) 6 | (* *) 7 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 8 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 9 | (* *) 10 | (* This file is part of SKS. SKS is free software; you can *) 11 | (* redistribute it and/or modify it under the terms of the GNU General *) 12 | (* Public License as published by the Free Software Foundation; either *) 13 | (* version 2 of the License, or (at your option) any later version. *) 14 | (* *) 15 | (* This program is distributed in the hope that it will be useful, but *) 16 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 17 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 18 | (* General Public License for more details. *) 19 | (* *) 20 | (* You should have received a copy of the GNU General Public License *) 21 | (* along with this program; if not, write to the Free Software *) 22 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 23 | (* USA or see . *) 24 | (***********************************************************************) 25 | 26 | open StdLabels 27 | open MoreLabels 28 | 29 | open Packet 30 | open Printf 31 | 32 | let hash_bytes = 16 33 | 34 | let packet_cmp p1 p2 = 35 | let c = compare p1.content_tag p2.content_tag in 36 | if c <> 0 then c 37 | else compare p1.packet_body p2.packet_body 38 | 39 | (* takes a key and dumps all of its contents into one long string *) 40 | let concat key = 41 | let length = List.fold_left 42 | ~f:(fun sum p -> sum + 4 + p.packet_length) 43 | ~init:0 key 44 | in 45 | let bufc = Channel.new_buffer_outc length in 46 | List.iter ~f:(fun p -> 47 | bufc#write_int p.content_tag ; 48 | bufc#write_int p.packet_length; 49 | bufc#write_string p.packet_body) 50 | key; 51 | bufc#contents 52 | 53 | let sort key = 54 | List.sort ~cmp:packet_cmp key 55 | 56 | let hash key = 57 | let keystring = concat (sort key) in 58 | let hash = Digest.string keystring in 59 | (hash : string) 60 | 61 | 62 | let hexify s = Utils.hexstring s 63 | 64 | let hexchar_to_int c = 65 | let ic = int_of_char c in 66 | if ic >= int_of_char '0' && ic <= int_of_char '9' then 67 | ic - int_of_char '0' 68 | else ( 69 | if not (ic <= int_of_char 'F' && ic >= int_of_char 'A') 70 | then failwith "char out of range for hex conversion"; 71 | ic - int_of_char 'A' + 10 72 | ) 73 | 74 | let dehexify s = 75 | let s = Utils.uppercase s in 76 | let ns = Bytes.create (String.length s / 2) in (* new string *) 77 | for i = 0 to Bytes.length ns - 1 do 78 | let first = hexchar_to_int s.[2 * i] 79 | and second = hexchar_to_int s.[2 * i + 1] 80 | in 81 | Bytes.set ns i (char_of_int ((first lsl 4) + second)) 82 | done; 83 | Bytes.unsafe_to_string ns 84 | -------------------------------------------------------------------------------- /sksclient.ml: -------------------------------------------------------------------------------- 1 | (************************************************************************) 2 | (* This file is part of SKS. SKS is free software; you can 3 | redistribute it and/or modify it under the terms of the GNU General 4 | Public License as published by the Free Software Foundation; either 5 | version 2 of the License, or (at your option) any later version. 6 | 7 | This program is distributed in the hope that it will be useful, but 8 | WITHOUT ANY WARRANTY; without even the implied warranty of 9 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | General Public License for more details. 11 | 12 | You should have received a copy of the GNU General Public License 13 | along with this program; if not, write to the Free Software 14 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 15 | USA *) 16 | (***********************************************************************) 17 | 18 | open StdLabels 19 | open MoreLabels 20 | open Printf 21 | open Common 22 | open DbMessages 23 | 24 | let settings = 25 | { Keydb. 26 | withtxn = !Settings.transactions; 27 | cache_bytes = !Settings.cache_bytes; 28 | pagesize = !Settings.pagesize; 29 | keyid_pagesize = !Settings.keyid_pagesize; 30 | meta_pagesize = !Settings.meta_pagesize; 31 | subkeyid_pagesize = !Settings.subkeyid_pagesize; 32 | time_pagesize = !Settings.time_pagesize; 33 | tqueue_pagesize = !Settings.tqueue_pagesize; 34 | word_pagesize = !Settings.word_pagesize; 35 | dbdir = Lazy.force Settings.dbdir; 36 | dumpdir = Lazy.force Settings.dumpdir; 37 | } 38 | 39 | module Keydb = Keydb.Safe 40 | 41 | let get_keys_by_keyid keyid = 42 | let keyid_length = String.length keyid in 43 | let short_keyid = String.sub ~pos:(keyid_length - 4) ~len:4 keyid in 44 | let keys = Keydb.get_by_short_subkeyid short_keyid in 45 | match keyid_length with 46 | | 4 -> (* 32-bit keyid. No further filtering required. *) 47 | keys 48 | 49 | | 8 -> (* 64-bit keyid *) 50 | List.filter keys 51 | ~f:(fun key -> keyid = (Fingerprint.from_key key).Fingerprint.keyid || 52 | (** Return keys i& subkeys with matching long keyID *) 53 | let (mainkeyid,subkeyids) = Fingerprint.keyids_from_key ~short:false key in 54 | List.exists (fun x -> x = keyid) subkeyids) 55 | 56 | | _ -> failwith "Unknown keyid type" 57 | 58 | let dump_one_key keyid = 59 | let deprefixed = 60 | if String.length keyid <= 2 then exit 3 61 | else if String.sub keyid 0 2 = "0x" 62 | then String.sub keyid 2 (String.length keyid - 2) 63 | else keyid 64 | in 65 | let keys = get_keys_by_keyid (KeyHash.dehexify deprefixed) in 66 | let aakeys = 67 | if keys = [] then exit 2 68 | else Armor.encode_pubkey_string (Key.to_string_multiple keys) 69 | in 70 | printf "%s\n" aakeys 71 | 72 | (** iterate over lines from stdin, printing out a final \n at the end *) 73 | let rec stdin_iter f = 74 | let line = try Some (input_line stdin) with End_of_file -> None in 75 | match line with 76 | | None -> printf "\n" 77 | | Some line -> f line; stdin_iter f 78 | 79 | let keysource action = 80 | if !Settings.use_stdin then stdin_iter action 81 | else 82 | for i = 1 to Array.length Sys.argv - 1 do 83 | action Sys.argv.(i) 84 | done 85 | 86 | let () = 87 | if Array.length Sys.argv < 2 then failwith "Keys in argv unless -stdin set"; 88 | set_logfile "sksclient"; 89 | perror "sksclient (SKS %s%s)" Common.version Common.version_suffix; 90 | Keydb.open_dbs settings; 91 | keysource dump_one_key; 92 | Keydb.close_dbs (); 93 | -------------------------------------------------------------------------------- /ptree_replay.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* ptree_replay.ml - Test for verifying consistency of prefix tree *) 3 | (* data structure *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open Common 25 | open StdLabels 26 | open MoreLabels 27 | module Set = PSet.Set 28 | 29 | open Pstyle 30 | open ReconPTreeDb 31 | open ReconPTreeDb.PDb 32 | 33 | (******************************************************************) 34 | 35 | let rec get_piece_ch ch s pos = 36 | if pos >= String.length s then None 37 | else if s.[pos] = ch then get_piece_ch ch s (pos + 1) 38 | else 39 | try 40 | let nextpos = String.index_from s pos ch in 41 | Some ((String.sub ~pos ~len:(nextpos - pos) s),nextpos) 42 | with 43 | Not_found -> 44 | Some ((String.sub ~pos ~len:(String.length s - pos) s), 45 | String.length s) 46 | 47 | let rec chsplit ch s pos = 48 | match get_piece_ch ch s pos with 49 | None -> [] 50 | | Some (piece,nextpos) -> piece::chsplit ch s nextpos 51 | 52 | let chsplit ch s = Array.of_list (chsplit ch s 0) 53 | 54 | (******************************************************************) 55 | 56 | let hashfile = "log.real" 57 | 58 | let rec hashiter ~f file = 59 | match (try Some (input_line file) with End_of_file -> None) 60 | with 61 | | None -> () 62 | | Some line -> 63 | let pieces = chsplit ' ' line in 64 | let hash = KeyHash.dehexify pieces.(-1) in 65 | let action = match pieces.(-2) with 66 | | "Add" -> Add hash 67 | | "Del" -> Delete hash 68 | | _ -> failwith "Unexpected action" 69 | in 70 | f action; 71 | hashiter ~f file 72 | 73 | let hashiter ~f file = 74 | ignore (input_line file); 75 | hashiter ~f file 76 | 77 | let apply_action txn action = 78 | match action with 79 | | Add hash -> PTree.insert_str !ptree txn hash 80 | | Delete hash -> PTree.delete_str !ptree txn hash 81 | 82 | 83 | let () = 84 | let file = open_in hashfile in 85 | let txn = new_txnopt () in 86 | try 87 | hashiter ~f:(apply_action txn) file; 88 | commit_txnopt txn; 89 | with 90 | e -> 91 | abort_txnopt txn; 92 | raise e 93 | -------------------------------------------------------------------------------- /ANNOUNCEMENT: -------------------------------------------------------------------------------- 1 | We are pleased to announce the availability of a new stable SKS 2 | release: Version 1.1.6. 3 | 4 | SKS is an OpenPGP keyserver whose goal is to provide easy to deploy, 5 | decentralized, and highly reliable synchronization. That means that a 6 | key submitted to one SKS server will quickly be distributed to all key 7 | servers, and even wildly out-of-date servers, or servers that experience 8 | spotty connectivity, can fully synchronize with rest of the system. 9 | 10 | What's New in 1.1.6 11 | ==================== 12 | - Add support for Elliptic Curve keys based on Curve25519 (both Ed25519/EdDSA 13 | and encryption keys based on these curves) 14 | - Fix format of md5sum file by adding a 2nd space to be format compliant 15 | - Improvements to sks build stack space requirements 16 | - Misc updates and fixes to web interface and typical config file 17 | 18 | Note when upgrading from earlier versions of SKS 19 | ==================== 20 | The default values for pagesize settings changed in SKS 1.1.4. To continue 21 | using an existing DB from earlier versions without rebuilding, explicit settings 22 | have to be added to the sksconf file. 23 | pagesize: 4 24 | ptree_pagesize: 1 25 | 26 | Getting the Software 27 | ==================== 28 | SKS can be downloaded from 29 | https://bitbucket.org/skskeyserver/sks-keyserver 30 | 31 | Prerequisites 32 | ==================== 33 | There are a few prerequisites to building this code. You need: 34 | * ocaml-4.0 or later. Get it from 35 | 36 | * Berkeley DB version 4.6.* or later, whereby 4.8 or later is recommended. 37 | You can find the appropriate versions at 38 | 39 | * GNU Make and a C compiler (e.g gcc) 40 | 41 | 42 | Verifying the integrity of the download 43 | ==================== 44 | Releases of SKS are signed using the SKS Keyserver Signing Key 45 | available on public keyservers with the KeyID 46 | 47 | 0x41259773973A612A 48 | 49 | and has a fingerprint of 50 | 51 | C90E F143 0B3A C0DF D00E 6EA5 4125 9773 973A 612A. 52 | 53 | Using GnuPG, verification can be accomplished by, first, retrieving the signing 54 | key using 55 | 56 | gpg --keyserver pool.sks-keyservers.net --recv-key 0x41259773973A612A 57 | 58 | followed by verifying that you have the correct key 59 | 60 | gpg --keyid-format long --fingerprint 0x41259773973A612A 61 | 62 | should produce: 63 | 64 | pub 4096R/41259773973A612A 2012-06-27 65 | Key fingerprint = C90E F143 0B3A C0DF D00E 6EA5 4125 9773 973A 612A 66 | 67 | A check should also be made that the key is signed by 68 | trustworthy other keys; 69 | 70 | gpg --list-sigs 0x41259773973A612A 71 | 72 | and the fingerprint should be verified through other trustworthy sources. 73 | 74 | Once you are certain that you have the correct key downloaded, you can create 75 | a local signature, in order to remember that you have verified the key. 76 | 77 | gpg --lsign-key 0x41259773973A612A 78 | 79 | Finally; verifying the downloaded file can be done using 80 | 81 | gpg --keyid-format long --verify sks-x.y.z.tgz.asc 82 | 83 | The resulting output should be similar to 84 | 85 | gpg: Signature made Wed Jun 27 12:52:39 2012 CEST 86 | gpg: using RSA key 41259773973A612A 87 | gpg: Good signature from "SKS Keyserver Signing Key" 88 | 89 | 90 | Thanks 91 | ==================== 92 | We have to thank all the people who helped with this release, by discussions on 93 | the mailing list, submitting patches, or opening issues for items that needed 94 | our attention. 95 | 96 | Happy Hacking, 97 | 98 | The SKS Team (Yaron, John, Kristian, Phil, and the other contributors) 99 | -------------------------------------------------------------------------------- /bdb/db.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Objective Caml *) 4 | (* *) 5 | (* Francois Rouaix, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file ../../LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: db.ml,v 1.1.1.1 2002/10/01 00:10:14 yminsky Exp $ *) 15 | 16 | (* Module [Db]: interface to the DB databases *) 17 | 18 | (* this collides with Unix *) 19 | type open_flag = 20 | O_CREAT 21 | | O_EXCL 22 | | O_RDONLY 23 | | O_RDWR 24 | | O_TRUNC 25 | 26 | type routine_flag = 27 | R_CURSOR 28 | | R_FIRST 29 | | R_LAST 30 | | R_NEXT 31 | | R_NOOVERWRITE 32 | | R_PREV 33 | | R_SETCURSOR 34 | 35 | 36 | (* All other fields have default values *) 37 | type btree_flag = 38 | Duplicates (* means R_DUP *) 39 | | Cachesize of int 40 | 41 | 42 | type file_perm = int 43 | 44 | exception DB_error of string 45 | (* Raised by the following functions when an error is encountered. *) 46 | 47 | external caml_db_init : unit -> unit 48 | = "caml_db_init" 49 | 50 | let _ = Callback.register_exception "dberror" (DB_error "") 51 | let _ = caml_db_init() 52 | 53 | type key = string 54 | type data = string 55 | type t 56 | 57 | (* Raw access *) 58 | external dbopen : string -> open_flag list -> file_perm -> btree_flag list -> t 59 | = "caml_db_open" 60 | (* [dbopen file flags mode dupentries] *) 61 | 62 | (* The common subset of available primitives *) 63 | external close : t -> unit 64 | = "caml_db_close" 65 | 66 | external del : t -> key -> routine_flag list -> unit 67 | = "caml_db_del" 68 | (* raise Not_found if the key was not in the file *) 69 | 70 | external get : t -> key -> routine_flag list -> data 71 | = "caml_db_get" 72 | (* raise Not_found if the key was not in the file *) 73 | 74 | external put : t -> key:key -> data:data -> routine_flag list -> unit 75 | = "caml_db_put" 76 | 77 | external seq : t -> key -> routine_flag list -> (key * data) 78 | = "caml_db_seq" 79 | 80 | external sync : t -> unit 81 | = "caml_db_sync" 82 | 83 | 84 | (* Wrap-up as for other table-like types *) 85 | let add db ~key:x ~data:v = put db x v [R_NOOVERWRITE] 86 | let find db x = get db x [] 87 | let find_all db x = 88 | try 89 | match seq db x [R_CURSOR] with 90 | k, v when k = x -> 91 | let l = ref [v] in 92 | begin 93 | try 94 | while true do 95 | let k, v = seq db x [R_NEXT] in 96 | if k = x then l := v :: !l 97 | else raise Exit 98 | done; 99 | !l 100 | with 101 | Exit | Not_found -> !l 102 | end 103 | | _ -> (* its greater than x *) [] 104 | with 105 | Not_found -> [] 106 | 107 | let remove db x = del db x [] 108 | 109 | let iter ~f db = 110 | let rec walk = function 111 | None -> () 112 | | Some(k, v) -> 113 | f ~key:k ~data:v; 114 | walk (try Some(seq db k [R_NEXT]) with Not_found -> None) 115 | in 116 | walk (try Some(seq db "" [R_FIRST]) with Not_found -> None) 117 | -------------------------------------------------------------------------------- /ptree_consistency_test.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* ptree_consistency_test.ml - Test for verifying consistency of *) 3 | (* prefix tree data structure *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open Common 25 | open StdLabels 26 | open MoreLabels 27 | module Set = PSet.Set 28 | 29 | open ReconPTreeDb 30 | 31 | let ident x = x 32 | 33 | let node_to_svalues node = node.PTree.svalues 34 | 35 | let check_svalues parent children = 36 | let parent = ZZp.zzarray_to_array parent in 37 | let children = List.map ~f:ZZp.zzarray_to_array children in 38 | match children with 39 | [] -> failwith "check_svalues: no children to check" 40 | | hd::tl -> 41 | parent = List.fold_left ~f:ZZp.array_mult ~init:hd tl 42 | 43 | let check_node ptree parent children = 44 | check_svalues parent.PTree.svalues 45 | (List.map ~f:node_to_svalues children) 46 | 47 | let check_leaf ptree node = 48 | let points = ptree.PTree.points in 49 | let svalues = PTree.create_svalues points in 50 | match node.PTree.children with 51 | | PTree.Children _ -> failwith "check_leaf called on non-leaf node" 52 | | PTree.Leaf children -> 53 | Set.iter children ~f:(fun zzs -> 54 | let zz = ZZp.of_bytes zzs in 55 | ZZp.add_el ~svalues ~points zz 56 | ); 57 | (ZZp.zzarray_to_array node.PTree.svalues = 58 | ZZp.zzarray_to_array svalues) 59 | 60 | let rec check_tree ptree node = 61 | let key = node.PTree.key in 62 | let keyrep = Bitstring.to_string key in 63 | if PTree.is_leaf node then 64 | let rval = check_leaf ptree node in 65 | if rval 66 | then perror "leaf passed: %s" keyrep 67 | else perror "leaf failed: %s" keyrep; 68 | rval 69 | else 70 | let childkeys = PTree.child_keys ptree key in 71 | let children = 72 | List.map ~f:(fun key -> PTree.get_node_key ptree key) childkeys 73 | in 74 | let node_passed = check_node ptree node children in 75 | if node_passed 76 | then perror "internal node passed: %s" keyrep 77 | else perror "internal node failed: %s" keyrep; 78 | let child_status = List.map ~f:(check_tree ptree) children in 79 | node_passed & 80 | List.for_all ~f:ident child_status 81 | 82 | let () = 83 | perror "Starting recursive check"; 84 | if check_tree !ptree (!ptree).PTree.root 85 | then perror "tree passed" 86 | else perror "tree FAILED" 87 | -------------------------------------------------------------------------------- /sampleWeb/XHTML+ES/functions.es: -------------------------------------------------------------------------------- 1 | function set_modifier_status(id, active) 2 | { 3 | if (active) 4 | { 5 | document.getElementById(id).style.visibility = "visible"; 6 | document.getElementById(id + ".label").style.visibility = "visible"; 7 | document.getElementById(id).disabled = false; 8 | document.getElementById(id + ".label").disabled = false; 9 | } 10 | else 11 | { 12 | document.getElementById(id).style.visibility = "hidden"; 13 | document.getElementById(id + ".label").style.visibility = "hidden"; 14 | document.getElementById(id).disabled = true; 15 | document.getElementById(id + ".label").disabled = true; 16 | } 17 | } 18 | 19 | 20 | 21 | 22 | function search_options_change() 23 | { 24 | var op = ""; 25 | for (var i = 0; i < document.getElementsByName("op").length; ++i) 26 | if (document.getElementsByName("op")[i].checked) 27 | { 28 | op = document.getElementsByName("op")[i].value; 29 | break; 30 | } 31 | 32 | 33 | switch (op) 34 | { 35 | case "index": 36 | set_modifier_status("modifier_fingerprint", true) 37 | set_modifier_status("modifier_hash", true) 38 | set_modifier_status("modifier_options-mr", true) 39 | 40 | if ( ( document.getElementById("modifier_fingerprint").checked || document.getElementById("modifier_hash").checked ) && document.getElementById("modifier_options-mr").checked ) 41 | { 42 | document.getElementById("modifier_options-mr").checked = false; 43 | } 44 | if (document.getElementById("modifier_options-mr").checked) 45 | { 46 | set_modifier_status("modifier_fingerprint", false) 47 | set_modifier_status("modifier_hash", false) 48 | } 49 | else 50 | { 51 | set_modifier_status("modifier_fingerprint", true) 52 | set_modifier_status("modifier_hash", true) 53 | } 54 | if (document.getElementById("modifier_fingerprint").checked || document.getElementById("modifier_hash").checked) 55 | set_modifier_status("modifier_options-mr", false) 56 | else 57 | set_modifier_status("modifier_options-mr", true) 58 | 59 | break; 60 | 61 | case "vindex": 62 | set_modifier_status("modifier_fingerprint", true) 63 | set_modifier_status("modifier_hash", true) 64 | set_modifier_status("modifier_options-mr", false) 65 | 66 | break; 67 | 68 | case "get": 69 | set_modifier_status("modifier_fingerprint", false) 70 | set_modifier_status("modifier_hash", false) 71 | set_modifier_status("modifier_options-mr", true) 72 | 73 | break; 74 | 75 | case "hget": 76 | set_modifier_status("modifier_fingerprint", false) 77 | set_modifier_status("modifier_hash", false) 78 | set_modifier_status("modifier_options-mr", true) 79 | 80 | break; 81 | } 82 | 83 | 84 | 85 | 86 | } 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | /* 104 | Copyright © 2010–2013, Christoph Anton Mitterer . 105 | All rights reserved. 106 | 107 | 108 | This program is free software: you can redistribute it and/or modify it under 109 | the terms of the GNU General Public License as published by the Free Software 110 | Foundation, either version 3 of the License, or (at your option) any later 111 | version. 112 | This program is distributed in the hope that it will be useful, but WITHOUT ANY 113 | WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A 114 | PARTICULAR PURPOSE. 115 | See the GNU General Public License for more details. 116 | You should have received a copy of the GNU General Public License along with 117 | this program. If not, see . 118 | 119 | This work is licensed under the Creative Commons Attribution-ShareAlike 3.0 120 | Unported License. 121 | To view a copy of this license, visit 122 | http://creativecommons.org/licenses/by-sa/3.0/. 123 | 124 | This work is licensed under the Creative Commons Attribution-ShareAlike 3.0 125 | Germany License. 126 | To view a copy of this license, visit 127 | http://creativecommons.org/licenses/by-sa/3.0/de/. 128 | */ 129 | -------------------------------------------------------------------------------- /poly_test.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* poly_test.ml - unit tests for Poly module *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open Common 24 | open StdLabels 25 | open MoreLabels 26 | module Unix = UnixLabels 27 | open Printf 28 | open ZZp.Infix 29 | 30 | 31 | let rand_int n = Random.State.int RMisc.det_rng n 32 | let rand_bits () = Random.State.bits RMisc.det_rng 33 | 34 | let ctr = ref 0 35 | let test name cond = 36 | printf ".%!"; 37 | incr ctr; 38 | if not cond then raise 39 | (Unit_test_failure (sprintf "Poly test %s:%d failed" name !ctr)) 40 | 41 | 42 | let divtest () = 43 | let x = Poly.of_array [| ZZp.one; ZZp.one; ZZp.one; ZZp.one |] in 44 | let c = ZZp.of_int 5 in 45 | let y = Poly.of_array [| c; c; c |] in 46 | let (q,r) = Poly.divmod x y in 47 | test "invtest" (Poly.eq x (Poly.add (Poly.mult y q) r)); 48 | test "rtest" (Poly.eq r (Poly.of_array [| ZZp.one |])); 49 | test "qtest" (Poly.eq q (Poly.of_array [| ZZp.zero; ZZp.inv c |])) 50 | 51 | let rand_divtest () = 52 | let p1 = Poly.of_array (Array.init (1 + rand_int 20) 53 | ~f:(fun i -> ZZp.rand rand_bits)) in 54 | let p2 = Poly.of_array (Array.init (1 + rand_int 20) 55 | ~f:(fun i -> ZZp.rand rand_bits)) in 56 | let (q,r) = Poly.divmod p1 p2 in 57 | let z = ZZp.rand rand_bits in 58 | let r_z = Poly.eval r z 59 | and q_z = Poly.eval q z 60 | and p1_z = Poly.eval p1 z 61 | and p2_z = Poly.eval p2 z 62 | in 63 | test "rand_divtest" (p1_z =: p2_z *: q_z +: r_z) 64 | 65 | (** returns true iff y divides x *) 66 | let divides x y = 67 | Poly.eq (Poly.modulo x y) Poly.zero 68 | 69 | let gcd_test () = 70 | let p1 = Poly.of_array (Array.init (1 + rand_int 20) 71 | ~f:(fun i -> ZZp.rand rand_bits)) in 72 | let p2 = Poly.of_array (Array.init (1 + rand_int 20) 73 | ~f:(fun i -> ZZp.rand rand_bits)) in 74 | let p3 = Poly.of_array (Array.init (1 + rand_int 20) 75 | ~f:(fun i -> ZZp.rand rand_bits)) in 76 | let p1 = Poly.mult p1 p3 in 77 | let p2 = Poly.mult p2 p3 in 78 | let gcd = Poly.gcd p1 p2 in 79 | test "gcd - p3 div" (divides gcd p3); 80 | test "gcd - gcd div 1" (divides p1 gcd); 81 | test "gcd - gcd div 2" (divides p2 gcd); 82 | let p1 = Poly.div p1 gcd in 83 | let p2 = Poly.div p2 gcd in 84 | let gcd = Poly.gcd p1 p2 in 85 | test "gcd - zero" (Poly.degree gcd = 0) 86 | 87 | 88 | let run () = 89 | begin 90 | for i = 1 to 100 do 91 | rand_divtest () 92 | done; 93 | for i = 1 to 100 do 94 | gcd_test () 95 | done; 96 | divtest (); 97 | end 98 | -------------------------------------------------------------------------------- /recvmail.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* recvmail.ml - Simple (and likely incomplete) interface for *) 3 | (* receiving mail *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open Common 25 | open StdLabels 26 | open MoreLabels 27 | open Printf 28 | module Unix = UnixLabels 29 | 30 | let whitespace = Str.regexp "[ \t\n\r]+" 31 | let eol = Str.regexp "\r?\n" 32 | 33 | exception No_colon 34 | 35 | let parse_header_line hline = 36 | if String.length hline = 0 37 | then None (* done parsing header *) 38 | else 39 | if hline.[0] = '\t' 40 | then (* this is a continuation, not a new pair *) 41 | Some ("",String.sub ~pos:1 ~len:(String.length hline - 1) hline) 42 | else 43 | 44 | try 45 | let colonpos = 46 | try String.index hline ':' 47 | with Not_found -> raise No_colon 48 | in 49 | let key = String.sub hline ~pos:0 ~len:colonpos 50 | and data = String.sub hline ~pos:(colonpos+1) 51 | ~len:(String.length hline - colonpos - 1) 52 | in 53 | if String.contains data ' ' then 54 | (* then the colon in question wasn't a real line *) 55 | Some ("",Wserver.strip hline) 56 | else 57 | Some (Wserver.strip key, Wserver.strip data) 58 | 59 | with 60 | No_colon -> Some ("",Wserver.strip hline) 61 | 62 | 63 | 64 | let rec parse_header lines header = match lines with 65 | [] -> 66 | (* headers done, no body left *) 67 | (List.rev header,[]) 68 | | hline::tl -> match parse_header_line hline with 69 | None -> (List.rev header,tl) 70 | | Some pair -> parse_header tl (pair::header) 71 | 72 | 73 | (** Given a list of headers where some entries have no keys listed, returns a 74 | list of headers where those keyless entries have been joined into previous 75 | entries. 76 | *) 77 | let rec simplify_headers headers newheaders = 78 | match headers with 79 | [] -> List.rev newheaders 80 | | ("",data)::header_tl -> 81 | (match newheaders with 82 | [] -> failwith "simplify_headers: initial header line lacks field" 83 | | (key,prevdata)::newheader_tl -> 84 | simplify_headers 85 | header_tl ((key,prevdata ^ "\n" ^ data)::newheader_tl) 86 | ) 87 | | (key,data)::header_tl -> 88 | simplify_headers header_tl ((key,data)::newheaders) 89 | 90 | let simplify_headers headers = simplify_headers headers [] 91 | 92 | let parse msgtext = 93 | let lines = Str.split eol msgtext in 94 | let (headers,bodylines) = parse_header lines [] in 95 | (*let headers = simplify_headers headers in *) 96 | { Sendmail.headers = headers; 97 | Sendmail.body = String.concat ~sep:"\n" bodylines; 98 | } 99 | 100 | -------------------------------------------------------------------------------- /prime.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* prime.ml - Generate prime using miller-rabin primality test *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | module Unix=UnixLabels 26 | open Number.Infix 27 | 28 | (** returns random string with exactly bits. Highest order bit is 29 | always 1 *) 30 | let randbits rfunc nbits = 31 | let rval = 32 | let nbytes = nbits / 8 + (if nbits mod 8 = 0 then 0 else 1) in 33 | let rstring = Utils.random_string rfunc nbytes in 34 | let rand = Number.of_bytes rstring in 35 | let high = two **! (nbits - 1) in 36 | high +! (rand %! high) 37 | in 38 | assert (Number.nbits rval = nbits); 39 | rval 40 | 41 | (** chooses random int between 0 and high-1 *) 42 | let rec randint rfunc high = 43 | let nbits = Number.nbits high in 44 | let nbytes = nbits / 8 + (if nbits mod 8 = 0 then 0 else 1) in 45 | let rstring = Utils.random_string rfunc nbytes in 46 | let rand = Number.of_bytes rstring in 47 | rand %! high 48 | 49 | (** chooses random int between low and high-1 *) 50 | let randrange rfunc low high = 51 | low +! (randint rfunc (high -! low)) 52 | 53 | let zerobits n = 54 | let nbits = Number.nbits n in 55 | let rec loop count = 56 | if count >= nbits 57 | then failwith ("Prime.zerobits: unexpected condition. " ^ 58 | "Argument may have been zero"); 59 | if Number.nth_bit n count 60 | then count 61 | else loop (count + 1) 62 | in 63 | loop 0 64 | 65 | let decompose n = 66 | let s = zerobits n in 67 | let r = n /! two **! s in 68 | assert ((two **! s) *! r =! n); 69 | assert(Number.nth_bit r 0); 70 | (s,r) 71 | 72 | type result = Prime | Composite 73 | 74 | let rec test_loop test m = 75 | if m = 0 then true 76 | else 77 | match test () with 78 | Prime -> test_loop test (m - 1) 79 | | Composite -> false 80 | 81 | 82 | (** miller-rabin primality test *) 83 | let miller_rabin rfunc n t = 84 | let (s,r) = decompose (n -! one) in 85 | let neg_one = n -! one in 86 | 87 | let test () = 88 | let a = randrange rfunc two (n -! one) in 89 | let y = Number.powmod a r n in 90 | if y =! one || y =! neg_one then Prime 91 | else 92 | let rec loop y j = 93 | if y =! neg_one then Prime 94 | else if j = s then Composite 95 | else 96 | let y = Number.squaremod y n in 97 | if y =! one then Composite 98 | else loop y (j + 1) 99 | in 100 | loop y 1 101 | 102 | in 103 | test_loop test t 104 | 105 | 106 | let rec randprime rfunc ~bits ~error:t = 107 | let guess = randbits rfunc bits in 108 | let guess = (* force oddness *) 109 | if guess %! two =! zero 110 | then guess +! one else guess 111 | in 112 | if miller_rabin rfunc guess t 113 | then guess 114 | else randprime rfunc ~bits ~error:t 115 | 116 | 117 | -------------------------------------------------------------------------------- /incdump.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* incdump.ml - creates keydump consisting of recently added keys *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* Copyright (C) 2004 Peter Palfrader *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | open Printf 27 | open Common 28 | open Packet 29 | module Set = PSet.Set 30 | 31 | let settings = { 32 | Keydb.withtxn = !Settings.transactions; 33 | Keydb.cache_bytes = !Settings.cache_bytes; 34 | Keydb.pagesize = !Settings.pagesize; 35 | Keydb.keyid_pagesize = !Settings.keyid_pagesize; 36 | Keydb.meta_pagesize = !Settings.meta_pagesize; 37 | Keydb.subkeyid_pagesize = !Settings.subkeyid_pagesize; 38 | Keydb.time_pagesize = !Settings.time_pagesize; 39 | Keydb.tqueue_pagesize = !Settings.tqueue_pagesize; 40 | Keydb.word_pagesize = !Settings.word_pagesize; 41 | Keydb.dbdir = Lazy.force Settings.dbdir; 42 | Keydb.dumpdir = Lazy.force Settings.dumpdir; 43 | } 44 | 45 | module Keydb = Keydb.Unsafe 46 | 47 | let dump_database timestamp fname = 48 | let maxsize = 250_000 in 49 | let log = Keydb.reverse_logquery ~maxsize timestamp in 50 | if List.length log = 0 then 51 | printf "No changes since timestamp\n" 52 | else 53 | let file = open_out fname in 54 | let run () = 55 | let newkeys = List.fold_left log ~init:Set.empty 56 | ~f:(fun set (_,change) -> match change with 57 | Add hash -> Set.add hash set 58 | | Delete hash -> Set.remove hash set) 59 | in 60 | printf "%d new keys in log.\n%!" (Set.cardinal newkeys); 61 | Set.iter newkeys 62 | ~f:(fun hash -> 63 | try 64 | let keystring = Keydb.get_keystring_by_hash hash in 65 | output_string file keystring; 66 | with 67 | e -> 68 | eprintf "Error fetching keystring from hash %s: %s\n%!" 69 | (Utils.hexstring hash) 70 | (Printexc.to_string e) 71 | ) 72 | in 73 | protect ~f:run ~finally:(fun () -> close_out file) 74 | 75 | let run () = 76 | List.iter !Settings.anonlist 77 | ~f:(fun x -> printf "\"%s\" " x); 78 | printf "\n%!"; 79 | match !Settings.anonlist with 80 | | timestamp::tl -> 81 | let name = match tl with 82 | | [] -> "incdump.pgp" 83 | | [name] -> name 84 | | _ -> raise (Argument_error "too many arguments") 85 | in 86 | printf "saving to file %s\n%!" name; 87 | set_logfile "incdump"; 88 | perror "Running SKS %s%s" Common.version Common.version_suffix; 89 | Keydb.open_dbs settings; 90 | protect ~f:(fun () -> 91 | let timestamp = float_of_string timestamp in 92 | dump_database timestamp name ) 93 | ~finally:(fun () -> Keydb.close_dbs ()) 94 | 95 | | _ -> 96 | raise (Argument_error "no timestamp provided") 97 | 98 | -------------------------------------------------------------------------------- /sendmail.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* sendmail.ml - Simple (& likely incomplete) interface for sending *) 3 | (* mail *) 4 | (* *) 5 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 6 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 7 | (* *) 8 | (* This file is part of SKS. SKS is free software; you can *) 9 | (* redistribute it and/or modify it under the terms of the GNU General *) 10 | (* Public License as published by the Free Software Foundation; either *) 11 | (* version 2 of the License, or (at your option) any later version. *) 12 | (* *) 13 | (* This program is distributed in the hope that it will be useful, but *) 14 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 15 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 16 | (* General Public License for more details. *) 17 | (* *) 18 | (* You should have received a copy of the GNU General Public License *) 19 | (* along with this program; if not, write to the Free Software *) 20 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 21 | (* USA or see . *) 22 | (***********************************************************************) 23 | 24 | open StdLabels 25 | open MoreLabels 26 | open Common 27 | open Printf 28 | 29 | module Map = PMap.Map 30 | module Set = PSet.Set 31 | 32 | type msg = { headers: (string * string) list; 33 | body: string; 34 | } 35 | 36 | let process_status_to_string ps = 37 | let (name,code) = match ps with 38 | Unix.WEXITED n -> ("Exited",n) 39 | | Unix.WSIGNALED n -> ("Signaled",n) 40 | | Unix.WSTOPPED n -> ("Stopped",n) 41 | in 42 | sprintf "%s(%d)" name code 43 | 44 | exception Unwrap_failure 45 | let unwrap x = match x with 46 | None -> raise Unwrap_failure 47 | | Some x -> x 48 | 49 | 50 | (** Invokes sendmail and sends the argument to sendmail via stdin *) 51 | let send_text text = 52 | let cout = Unix.open_process_out !Settings.sendmail_cmd in 53 | let status = ref None in 54 | protect ~f:(fun () -> output_string cout text) 55 | ~finally:(fun () -> status := Some (Unix.close_process_out cout)); 56 | if unwrap !status <> Unix.WEXITED 0 then 57 | failwith (sprintf "Sendmail.send_text failed: %s" 58 | (process_status_to_string (unwrap !status))) 59 | else () 60 | 61 | (** converts message to string ready for sending via you favoriate 62 | MTA *) 63 | let msg_to_string msg = 64 | let header_lines = 65 | List.map ~f:(fun (field,entry) -> 66 | if field = "" then sprintf "\t%s\n" entry 67 | else sprintf "%s: %s\n" field entry) 68 | msg.headers 69 | in 70 | let header = String.concat ~sep:"" header_lines in 71 | header ^ "\n" ^ msg.body 72 | 73 | 74 | (** Sends the given message *) 75 | let send msg = send_text (msg_to_string msg) 76 | 77 | (** removes the continuation of the headers, where a continuation is defined 78 | to be an initial sequence of headers with empty field names 79 | *) 80 | let rec remove_continuation headers = match headers with 81 | [] -> [] 82 | | ("",entry)::tl -> 83 | remove_continuation tl 84 | | headers -> headers 85 | 86 | 87 | let rec filter_headers_from_headers headers fields = match headers with 88 | | [] -> [] 89 | | (("",contents) as hd)::tl -> 90 | hd::(filter_headers_from_headers tl fields) 91 | | ((field,contents) as hd)::tl -> 92 | if Set.mem (Utils.lowercase field) fields then 93 | hd::(filter_headers_from_headers tl fields) 94 | else 95 | filter_headers_from_headers (remove_continuation tl) 96 | fields 97 | 98 | let filter_headers msg fields = 99 | let fields = Set.of_list (List.map ~f:Utils.lowercase fields) in 100 | { msg with 101 | headers = filter_headers_from_headers msg.headers fields 102 | } 103 | 104 | let add_headers msg headers = 105 | { msg with headers = headers @ msg.headers } 106 | 107 | let get_body msg = msg.body 108 | let get_headers msg = msg.headers 109 | -------------------------------------------------------------------------------- /tester.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* tester.ml *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | open Printf 26 | open Common 27 | open Packet 28 | open DbMessages 29 | 30 | let settings = { 31 | Keydb.withtxn = !Settings.transactions; 32 | Keydb.cache_bytes = !Settings.cache_bytes; 33 | Keydb.pagesize = !Settings.pagesize; 34 | Keydb.keyid_pagesize = !Settings.keyid_pagesize; 35 | Keydb.meta_pagesize = !Settings.meta_pagesize; 36 | Keydb.subkeyid_pagesize = !Settings.subkeyid_pagesize; 37 | Keydb.time_pagesize = !Settings.time_pagesize; 38 | Keydb.tqueue_pagesize = !Settings.tqueue_pagesize; 39 | Keydb.word_pagesize = !Settings.word_pagesize; 40 | Keydb.dbdir = Lazy.force Settings.dbdir; 41 | Keydb.dumpdir = Lazy.force Settings.dumpdir; 42 | } 43 | 44 | module Keydb = Keydb.Safe 45 | 46 | 47 | let send_msg addr msg = 48 | let s = Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in 49 | protect ~f:( fun () -> 50 | Unix.connect s addr; 51 | let cin = Channel.sys_in_from_fd s 52 | and cout = Channel.sys_out_from_fd s in 53 | marshal cout msg; 54 | let reply = unmarshal cin in 55 | printf "Reply received: %s\n" (msg_to_string reply.msg); 56 | reply 57 | ) 58 | ~finally:(fun () -> Unix.close s) 59 | 60 | let send_msg_noreply addr msg = 61 | let s = Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in 62 | protect ~f:(fun () -> 63 | Unix.connect s addr; 64 | let cout = Channel.sys_out_from_fd s in 65 | marshal cout msg 66 | ) 67 | ~finally:(fun () -> Unix.close s) 68 | 69 | 70 | let print_key key = 71 | let ids = Key.get_ids key in 72 | List.iter ~f:(printf "%s | ") ids; 73 | print_newline () 74 | 75 | let word_query addr string = 76 | let words = Utils.extract_words string in 77 | let reply = send_msg addr (WordQuery words) in 78 | match reply.msg with 79 | | Keys keys -> 80 | List.iter ~f:print_key keys; 81 | printf "\n-------------------\n" 82 | | _ -> 83 | printf "Unexpected response\n"; flush stdout 84 | 85 | let rec is_sorted list = match list with 86 | [] -> true 87 | | hd::[] -> true 88 | | hd1::hd2::tl -> hd2 > hd1 && is_sorted (hd2::tl) 89 | 90 | let rec last list = match list with 91 | [] -> raise Not_found 92 | | hd::[] -> hd 93 | | hd::tl -> last tl 94 | 95 | let get_log addr ts = 96 | let resp = send_msg addr (LogQuery ts) in 97 | match resp.msg with 98 | LogResp log -> log 99 | | _ -> failwith "Unexpected response" 100 | 101 | let ts pair = fst pair 102 | 103 | let first log = List.hd log 104 | let first_ts log = ts (first log) 105 | 106 | let last_ts log = 107 | let (ts,hash) = last log in 108 | ts 109 | 110 | (* 111 | let rec get_all ts accum = 112 | let hashes = send_msg (LogQuery ts) 113 | 114 | *) 115 | -------------------------------------------------------------------------------- /fqueue.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* fqueue.ml - Simple implementation of a polymorphic functional queue *) 3 | (* *) 4 | (* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *) 5 | (* 2011, 2012, 2013 Yaron Minsky and Contributors *) 6 | (* *) 7 | (* This file is part of SKS. SKS is free software; you can *) 8 | (* redistribute it and/or modify it under the terms of the GNU General *) 9 | (* Public License as published by the Free Software Foundation; either *) 10 | (* version 2 of the License, or (at your option) any later version. *) 11 | (* *) 12 | (* This program is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 15 | (* General Public License for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU General Public License *) 18 | (* along with this program; if not, write to the Free Software *) 19 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 20 | (* USA or see . *) 21 | (***********************************************************************) 22 | 23 | open StdLabels 24 | open MoreLabels 25 | module Unix=UnixLabels 26 | 27 | 28 | (** push and top are O(1). 29 | pop and take are O(1) amortized. 30 | to_list and length are O(n). 31 | *) 32 | 33 | (* Invariant: 34 | if queue is not empty, outlist is not empty 35 | queue.length = List.length(queue.outlist) + List.length(queue.inlist)*) 36 | 37 | exception Empty 38 | 39 | type 'a t = { inlist: 'a list; 40 | outlist: 'a list; 41 | length: int; 42 | } 43 | 44 | (*****************************************) 45 | 46 | (* 47 | let test_invariants queue = 48 | assert 49 | begin 50 | queue.length = (List.length queue.outlist) + (List.length queue.inlist) 51 | end; 52 | assert 53 | begin 54 | (queue.length = 0) || List.length queue.outlist > 0 55 | end 56 | *) 57 | 58 | let empty = { inlist = []; 59 | outlist = []; 60 | length = 0; 61 | } 62 | 63 | (*****************************************) 64 | 65 | let push el queue = 66 | if queue.outlist = [] then 67 | let outlist = List.rev (el::queue.inlist) 68 | in { inlist = []; 69 | outlist = outlist; 70 | length = queue.length + 1; 71 | } 72 | else 73 | { inlist = el::queue.inlist; 74 | outlist = queue.outlist; 75 | length = queue.length + 1; 76 | } 77 | 78 | let enq = push 79 | (*****************************************) 80 | 81 | let top queue = 82 | match queue.outlist with 83 | [] -> (if queue.inlist != [] 84 | then failwith "FQueue.top: BUG. inlist should be empty but isn't" 85 | else raise Empty) 86 | | hd::tl -> hd 87 | 88 | (*****************************************) 89 | 90 | let pop queue = match queue.outlist with 91 | hd::[] -> (hd, { inlist = []; 92 | outlist = (List.rev queue.inlist); 93 | length = queue.length - 1}) 94 | | hd::tl -> (hd, { inlist = queue.inlist; 95 | outlist = tl; 96 | length = queue.length - 1;}) 97 | | [] -> 98 | if queue.inlist = [] 99 | then raise Empty 100 | else (match List.rev queue.inlist with 101 | [] -> failwith "FQueue.top: BUG. inlist should not be empty here" 102 | | hd::tl -> (hd, { inlist=[]; 103 | outlist=tl; 104 | length = queue.length - 1; 105 | })) 106 | 107 | (*****************************************) 108 | 109 | let discard queue = 110 | let (el,new_q) = pop queue in 111 | new_q 112 | 113 | let deq = pop 114 | 115 | (*****************************************) 116 | 117 | let to_list queue = 118 | queue.inlist @ (List.rev (queue.outlist)) 119 | 120 | (*****************************************) 121 | 122 | let length queue = queue.length 123 | 124 | let is_empty queue = queue.length = 0 125 | --------------------------------------------------------------------------------