From b424dc951fe69185b9830931c394acee88df7f8e Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 31 Mar 2022 17:51:41 +0200 Subject: [PATCH 1/6] Add rudimentary parser for Git config files --- cli/dune | 17 ++++++++++++++--- cli/gitconfig_lexer.mll | 16 ++++++++++++++++ cli/gitconfig_parser.mly | 24 ++++++++++++++++++++++++ cli/gitconfig_types.mli | 5 +++++ cli/test_gitconfig.ml | 23 +++++++++++++++++++++++ dune-project | 1 + 6 files changed, 83 insertions(+), 3 deletions(-) create mode 100644 cli/gitconfig_lexer.mll create mode 100644 cli/gitconfig_parser.mly create mode 100644 cli/gitconfig_types.mli create mode 100644 cli/test_gitconfig.ml diff --git a/cli/dune b/cli/dune index 1a266cf..9fa606a 100644 --- a/cli/dune +++ b/cli/dune @@ -1,8 +1,19 @@ -(executables +(executable (libraries cohttp-lwt-unix gitlab-unix cmdliner otoml) (package lab) - (public_names lab) - (names main)) + (public_name lab) + (modules main) + (name main)) + +(executable + (name test_gitconfig) + (modules_without_implementation gitconfig_types) + (modules gitconfig_lexer gitconfig_types gitconfig_parser test_gitconfig)) + +(ocamllex gitconfig_lexer) + +(menhir + (modules gitconfig_parser)) (mdx (files lab.md) diff --git a/cli/gitconfig_lexer.mll b/cli/gitconfig_lexer.mll new file mode 100644 index 0000000..75d4185 --- /dev/null +++ b/cli/gitconfig_lexer.mll @@ -0,0 +1,16 @@ +{ +open Gitconfig_parser + +exception Error of string +} + +let whitespace = ['\t' ' ']* +let eol = '\n' | "\r\n" +let key = ['A'-'Z''a'-'z''0'-'9''_''-']+ +let value = [^'\n''\r']+ +let section_name = [^'['']']+ + +rule token = parse +| whitespace '[' (section_name as name) ']' whitespace eol { SECTIONHEADER name } +| whitespace (key as key) whitespace '=' whitespace (value as value) eol { KEYVAL (key,value) } +| eof { EOF } diff --git a/cli/gitconfig_parser.mly b/cli/gitconfig_parser.mly new file mode 100644 index 0000000..dcbf060 --- /dev/null +++ b/cli/gitconfig_parser.mly @@ -0,0 +1,24 @@ +%{ +%} + +%token KEYVAL +%token SECTIONHEADER +%token EOF + +%start config + +%type config +%type key_value + +%% +config: +| section* EOF { $1 } + +section: +| section_header key_value* { $1, $2 } + +section_header: +| SECTIONHEADER { $1 } + +key_value: +| KEYVAL { $1 } diff --git a/cli/gitconfig_types.mli b/cli/gitconfig_types.mli new file mode 100644 index 0000000..8aa2106 --- /dev/null +++ b/cli/gitconfig_types.mli @@ -0,0 +1,5 @@ +type binding = string * string (* Key/value pair *) + +type section = string * binding list (* Section name and contents *) + +type t = section list diff --git a/cli/test_gitconfig.ml b/cli/test_gitconfig.ml new file mode 100644 index 0000000..595d679 --- /dev/null +++ b/cli/test_gitconfig.ml @@ -0,0 +1,23 @@ +let print_config fmt config = + let open Format in + let rec print_bindings fmt = function + | [] -> () + | (key, value) :: rem -> + fprintf fmt "\t%s = %s\n" key value; + print_bindings fmt rem + in + config |> List.iter (fun (name, bindings) -> + fprintf fmt "[%s]\n%a" name print_bindings bindings + ) + + +let () = + let lexbuf = Lexing.from_channel stdin in + try + let config = Gitconfig_parser.config Gitconfig_lexer.token lexbuf in + print_config Format.std_formatter config + with + | Gitconfig_lexer.Error msg -> + Printf.fprintf stderr "%s%!" msg + | Gitconfig_parser.Error -> + Printf.fprintf stderr "At offset %d: syntax error.\n%!" (Lexing.lexeme_start lexbuf) diff --git a/dune-project b/dune-project index b990498..3080fd4 100644 --- a/dune-project +++ b/dune-project @@ -69,3 +69,4 @@ This library installs the JavaScript version, which uses [js_of_ocaml](http://oc (synopsis "GitLab cli") (description "Experimental GitLab cli in the style of GitHub's gh and hub commands.")) +(using menhir 2.1) From f177fe8a4f08b62c0815f95664e14c2db021be63 Mon Sep 17 00:00:00 2001 From: Tim McGilchrist Date: Fri, 1 Apr 2022 14:22:37 +1100 Subject: [PATCH 2/6] List modules in dune. --- cli/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cli/dune b/cli/dune index 9fa606a..e10508f 100644 --- a/cli/dune +++ b/cli/dune @@ -2,7 +2,7 @@ (libraries cohttp-lwt-unix gitlab-unix cmdliner otoml) (package lab) (public_name lab) - (modules main) + (modules main api config issue merge_request project user) (name main)) (executable From ca401272ca848b69eb181d6a6e7aada45d7281c4 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 1 Apr 2022 15:00:23 +0200 Subject: [PATCH 3/6] Move config parser test to test/. --- cli/dune | 10 ++++++---- test/gitconfig/dune | 5 +++++ test/gitconfig/gitconfig.expected | 14 ++++++++++++++ .../gitconfig/gitconfig.ml | 19 ++++++++++++++++++- 4 files changed, 43 insertions(+), 5 deletions(-) create mode 100644 test/gitconfig/dune create mode 100644 test/gitconfig/gitconfig.expected rename cli/test_gitconfig.ml => test/gitconfig/gitconfig.ml (61%) diff --git a/cli/dune b/cli/dune index e10508f..f917115 100644 --- a/cli/dune +++ b/cli/dune @@ -5,10 +5,12 @@ (modules main api config issue merge_request project user) (name main)) -(executable - (name test_gitconfig) - (modules_without_implementation gitconfig_types) - (modules gitconfig_lexer gitconfig_types gitconfig_parser test_gitconfig)) +; Parser for Git config files +(library + (name gitconfig) + (package lab) + (modules gitconfig_lexer gitconfig_types gitconfig_parser) + (modules_without_implementation gitconfig_types)) (ocamllex gitconfig_lexer) diff --git a/test/gitconfig/dune b/test/gitconfig/dune new file mode 100644 index 0000000..8425762 --- /dev/null +++ b/test/gitconfig/dune @@ -0,0 +1,5 @@ +(test + (name gitconfig) + (package lab) + (libraries gitconfig) + (modules gitconfig)) diff --git a/test/gitconfig/gitconfig.expected b/test/gitconfig/gitconfig.expected new file mode 100644 index 0000000..2946b16 --- /dev/null +++ b/test/gitconfig/gitconfig.expected @@ -0,0 +1,14 @@ +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[remote "origin"] + url = git@github.com:tmcgilchrist/ocaml-gitlab + fetch = +refs/heads/*:refs/remotes/origin/* +[branch "master"] + remote = origin + merge = refs/heads/master +[branch "parse_gitconfig"] + remote = origin + merge = refs/heads/parse_gitconfig diff --git a/cli/test_gitconfig.ml b/test/gitconfig/gitconfig.ml similarity index 61% rename from cli/test_gitconfig.ml rename to test/gitconfig/gitconfig.ml index 595d679..7790613 100644 --- a/cli/test_gitconfig.ml +++ b/test/gitconfig/gitconfig.ml @@ -1,3 +1,5 @@ +open Gitconfig + let print_config fmt config = let open Format in let rec print_bindings fmt = function @@ -12,7 +14,22 @@ let print_config fmt config = let () = - let lexbuf = Lexing.from_channel stdin in + let lexbuf = Lexing.from_string {|[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[remote "origin"] + url = git@github.com:tmcgilchrist/ocaml-gitlab + fetch = +refs/heads/*:refs/remotes/origin/* +[branch "master"] + remote = origin + merge = refs/heads/master +[branch "parse_gitconfig"] + remote = origin + merge = refs/heads/parse_gitconfig +|} + in try let config = Gitconfig_parser.config Gitconfig_lexer.token lexbuf in print_config Format.std_formatter config From 190b4595269cf8c5d8e8668891d31acdcf785c4d Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 1 Apr 2022 15:01:05 +0200 Subject: [PATCH 4/6] Clarify type name. --- cli/gitconfig_parser.mly | 2 +- cli/gitconfig_types.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cli/gitconfig_parser.mly b/cli/gitconfig_parser.mly index dcbf060..22a2e35 100644 --- a/cli/gitconfig_parser.mly +++ b/cli/gitconfig_parser.mly @@ -7,7 +7,7 @@ %start config -%type config +%type config %type key_value %% diff --git a/cli/gitconfig_types.mli b/cli/gitconfig_types.mli index 8aa2106..892c086 100644 --- a/cli/gitconfig_types.mli +++ b/cli/gitconfig_types.mli @@ -2,4 +2,4 @@ type binding = string * string (* Key/value pair *) type section = string * binding list (* Section name and contents *) -type t = section list +type config = section list From 050cd3a916d79fd5e74af21f522f7993db5c27d9 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 1 Apr 2022 15:29:25 +0200 Subject: [PATCH 5/6] Improve file names and directory structure. Follow the dune spirit, i.e. stop prefixing modules with `Gitconfig_`. --- cli/dune | 12 ------------ cli/gitconfig/dune | 10 ++++++++++ cli/{gitconfig_lexer.mll => gitconfig/lexer.mll} | 2 +- cli/{gitconfig_parser.mly => gitconfig/parser.mly} | 6 +++--- cli/{gitconfig_types.mli => gitconfig/types.mli} | 0 test/gitconfig/gitconfig.ml | 8 +++----- 6 files changed, 17 insertions(+), 21 deletions(-) create mode 100644 cli/gitconfig/dune rename cli/{gitconfig_lexer.mll => gitconfig/lexer.mll} (94%) rename cli/{gitconfig_parser.mly => gitconfig/parser.mly} (64%) rename cli/{gitconfig_types.mli => gitconfig/types.mli} (100%) diff --git a/cli/dune b/cli/dune index f917115..0694cf2 100644 --- a/cli/dune +++ b/cli/dune @@ -5,18 +5,6 @@ (modules main api config issue merge_request project user) (name main)) -; Parser for Git config files -(library - (name gitconfig) - (package lab) - (modules gitconfig_lexer gitconfig_types gitconfig_parser) - (modules_without_implementation gitconfig_types)) - -(ocamllex gitconfig_lexer) - -(menhir - (modules gitconfig_parser)) - (mdx (files lab.md) (package lab) diff --git a/cli/gitconfig/dune b/cli/gitconfig/dune new file mode 100644 index 0000000..a1e9653 --- /dev/null +++ b/cli/gitconfig/dune @@ -0,0 +1,10 @@ +(library + (name gitconfig) + (package lab) + (modules types lexer parser) + (modules_without_implementation types)) + +(ocamllex lexer) + +(menhir + (modules parser)) diff --git a/cli/gitconfig_lexer.mll b/cli/gitconfig/lexer.mll similarity index 94% rename from cli/gitconfig_lexer.mll rename to cli/gitconfig/lexer.mll index 75d4185..387b34c 100644 --- a/cli/gitconfig_lexer.mll +++ b/cli/gitconfig/lexer.mll @@ -1,5 +1,5 @@ { -open Gitconfig_parser +open Parser exception Error of string } diff --git a/cli/gitconfig_parser.mly b/cli/gitconfig/parser.mly similarity index 64% rename from cli/gitconfig_parser.mly rename to cli/gitconfig/parser.mly index 22a2e35..4f29444 100644 --- a/cli/gitconfig_parser.mly +++ b/cli/gitconfig/parser.mly @@ -1,14 +1,14 @@ %{ %} -%token KEYVAL +%token KEYVAL %token SECTIONHEADER %token EOF %start config -%type config -%type key_value +%type config +%type key_value %% config: diff --git a/cli/gitconfig_types.mli b/cli/gitconfig/types.mli similarity index 100% rename from cli/gitconfig_types.mli rename to cli/gitconfig/types.mli diff --git a/test/gitconfig/gitconfig.ml b/test/gitconfig/gitconfig.ml index 7790613..a3e02cc 100644 --- a/test/gitconfig/gitconfig.ml +++ b/test/gitconfig/gitconfig.ml @@ -1,5 +1,3 @@ -open Gitconfig - let print_config fmt config = let open Format in let rec print_bindings fmt = function @@ -31,10 +29,10 @@ let () = |} in try - let config = Gitconfig_parser.config Gitconfig_lexer.token lexbuf in + let config = Gitconfig.Parser.config Gitconfig.Lexer.token lexbuf in print_config Format.std_formatter config with - | Gitconfig_lexer.Error msg -> + | Gitconfig.Lexer.Error msg -> Printf.fprintf stderr "%s%!" msg - | Gitconfig_parser.Error -> + | Gitconfig.Parser.Error -> Printf.fprintf stderr "At offset %d: syntax error.\n%!" (Lexing.lexeme_start lexbuf) From 327e557a4096d73c3afdcc3c410c58a97329bb05 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 1 Apr 2022 17:02:36 +0200 Subject: [PATCH 6/6] Add functions for extracting Gitlab project name. --- cli/gitconfig/dune | 3 +- cli/gitconfig/resolve.ml | 74 +++++++++++++++++++++++++++++++++++++++ cli/gitconfig/resolve.mli | 14 ++++++++ 3 files changed, 90 insertions(+), 1 deletion(-) create mode 100644 cli/gitconfig/resolve.ml create mode 100644 cli/gitconfig/resolve.mli diff --git a/cli/gitconfig/dune b/cli/gitconfig/dune index a1e9653..99587ad 100644 --- a/cli/gitconfig/dune +++ b/cli/gitconfig/dune @@ -1,7 +1,8 @@ (library (name gitconfig) (package lab) - (modules types lexer parser) + (modules types lexer parser resolve) + (libraries str) (modules_without_implementation types)) (ocamllex lexer) diff --git a/cli/gitconfig/resolve.ml b/cli/gitconfig/resolve.ml new file mode 100644 index 0000000..2260f6c --- /dev/null +++ b/cli/gitconfig/resolve.ml @@ -0,0 +1,74 @@ +let find_dot_git () = + let rec search dir = + let dot_git = Filename.concat dir ".git" in + if Sys.file_exists dot_git && Sys.is_directory dot_git then + Some dot_git + else + let parent_dir = Filename.dirname dir in + if not (String.equal dir parent_dir) then + search parent_dir + else + None + in + search (Sys.getcwd ()) + +let parse_dot_git () = + let dot_git = find_dot_git () in + match dot_git with + | None -> Error "No .git directory found in this directory, nor in a parent \ + directory." + | Some dot_git -> + let config_file = Filename.concat dot_git "config" in + begin try + let chan = open_in config_file in + let lexbuf = Lexing.from_channel chan in + begin try + Ok (Parser.config Lexer.token lexbuf) + with + | Lexer.Error msg -> + Error (Printf.sprintf "Error in lexer while parsing %s: %s%!" + config_file msg) + | Parser.Error -> + Error (Printf.sprintf + "Error while parsing %s: At offset %d: syntax error.\n%!" + config_file + (Lexing.lexeme_start lexbuf)) + end + with Sys_error e -> + Error ("Error when opening " ^ config_file ^ ": " ^ e) + end + +let gitlab_project_from_url url = + let regex = Str.regexp + "^git@[A-Za-z0-9.-]+:\\([A-Za-z0-9-]+/[A-Za-z-]+\\)\\(\\.git\\)?$\ + \\|\ + ^https:[A-Za-z0-9./-]+/\\([A-Za-z0-9-]+/[A-Za-z-]+\\)\\(\\.git\\)?$" + in + if Str.string_match regex url 0 then Some (Str.matched_group 1 url) else None + +let gitlab_project_name ?remote config = + match remote with + | Some remote -> + begin try + let settings = List.assoc ("remote \"" ^ remote ^ "\"") config in + let url = List.assoc "url" settings in + gitlab_project_from_url url + with Not_found -> None + end + | None -> + let remotes = + List.filter + (fun (name,_) -> + let regex = Str.regexp "^remote \"[^\"]+\"$" in + Str.string_match regex name 0) + config + in + begin match remotes with + | [(_name,settings)] -> + Printf.printf "case 1\n"; + begin try + gitlab_project_from_url (List.assoc "url" settings) + with Not_found -> None + end + | _ :: _ | [] -> Printf.printf "case 2\n"; None + end diff --git a/cli/gitconfig/resolve.mli b/cli/gitconfig/resolve.mli new file mode 100644 index 0000000..d9b7a13 --- /dev/null +++ b/cli/gitconfig/resolve.mli @@ -0,0 +1,14 @@ +(** Search for a [.git] directory from the current directory upwards. Return + [None] if none could be found. *) +val find_dot_git : unit -> string option + +(** Search for a [.git] directory from the current directory upwards, and parse + it. Return [Error] with an error message if none could be found, or in + case of parse error. *) +val parse_dot_git : unit -> (Types.config, string) result + +(** [gitlab_project_name ~remote config] extracts the Gitlab project name from + the URL of the remote named [remote] in [config]. If [remote] is not + specified, and there is more than one remote, returns [None]. Also returns + [None] if no suitable remote URL can be found. *) +val gitlab_project_name : ?remote:string -> Types.config -> string option