# # # delete "revision_lexer.mll" # # delete "revision_parser.mly" # # delete "revision_types.mli" # # add_file "basic_io_lexer.mli" # content [35b059d07b02f9b50d82d4156180da2d72414849] # # add_file "basic_io_lexer.mll" # content [c2a66033259ea5a40cdc0bf4620ca5b661a62179] # # add_file "revision.ml" # content [7ebe36ea4f1c4b9a6f0e9660d32ba991995b116e] # # add_file "revision.mli" # content [c55251affdd8ab000599767b9e473cab8ad23b0b] # # patch "Makefile" # from [a541d9e779dd36da5fb40e6f6416e2bbe8b1209a] # to [e5432015d52a5be853627b2720e850a2ffc3118b] # # patch "database.ml" # from [50a5a35ff7dc8d9910fe824e9ff81b6d8afae95b] # to [8009b3ef665dc68c2dd896cd9fe88d603c1b045b] # # patch "database.mli" # from [bbe1dd977dd4df5d9b22a6a74ab79e8d7ad27f93] # to [a3da1f59cd5330dfc47c0ba6e854c75c19f83a6f] # # patch "main.ml" # from [4e7b15f2966740755d87d69522e02c1f47feefe9] # to [ce99c7ae5acc3bc348255ed12b1972fc4e3405a7] # # patch "monotone.ml" # from [4b6201bde7f13d46de89a3a297e36acfdc634a65] # to [e1b68e6da8d6dd8a5afc6253f4187d63f463d402] # # patch "monotone.mli" # from [411c0e2eb06c3c5b4627ff870ecb88e0cf32c7ee] # to [caa9158dd57c50f72973b68c33e2f00a6ef83ba0] # # patch "query.ml" # from [f691b2a902e28ebb9503a018f52a1634297b39ed] # to [1ba5f91fb7c65a662a9ae17af8a19edf6c318828] # # patch "ui.ml" # from [a1771efa0cc6a979a8436e99a43df62b74881081] # to [d87af029600a71eb22e88ecd31c17d788ceabba4] # # patch "view.ml" # from [41bf399ecc2067d9cf5e3cde7b0af3917309285a] # to [dbc7bbd981a1cc9a1b399ea544cb4eaf10b62676] # # patch "viz_types.ml" # from [000e61799446f6d11caad5379ca79c9ea6ff087e] # to [392de3299992cb0b698cc920941cf4ad6a87a78b] # # patch "viz_types.mli" # from [dcc5514fcad957dbccfe3b83c2878fe91dc605b0] # to [a26eeb13ea1ec9c013b24223091d747033070f0c] # ============================================================ --- basic_io_lexer.mli 35b059d07b02f9b50d82d4156180da2d72414849 +++ basic_io_lexer.mli 35b059d07b02f9b50d82d4156180da2d72414849 @@ -0,0 +1,8 @@ +type v = + | ID of string + | STRING of string +type stanza = (string * v) list +type t = stanza list + +val get_stanza : Lexing.lexbuf -> stanza option +val parse : Lexing.lexbuf -> t ============================================================ --- basic_io_lexer.mll c2a66033259ea5a40cdc0bf4620ca5b661a62179 +++ basic_io_lexer.mll c2a66033259ea5a40cdc0bf4620ca5b661a62179 @@ -0,0 +1,80 @@ +{ + type v = + | ID of string + | STRING of string + type stanza = (string * v) list + type t = stanza list + + let string_buffer = + Buffer.create 128 +} + +let id = ['a'-'f' '0'-'9']* +let ident = ['a'-'z' '_']+ +let ws = [' ' '\t']+ +let nl = [ '\n' ] + +rule lex = parse + | ws { lex lexbuf } + | ident as k { let v = lex_value lexbuf in + let _ = nl lexbuf in + `TOK (k, v) } + | nl { `END_OF_STANZA } + | eof { `EOF } + +and nl = parse + | ws { nl lexbuf } + | nl { () } + +and lex_value = parse + | ws { lex_value lexbuf } + | '[' (id as id) ']' { ID id } + | '"' { Buffer.clear string_buffer ; + STRING (string lexbuf) } + +and string = parse + | '"' { Buffer.contents string_buffer } + | '\\' ['"' '\\'] { Buffer.add_char + string_buffer + (Lexing.lexeme_char lexbuf 1) ; + string lexbuf } + | [^ '"' '\\']+ { let off = lexbuf.Lexing.lex_start_pos in + let len = lexbuf.Lexing.lex_curr_pos - off in + Buffer.add_substring + string_buffer + lexbuf.Lexing.lex_buffer + off len ; + string lexbuf } + +{ + let rec _get_stanza acc lb = + match lex lb with + | `TOK ((k, _) as v) -> + _get_stanza (v :: acc) lb + | `END_OF_STANZA when acc = [] -> + _get_stanza acc lb + | `EOF + | `END_OF_STANZA as e -> + e, List.rev acc + + let get_stanza lb = + match _get_stanza [] lb with + | `EOF, [] -> + None + | _, st -> + Some st + + let rec _parse acc lb = + match _get_stanza [] lb with + | `EOF, [] -> + List.rev acc + | `EOF, st -> + List.rev (st :: acc) + | `END_OF_STANZA, st -> + assert (st <> []) ; + _parse (st :: acc) lb + + let parse lb = + _parse [] lb +} + ============================================================ --- revision.ml 7ebe36ea4f1c4b9a6f0e9660d32ba991995b116e +++ revision.ml 7ebe36ea4f1c4b9a6f0e9660d32ba991995b116e @@ -0,0 +1,89 @@ + +type change = + | DELETE of string + | RENAME of string * string + | ADD_DIR of string + | ADD_FILE of string * string + | PATCH of string * string * string + | ATTR_CLEAR of string * string + | ATTR_SET of string * string * string + +type edge = { + old_revision : string ; + change_set : change list ; + } + +type t = string * edge list + + +type tok = Basic_io_lexer.v = + | ID of string + | STRING of string + + +let rec _star acc p = parser + | [< v = p ; nxt >] -> _star (v :: acc) p nxt + | [<>] -> acc + + +let format = parser + | [< ' [ "format_version", STRING "1" ] >] -> + () +let new_manifest = parser + | [< ' [ "new_manifest", ID id ] >] -> + id + +let delete = parser + | [< ' [ "delete", STRING p ] >] -> + DELETE p +let rename = parser + | [< ' [ "rename", STRING p ; + "to", STRING np ] >] -> + RENAME (p, np) +let add_dir = parser + | [< ' [ "add_dir", STRING p ] >] -> + ADD_DIR p +let add_file = parser + | [< ' [ "add_file", STRING p ; + "content", ID id ] >] -> + ADD_FILE (p, id) +let patch = parser + | [< ' [ "patch", STRING p ; + "from", ID id1 ; + "to", ID id2 ] >] -> + PATCH (p, id1, id2) +let clear = parser + | [< ' [ "clear", STRING p ; + "attr", STRING a ] >] -> + ATTR_CLEAR (p, a) +let set = parser + | [< ' [ "set", STRING p ; + "attr", STRING a ; + "value", STRING v ] >] -> + ATTR_SET (p, a, v) +let change_set = parser + | [< cs = _star [] delete ; + cs = _star cs rename ; + cs = _star cs add_dir ; + cs = _star cs add_file ; + cs = _star cs patch ; + cs = _star cs clear ; + cs = _star cs set >] -> List.rev cs + +let edge = parser + | [< ' [ "old_revision", ID id ] ; cs = change_set >] -> + { old_revision = id ; change_set = cs } + + +let revision = parser + | [< () = format ; + manifest = new_manifest ; + edges = _star [] edge >] -> + manifest, List.rev edges + + +let revision_set lb = + let strm = + Stream.from + (fun _ -> Basic_io_lexer.get_stanza lb) in + revision strm ============================================================ --- revision.mli c55251affdd8ab000599767b9e473cab8ad23b0b +++ revision.mli c55251affdd8ab000599767b9e473cab8ad23b0b @@ -0,0 +1,17 @@ +type change = + | DELETE of string + | RENAME of string * string + | ADD_DIR of string + | ADD_FILE of string * string + | PATCH of string * string * string + | ATTR_CLEAR of string * string + | ATTR_SET of string * string * string + +type edge = { + old_revision : string ; + change_set : change list ; + } + +type t = string * edge list + +val revision_set : Lexing.lexbuf -> t ============================================================ --- Makefile a541d9e779dd36da5fb40e6f6416e2bbe8b1209a +++ Makefile e5432015d52a5be853627b2720e850a2ffc3118b @@ -19,7 +19,7 @@ SRC = $(OCAMLNET)/base64.ml $(OCAMLNET)/ viz_misc.ml viz_misc.mli viz_types.ml viz_types.mli \ q.ml q.mli \ dot_lexer.ml dot_parser.ml dot_parser.mli \ - revision_types.mli revision_lexer.ml revision_parser.ml revision_parser.mli \ + basic_io_lexer.mli basic_io_lexer.ml revision.mli revision.ml \ subprocess.ml subprocess.mli \ components.ml schema_lexer.ml \ automate.mli automate.ml monotone.mli monotone.ml \ @@ -34,7 +34,7 @@ C_OBJ = mlsqlite/ocaml-sqlite3.o \ crypto/ocaml-openssl.o \ gnomecanvas_hack.o -USE_P4 = viz_style.ml +USE_P4 = viz_style.ml revision.ml OBJ = $(patsubst %.ml,%.cmo,$(filter %.ml, $(SRC))) OBJX = $(patsubst %.ml,%.cmx,$(filter %.ml, $(SRC))) @@ -45,8 +45,10 @@ DISTSRC = Makefile configure.ac config.m autocolor.ml autocolor.mli viz_style.ml viz_style.mli \ 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 schema_lexer.mll database.ml database.mli agraph.ml agraph.mli \ + basic_io_lexer.mll basic_io_lexer.mli revision.mli revision.ml \ + components.ml schema_lexer.mll \ + monotone.mli monotone.ml \ + 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 \ ============================================================ --- database.ml 50a5a35ff7dc8d9910fe824e9ff81b6d8afae95b +++ database.ml 8009b3ef665dc68c2dd896cd9fe88d603c1b045b @@ -369,24 +369,6 @@ let fetch_agraph query base64 db = (Printexc.to_string exn) ; raise exn -let decode_and_parse_revision rostered s = - let revision_parser = - if rostered - then Revision_parser.revision_set - else Revision_parser.pre_rosters_revision_set in - revision_parser - Revision_lexer.lex - (Lexing.from_string - (Unzip.inflate_str ~kind:Unzip.GZip s)) - -let fetch_revision_set rostered b64 db id = - decode_and_parse_revision - rostered - (List.hd - (Sqlite3.fetch_v db - "SELECT data FROM revisions WHERE id = ?" [`TEXT id] - (acc_one_col b64) [])) - let verify_cert_sig pubkeys keypair name id v signature = try let (pubkey, _) = Hashtbl.find pubkeys keypair in @@ -547,29 +529,6 @@ let fetch_ancestry_graph db query = let fetch_ancestry_graph db query = 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 d.base64 db id) - d in - let (manifest_id, edges) = revision_set in - { revision_id = id ; - manifest_id = manifest_id ; - revision_set = - List.map - (fun e -> (e.Revision_types.old_revision, e.Revision_types.change_set) ) - edges ; - certs = [] } - with Parsing.Parse_error -> - Viz_types.errorf "Error while parsing revision set of %s" id - -let fetch_certs_and_revision d id = - { (fetch_revision d id) - with certs = - sqlite_try (fun db -> - 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 ============================================================ --- database.mli bbe1dd977dd4df5d9b22a6a74ab79e8d7ad27f93 +++ database.mli a3da1f59cd5330dfc47c0ba6e854c75c19f83a6f @@ -12,8 +12,6 @@ val fetch_ancestry_graph : t -> query -> val get_filename : t -> string val fetch_ancestry_graph : t -> query -> agraph -val fetch_revision : t -> string -> node_data -val fetch_certs_and_revision : t -> string -> node_data val fetch_cert_signer : t -> string -> string -> string list val fetch_cert_value : t -> string -> string -> string list ============================================================ --- main.ml 4e7b15f2966740755d87d69522e02c1f47feefe9 +++ main.ml ce99c7ae5acc3bc348255ed12b1972fc4e3405a7 @@ -6,15 +6,6 @@ type mtn_options = | MTNopt_branch of string * string | MTNopt_full of string * string * string -let unquote s = - if s.[0] = '"' - then - let len = String.length s in - Revision_lexer.string - (Buffer.create len) - (Lexing.from_string (String.sub s 1 (len - 1))) - else s - let find_MTN_dir base = let rec up = function | "/" -> raise Not_found @@ -34,17 +25,18 @@ let parse_MTN_options mtn_file = let parse_MTN_options mtn_file = - let lines = - try with_file_in input_lines (mtn_file "options") + let stanzas = + try + with_file_in + (fun ic -> Basic_io_lexer.parse (Lexing.from_channel ic)) + (mtn_file "options") with Not_found | Sys_error _ -> [] in - try - List.fold_right - (fun s acc -> - match string_split ~max_elem:2 ' ' s with - | [a; b] -> (a, unquote b) :: acc - | _ -> acc) - lines [] - with Failure _ -> [] + List.map + (fun (k, v) -> + match v with + | Basic_io_lexer.STRING s + | Basic_io_lexer.ID s -> k, s) + (List.flatten stanzas) let parse_MTN_revision mtn_file = let format = @@ -62,11 +54,10 @@ let parse_MTN_revision mtn_file = with_file_in (fun ic -> match - Revision_parser.revision_set - Revision_lexer.lex + Revision.revision_set (Lexing.from_channel ic) with - | _, { Revision_types.old_revision = r } :: _ -> r + | _, { Revision.old_revision = r } :: _ -> r | _ -> failwith "could not determine revision id from _MTN/revision") rev_file | _ -> ============================================================ --- monotone.ml 4b6201bde7f13d46de89a3a297e36acfdc634a65 +++ monotone.ml e1b68e6da8d6dd8a5afc6253f4187d63f463d402 @@ -1,15 +1,68 @@ +open Viz_types type t = Automate.t let make = Automate.make let exit = Automate.exit +let ( +> ) x f = f x + let decode_branches msg = let l = Viz_misc.string_split '\n' msg in List.map (fun l -> l, 0) l let branches mtn = + Automate.submit_sync + mtn + [ "branches" ] + +> decode_branches + +let node_data_of_revision rev_id certs (m_id, edges) = + { revision_id = rev_id ; + manifest_id = m_id ; + revision_set = List.map (fun e -> e.Revision.old_revision, e.Revision.change_set) edges ; + certs = certs ; + } + +let _get_revision mtn id certs = + Automate.submit_sync + mtn [ "get_revision" ; id ] + +> Lexing.from_string + +> Revision.revision_set + +> node_data_of_revision id certs + +let get_revision mtn id = + _get_revision mtn id [] + + + + +let get_elem st k = + match List.assoc k st with + | Basic_io_lexer.STRING s + | Basic_io_lexer.ID s -> s + +let sig_verif = function + | "ok" -> SIG_OK + | "bad" -> SIG_BAD + | "unknown" -> SIG_UNKNOWN + | _ -> failwith "Monotone.sig_verif" + +let cert_of_stanza id st = + { c_id = id ; + c_name = get_elem st "name" ; + c_value = get_elem st "value" ; + c_signer_id = get_elem st "key" ; + c_signature = sig_verif (get_elem st "signature") ; + } + +let certs mtn id = + Automate.submit_sync + mtn [ "certs" ; id ] + +> Lexing.from_string + +> Basic_io_lexer.parse + +> List.map (cert_of_stanza id) + +let get_certs_and_revision mtn id = + certs mtn id + +> _get_revision mtn id - decode_branches - (Automate.submit_sync - mtn - [ "branches" ]) ============================================================ --- monotone.mli 411c0e2eb06c3c5b4627ff870ecb88e0cf32c7ee +++ monotone.mli caa9158dd57c50f72973b68c33e2f00a6ef83ba0 @@ -5,3 +5,5 @@ val branches : t -> (string * int) list val exit : t -> unit val branches : t -> (string * int) list +val get_revision : t -> string -> Viz_types.node_data +val get_certs_and_revision : t -> string -> Viz_types.node_data ============================================================ --- query.ml f691b2a902e28ebb9503a018f52a1634297b39ed +++ query.ml 1ba5f91fb7c65a662a9ae17af8a19edf6c318828 @@ -1,3 +1,4 @@ +open Viz_misc open Viz_types module Selector = struct @@ -71,16 +72,14 @@ let revision_contains pat = function | [ _, changes ] -> List.exists (function - | Revision_types.PATCH (f, _, _) - | Revision_types.ADD_FILE (f, _) - | Revision_types.ADD_DIR f - | Revision_types.DELETE_FILE f - | Revision_types.DELETE_DIR f - | Revision_types.ATTR_CLEAR (_, f) - | Revision_types.ATTR_SET (_, f, _) -> + | Revision.PATCH (f, _, _) + | Revision.ADD_FILE (f, _) + | Revision.ADD_DIR f + | Revision.DELETE f + | Revision.ATTR_CLEAR (_, f) + | Revision.ATTR_SET (_, f, _) -> Gpattern.match_string pat f - | Revision_types.RENAME_FILE (f1, f2) - | Revision_types.RENAME_DIR (f1, f2) -> + | Revision.RENAME (f1, f2) -> Gpattern.match_string pat f1 || Gpattern.match_string pat f2) changes @@ -90,22 +89,22 @@ let filter_by_revision_content let filter_by_revision_content (ctrl : (unit -> 'a) -> 'a; ..>; ..>) - db revision_content ids = + mtn revision_content ids = (ctrl#status "search")#with_status "Searching the monotone database ..." (fun () -> let pat = Gpattern.make revision_content in Ui.fold_in_loop (fun acc id -> - let r = Database.fetch_revision db id in + let r = Monotone.get_revision mtn id in if revision_contains pat r.revision_set then id :: acc else acc) [] ids) -let select_by_revision_content ctrl db revision_content g = +let select_by_revision_content ctrl mtn revision_content g = filter_by_revision_content - ctrl db revision_content + ctrl mtn revision_content (Agraph.get_ids g) @@ -135,17 +134,20 @@ let do_query ~selector ~revision_content ctrl db g selector (function | `IDS ids when revision_content <> "" -> - results_ids db + let mtn = some ctrl#get_mtn in + results_ids + db (filter_by_revision_content - ctrl db revision_content ids) + ctrl mtn revision_content ids) | `IDS ids -> results_ids db ids | `SUB_PROC_ERROR _ as err -> results_cb err) | Some db, Some g when revision_content <> "" -> + let mtn = some ctrl#get_mtn in results_ids db (select_by_revision_content - ctrl db revision_content g) + ctrl mtn revision_content g) | _ -> no_results () ============================================================ --- ui.ml a1771efa0cc6a979a8436e99a43df62b74881081 +++ ui.ml d87af029600a71eb22e88ecd31c17d788ceabba4 @@ -492,7 +492,7 @@ let popup m ctrl ~popup_id button = begin let copy_revision = p.group#get_action "Copy_revision" in let copy_manifest = p.group#get_action "Copy_manifest" in - let data = Database.fetch_revision (some ctrl#get_db) popup_id in + let data = Monotone.get_revision (some ctrl#get_mtn) popup_id in remember_signal copy_revision (fun () -> set_clipboard m data.revision_id) ; remember_signal copy_manifest ============================================================ --- view.ml 41bf399ecc2067d9cf5e3cde7b0af3917309285a +++ view.ml dbc7bbd981a1cc9a1b399ea544cb4eaf10b62676 @@ -1,6 +1,6 @@ open Viz_types open Viz_misc open Viz_types -open Revision_types +open Revision open Ui let ( ++ ) x f = f x @@ -188,14 +188,12 @@ module Info_Display = struct i.cert_model#clear () let stock_of_delta_type = function - | PATCH _ -> None + | PATCH _ -> None | ADD_FILE _ - | ADD_DIR _ -> Some `ADD - | DELETE_FILE _ - | DELETE_DIR _ -> Some `REMOVE - | RENAME_FILE _ - | RENAME_DIR _ -> Some `CONVERT - | ATTR_SET _ -> Some `PROPERTIES + | ADD_DIR _ -> Some `ADD + | DELETE _ -> Some `REMOVE + | RENAME _ -> Some `CONVERT + | ATTR_SET _ -> Some `PROPERTIES | ATTR_CLEAR _ -> Some `CLEAR let text_of_delta_type = function @@ -203,11 +201,9 @@ module Info_Display = struct | PATCH (f, _, "") -> "" | PATCH (f, _, _) | ADD_FILE (f, _) - | DELETE_FILE f -> f - | ADD_DIR f - | DELETE_DIR f -> f ^ "/" - | RENAME_FILE (o, n) -> Printf.sprintf "%s -> %s" o n - | RENAME_DIR (o, n) -> Printf.sprintf "%s/ -> %s/" o n + | DELETE f -> f + | ADD_DIR f -> f ^ "/" + | RENAME (o, n) -> Printf.sprintf "%s -> %s" o n | ATTR_CLEAR (attr, f) | ATTR_SET (attr, f, _) -> Printf.sprintf "%s on %s" attr f @@ -275,14 +271,12 @@ module Info_Display = struct { data with certs = List.filter (fun c -> not (List.mem c.c_name ignored_certs)) data.certs } let fetch_and_display_data info ctrl id = - match ctrl#get_db with + match ctrl#get_mtn with | None -> () - | Some db -> + | Some mtn -> let data = - try Database.fetch_certs_and_revision db id + try Monotone.get_certs_and_revision mtn id with - | Sqlite3.Error ((Sqlite3.BUSY | Sqlite3.LOCKED), _) -> - failed_node_data | Viz_types.Error msg -> ctrl#error_notice msg ; failed_node_data in ============================================================ --- viz_types.ml 000e61799446f6d11caad5379ca79c9ea6ff087e +++ viz_types.ml 392de3299992cb0b698cc920941cf4ad6a87a78b @@ -64,7 +64,7 @@ type node_data = { type node_data = { revision_id : string ; manifest_id : string ; - revision_set : (string * Revision_types.change list) list ; + revision_set : (string * Revision.change list) list ; certs : cert list ; } ============================================================ --- viz_types.mli dcc5514fcad957dbccfe3b83c2878fe91dc605b0 +++ viz_types.mli a26eeb13ea1ec9c013b24223091d747033070f0c @@ -61,7 +61,7 @@ type node_data = { type node_data = { revision_id : string ; manifest_id : string ; - revision_set : (string * Revision_types.change list) list ; + revision_set : (string * Revision.change list) list ; certs : cert list ; }