File: ptest.ml

package info (click to toggle)
sks 1.1.6-14
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,296 kB
  • sloc: ml: 15,228; ansic: 1,069; sh: 358; makefile: 347
file content (166 lines) | stat: -rw-r--r-- 5,345 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
(***********************************************************************)
(* ptest.ml                                                            *)
(*                                                                     *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(*               2011, 2012, 2013  Yaron Minsky and Contributors       *)
(*                                                                     *)
(* This file is part of SKS.  SKS is free software; you can            *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 of the License, or (at your option) any later version.    *)
(*                                                                     *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of          *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU   *)
(* General Public License for more details.                            *)
(*                                                                     *)
(* You should have received a copy of the GNU General Public License   *)
(* along with this program; if not, write to the Free Software         *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>.                          *)
(***********************************************************************)

open StdLabels
open MoreLabels
open Printf
open Common
open Packet
open Bdb

module Set = PSet.Set

module Keydb =
  Keydb.Make(struct
               let withtxn = !Settings.transactions
               and cache_bytes = !Settings.cache_bytes
               and pagesize = !Settings.pagesize
               and dbdir = !Settings.dbdir
               and dumpdir = !Settings.dumpdir
             end)

module PTreeDB =
  PTreeDB.Make(struct
                 let mbar = !Settings.mbar
                 and bitquantum = !Settings.bitquantum
                 and treetype = `ondisk
                 and max_nodes = !Settings.max_ptree_nodes
                 and dbdir = !Settings.ptree_dbdir
                 and cache_bytes = !Settings.ptree_cache_bytes
                 and pagesize = !Settings.ptree_pagesize
               end)
open PTreeDB

module PTree = PrefixTree

let () = PTreeDB.init ()
let () = Keydb.open_dbs ()
let ptree = PrefixTree.create ?db:(get_db ()) ~txn:None
              ~num_samples ~bitquantum
              ~thresh:(mbar * !Settings.ptree_thresh_mult) ()

let trunc s = String.sub ~pos:0 ~len:16 s


let i = ref 0
let get_ptree_hashes () =
  PTree.summarize_tree
    ~lagg:(fun set -> Array.map ~f:trunc
             (Array.of_list (Set.elements set)))
    ~cagg:(fun alist -> Array.concat (Array.to_list alist))
    ptree


let sstream_array_get size stream =
  match SStream.peek stream with
      None -> [| |]
    | Some first ->
        let array = Array.make size first in
        let ctr = ref 0 in
        let emptystream = ref false in
        while (!ctr < Array.length array &&
               not !emptystream )
        do
          match SStream.next stream with
              Some hash ->
                array.(!ctr) <- hash;
                incr ctr
            | None ->
                emptystream := true
        done;
        if !ctr <> Array.length array then
          Array.sub ~pos:0 ~len:!ctr array
        else
          array

let get_kdb_hashes () =
  let chunksize = 5000 in
  let (stream,close) = Keydb.create_hashstream () in
  let rec loop alist =
    let newarray = sstream_array_get chunksize stream in
    if newarray = [| |] then
      List.rev alist
    else
      loop (newarray::alist)
  in
  let alist = loop [] in
  let array = Array.concat alist in
  array


let is_sorted ~cmp array =
  let rec loop i =
    if i >= Array.length array - 1 then
      true
    else (
      if cmp array.(i+1)  array.(i) > 0 then loop (i+1)
      else false
    )
  in
  loop 0

(** compute the symmetric difference between two arrays
  sorted in increasing order
*)
let array_diff a1 a2 =
  let c1 = ref 0 and c2 = ref 0 in
  let diff1 = ref [] and diff2 = ref [] in

  let add1 () =
    diff1 := a1.(!c1)::!diff1;
    incr c1
  and add2 () =
    diff2 := a2.(!c2)::!diff2;
    incr c2
  in

  while !c1 < Array.length a1 || !c2 < Array.length a2 do
    if !c1 >= Array.length a1 then add2 ()
    else if !c2 >= Array.length a2 then add1 ()
    else if a1.(!c1) = a2.(!c2) then ( incr c1; incr c2; )
    else if a1.(!c1) < a2.(!c2) then add1 ()
    else add2 ()
  done;
  (List.rev !diff1,List.rev !diff2)


let () =
  if not !Sys.interactive then
    perror "Getting Keydb hashes";
    let khashes = get_kdb_hashes () in
    perror "Getting PTree hashes";
    let phashes = get_ptree_hashes () in
    perror "Comparing hashes";
    let (diff1,diff2) = array_diff phashes khashes in
    let (diff1,diff2) = (List.map ~f:KeyHash.hexify diff1,
                         List.map ~f:KeyHash.hexify diff2)
    in
    printf "Prefix side:\n";
    MList.print2 ~f:(printf "%s") diff1;
    printf "\n\nKeydb side:\n";
    MList.print2 ~f:(printf "%s") diff2;
    printf "\n"

let () =
  perror "Closing DBs";
  Keydb.close_dbs ();
  PTreeDB.closedb ()