# # # add_file "schema_lexer.mll" # content [ed61256b28d1710d45787fce7b236f43759f6676] # # patch "Makefile" # from [4953ad0d3666c65f98633ed9b791b55d54048521] # to [a17e94ff0a8cfc06ea9cdb256cad9dd608264861] # # patch "database.ml" # from [aafe016319ec50a33b17e0aa6ee9c365e7d24a45] # to [8050fdf19eecbfea0acd1b5f5db5bd6ace5967f4] # # patch "mlsqlite/sqlite3.ml" # from [1bab996441c6aa8dc1e528681d6dcdc89d928f42] # to [53295e5f3023a4343a9708c102aa6622e12633fb] # # patch "viz_misc.ml" # from [e4da8d228a71dca79261bf14be9db15399c6de74] # to [6fd0c3f159b19117f0baf4570c3cec8b0a24aedc] # # patch "viz_misc.mli" # from [05b0d6067400240a80ed825580a60e65346b8b5e] # to [0cfad473122dc2494c4886ebf8ec3d362ef7ea5a] # ============================================================ --- schema_lexer.mll ed61256b28d1710d45787fce7b236f43759f6676 +++ schema_lexer.mll ed61256b28d1710d45787fce7b236f43759f6676 @@ -0,0 +1,24 @@ + +let ws = [' ''\r''\n''\t']+ +let sep = ['('')'','';'] +let token = [^ ' ''\r''\n''\t''('')'','';']+ + +rule lex = parse + | ws { lex lexbuf } + | sep { Lexing.lexeme lexbuf } + | token { Lexing.lexeme lexbuf } + | eof { raise End_of_file } + +{ + let massage_sql_tokens s = + let l = ref [] in + begin + try + let lb = Lexing.from_string s in + while true do + l := (lex lb) :: !l + done + with End_of_file -> () + end ; + String.concat " " (List.rev !l) +} ============================================================ --- Makefile 4953ad0d3666c65f98633ed9b791b55d54048521 +++ Makefile a17e94ff0a8cfc06ea9cdb256cad9dd608264861 @@ -19,7 +19,7 @@ dot_lexer.ml dot_parser.ml dot_parser.mli \ revision_types.mli revision_lexer.ml revision_parser.ml revision_parser.mli \ subprocess.ml subprocess.mli \ - components.ml \ + components.ml schema_lexer.ml \ database.ml database.mli agraph.ml agraph.mli \ autocolor.ml autocolor.mli viz_style.ml viz_style.mli \ icon.ml ui.ml ui.mli unidiff.ml unidiff.mli \ @@ -43,7 +43,7 @@ dot_types.mli dot_lexer.mll dot_parser.mly \ subprocess.ml subprocess.mli icon.ml ui.ml ui.mli \ revision_types.mli revision_lexer.mll revision_parser.mly \ - components.ml database.ml database.mli agraph.ml agraph.mli \ + components.ml schema_lexer.mll database.ml database.mli agraph.ml agraph.mli \ unidiff.ml unidiff.mli gnomecanvas_hack.c view.ml view.mli \ query.ml query.mli app.mli app.ml main.ml \ mlsqlite/sqlite3.ml mlsqlite/sqlite3.mli mlsqlite/ocaml-sqlite3.c \ ============================================================ --- database.ml aafe016319ec50a33b17e0aa6ee9c365e7d24a45 +++ database.ml 8050fdf19eecbfea0acd1b5f5db5bd6ace5967f4 @@ -9,39 +9,64 @@ let sql_escape s = String.concat "''" (string_split ~collapse:false '\'' s) -let register_base64_functions db = +let may_decode base64 v = + if base64 then monot_decode v else v + +let acc_one_col base64 acc row = + may_decode base64 row.(0) :: acc + + + +let setup_sqlite db = if Viz_misc.debug "sql" then Sqlite3.trace_set db (fun s -> prerr_string "### sql: " ; prerr_endline s) ; - Sqlite3.exec db "PRAGMA temp_store = MEMORY" ; - Sqlite3.create_fun_1 db "unbase64" (fun s -> `TEXT (monot_decode (Sqlite3.value_text s))) + Sqlite3.exec db "PRAGMA temp_store = MEMORY" +let schema_id db = + let lines = + Sqlite3.fetch + db + "SELECT sql FROM sqlite_master \ + WHERE (type = 'table' OR type = 'index') \ + AND sql IS NOT NULL \ + AND name NOT LIKE 'sqlite_stat%' \ + ORDER BY name" + (acc_one_col false) [] in + let schema_data = String.concat "\n" (List.rev lines) in + let schema = Schema_lexer.massage_sql_tokens schema_data in + Viz_misc.hex_enc (Crypto.sha1 schema) + let has_rosters db = Sqlite3.fetch db "SELECT name FROM sqlite_master WHERE name = 'rosters'" (fun _ _ -> true) false -let fetch_pubkeys db tbl = +let uses_base64 rosters schema_id = + not rosters || schema_id = "1db80c7cee8fa966913db1a463ed50bf1b0e5b0e" + +let fetch_pubkeys db base64 tbl = Sqlite3.fetch db "SELECT id, keydata, ROWID FROM public_keys" (fun () -> function | [| id; data; rowid |] -> begin try - let key = Crypto.decode_rsa_pubkey (monot_decode data) in + let data = may_decode base64 data in + let key = Crypto.decode_rsa_pubkey data in Hashtbl.add tbl id (key, int_of_string rowid - 1) with Failure _ -> () end | _ -> ()) () -let fetch_branches db = +let fetch_branches base64 db = List.sort compare (Sqlite3.fetch db "SELECT DISTINCT value FROM revision_certs WHERE name = 'branch'" - (fun acc row -> monot_decode row.(0) :: acc) + (acc_one_col base64) []) let view_name_domain = "ids_of_branch" @@ -215,14 +240,14 @@ agraph -let encode_quote s = - let enc = monot_encode s in - let l = String.length enc in - let o = String.make (l + 2) '\'' in - String.blit enc 0 o 1 l ; - o +let encode_quote base64 s = + if base64 + then + String.concat "" [ "\'" ; monot_encode s ; "\'" ] + else + String.concat "" [ "X\'" ; Viz_misc.hex_enc s ; "\'" ] -let fetch_with_view query db f = +let fetch_with_view query base64 db f = let (query_domain, query_limit) = query in let register_date_p () = @@ -230,7 +255,10 @@ | QUERY_BETWEEN (d1, d2) -> Sqlite3.create_fun_1 db "date_p" (fun arg -> - let d = monot_decode (Sqlite3.value_text arg) in + let d = + if base64 + then monot_decode (Sqlite3.value_text arg) + else Sqlite3.value_blob arg in sql_of_bool (d1 <= d && d <= d2)) | _ -> () in @@ -246,7 +274,7 @@ WHERE name = 'branch' AND value IN (%s)" view_name_domain (String.concat ", " - (List.map encode_quote q)) in + (List.map (encode_quote base64) q)) in let view_query_date_limit () = Printf.sprintf @@ -279,8 +307,8 @@ Sqlite3.exec_f db "DROP TABLE %s" view_name_domain) () -let fetch_agraph query db = - try fetch_with_view query db fetch_agraph_with_view +let fetch_agraph query base64 db = + try fetch_with_view query base64 db fetch_agraph_with_view with exn -> Printf.eprintf "fetch_agraph exn: %s\n%!" (Printexc.to_string exn) ; @@ -294,13 +322,13 @@ revision_parser Revision_lexer.lex (Lexing.from_string - (Unzip.inflate_str ~kind:Unzip.GZip (monot_decode s))) + (Unzip.inflate_str ~kind:Unzip.GZip s)) -let fetch_revision_set rostered db id = +let fetch_revision_set rostered b64 db id = decode_and_parse_revision rostered (List.hd - (Sqlite3.fetch_f db (fun acc row -> row.(0) :: acc) [] + (Sqlite3.fetch_f db (acc_one_col b64) [] "SELECT data FROM revisions WHERE id = '%s'" id)) let verify_cert_sig pubkeys keypair name id v signature = @@ -313,10 +341,10 @@ else SIG_BAD with Not_found -> SIG_UNKNOWN -let process_certs pubkeys acc = function +let process_certs pubkeys b64 acc = function | [| id; name; v; keypair; signature |] -> - let dec_v = monot_decode v in - let dec_sig = monot_decode signature in + let dec_v = may_decode b64 v in + let dec_sig = may_decode b64 signature in { c_id = id ; c_name = name ; c_value = dec_v ; @@ -324,8 +352,8 @@ c_signature = verify_cert_sig pubkeys keypair name id dec_v dec_sig } :: acc | _ -> acc -let fetch_certs db pubkeys id = - Sqlite3.fetch_f db (process_certs pubkeys) [] +let fetch_certs db pubkeys b64 id = + Sqlite3.fetch_f db (process_certs pubkeys b64) [] "SELECT id, name, value, keypair, signature \ FROM revision_certs WHERE id = '%s'" id @@ -344,17 +372,18 @@ (fun acc stmt -> let v = Sqlite3.column_text stmt 0 in match kind with - | `SIGNER -> v :: acc - | `VALUE -> monot_decode v :: acc) + | `SIGNER + | `VALUE -> v :: acc + | `VALUE_B64 -> monot_decode v :: acc) [] stmt -let get_matching_cert db name p = +let get_matching_cert db b64 name p = List.rev (Sqlite3.fetch_f db (fun acc -> function | [| id; v |] -> - let dv = monot_decode v in + let dv = may_decode b64 v in if p dv then (id, dv) :: acc else acc @@ -396,11 +425,13 @@ type t = { - filename : string ; - db : Sqlite3.db ; - pubkeys : (string, Crypto.pub_rsa_key * int) Hashtbl.t ; - stmts : Sqlite3.stmt array ; - mutable rostered : bool ; + filename : string ; + db : Sqlite3.db ; + pubkeys : (string, Crypto.pub_rsa_key * int) Hashtbl.t ; + stmts : Sqlite3.stmt array ; + rostered : bool ; + base64 : bool ; + schema_id : string } @@ -422,18 +453,23 @@ let pubkeys = Hashtbl.create 17 in let stmts = [| prepare_fetch_one_cert_signer db ; prepare_fetch_one_cert_value db |] in - let v = { - filename = fname ; - db = db ; - pubkeys = pubkeys ; - stmts = stmts ; - rostered = false } in - sqlite_try (fun db -> - register_base64_functions db ; - fetch_pubkeys db pubkeys ; - v.rostered <- has_rosters db) - v ; - v + try + setup_sqlite db ; + let rostered = has_rosters db in + let schema = schema_id db in + let base64 = uses_base64 rostered schema in + fetch_pubkeys db base64 pubkeys ; + { filename = fname ; + db = db ; + pubkeys = pubkeys ; + stmts = stmts ; + rostered = rostered ; + base64 = base64 ; + schema_id = schema + } + with Sqlite3.Error (_, msg) -> + Sqlite3.close_db db ; + Viz_types.errorf "Error processing database %s:\n%s" fname msg let close_db { db = db ; stmts = stmts } = Sqlite3.close_db db @@ -446,16 +482,16 @@ let get_filename d = d.filename let fetch_branches db = - sqlite_try fetch_branches db + sqlite_try (fetch_branches db.base64) db let fetch_ancestry_graph db query = - sqlite_try (fetch_agraph query) db + sqlite_try (fetch_agraph query db.base64) db let fetch_revision d id = try let revision_set = sqlite_try (fun db -> - fetch_revision_set d.rostered db id) + fetch_revision_set d.rostered d.base64 db id) d in let (manifest_id, edges) = revision_set in { revision_id = id ; @@ -472,27 +508,28 @@ { (fetch_revision d id) with certs = sqlite_try (fun db -> - fetch_certs db d.pubkeys id) d } + fetch_certs db d.pubkeys d.base64 id) d } let fetch_cert_signer db id name = sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(0) id name `SIGNER) db let fetch_cert_value db id name = - sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(1) id name `VALUE) db + let kind = if db.base64 then `VALUE_B64 else `VALUE in + sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(1) id name kind) db let get_key_rowid { pubkeys = pubkeys } id = let (_, rowid) = Hashtbl.find pubkeys id in rowid let get_matching_tags db p = - get_matching_cert db.db "tag" p + get_matching_cert db.db db.base64 "tag" p let get_matching_dates db d_pref = - get_matching_cert db.db "date" + get_matching_cert db.db db.base64 "date" (string_is_prefix d_pref) let get_matching_ids db id_pref = - get_matching_cert db.db "branch" + get_matching_cert db.db db.base64 "branch" (string_is_prefix id_pref) let run_monotone_diff db monotone_exe status cb (old_id, new_id) = ============================================================ --- mlsqlite/sqlite3.ml 1bab996441c6aa8dc1e528681d6dcdc89d928f42 +++ mlsqlite/sqlite3.ml 53295e5f3023a4343a9708c102aa6622e12633fb @@ -259,7 +259,7 @@ let row = Array.init (data_count stmt) - (column_text stmt) in + (column_blob stmt) in f acc row) init stmt ============================================================ --- viz_misc.ml e4da8d228a71dca79261bf14be9db15399c6de74 +++ viz_misc.ml 6fd0c3f159b19117f0baf4570c3cec8b0a24aedc @@ -178,6 +178,23 @@ o *) +let char_of_hex v = + if v < 0xa + then Char.chr (v + Char.code '0') + else Char.chr (v - 0xa + Char.code 'a') + +let hex_enc s = + let len = String.length s in + let o = String.create (2 * len) in + for i = 0 to len - 1 do + let c = int_of_char s.[i] in + let hi = c lsr 4 in + o.[2*i] <- char_of_hex hi ; + let lo = c land 0xf in + o.[2*i + 1] <- char_of_hex lo + done ; + o + let make_cache g = let tbl = Hashtbl.create 17 in fun k -> ============================================================ --- viz_misc.mli 05b0d6067400240a80ed825580a60e65346b8b5e +++ viz_misc.mli 0cfad473122dc2494c4886ebf8ec3d362ef7ea5a @@ -38,4 +38,6 @@ val connect : 'a t -> ('a -> unit) -> unit end +val hex_enc : string -> string + val make_cache : ('a -> 'b) -> 'a -> 'b