Source file bcfg_query.ml

let ( let@ ) finally fn = Fun.protect ~finally fn
let ( let* ) = Result.bind

let run _quiet cfg output_format query input =
  let* query = Bcfgq.of_string query in
  let ic, finally =
    match input with
    | None -> (stdin, ignore)
    | Some filepath ->
        let ic = open_in_bin filepath in
        (ic, fun () -> close_in ic)
  in
  let@ () = finally in
  let lexbuf = Lexing.from_channel ic in
  let* result =
    if Bcfgq.is_streamable query then begin
      (* No [@(...)] substitution: evaluate one top-level directive at a time,
         without materialising the whole document. *)
      let exception E of string in
      let chunks = ref [] in
      try
        Seq.iter
          (function
            | Ok d -> chunks := Bcfgq.eval query [ d ] :: !chunks
            | Error e -> raise (E (Format.asprintf "%a" Bcfg.Stream.pp_error e)))
          (Bcfg.Stream.to_directives lexbuf);
        Ok (List.concat (List.rev !chunks))
      with E msg -> Error (`Msg msg)
    end
    else
      let* bcfg = Bcfg.parser lexbuf in
      Ok (Bcfgq.eval query bcfg)
  in
  (match output_format with
  | `Bcfg -> Seq.iter (output_string stdout) (Bcfg.emitter ~cfg result)
  | `Json ->
      print_string (Bcfg_json.to_string (Bcfg_json.of_config result));
      print_newline ());
  Ok 0

let to_msg = function
  | `Msg _ as m -> m
  | #Bcfg.error -> `Msg "Invalid bcfg file"

open Cmdliner
open Bcfg_cli

let input =
  let doc = "The configuration file to query ($(b,-) for standard input)." in
  let parser str =
    match str with
    | "-" -> Ok None
    | filepath when Sys.file_exists filepath && is_regular_file filepath ->
        Ok (Some filepath)
    | filepath ->
        error_msgf "%S does not exist or is not a regular file" filepath
  in
  let pp ppf = function
    | None -> Fmt.string ppf "-"
    | Some filepath -> Fmt.string ppf filepath
  in
  let input = Arg.conv (parser, pp) in
  let open Arg in
  value & pos 1 input None & info [] ~doc ~docv:"FILE"

let query =
  let doc = "The $(b,bcfg) query." in
  let open Arg in
  required & pos 0 (some string) None & info [] ~doc ~docv:"QUERY"

let output_format =
  let doc = "The output format of the query result ($(b,bcfg) or $(b,json))." in
  let open Arg in
  value
  & opt (enum [ ("bcfg", `Bcfg); ("json", `Json) ]) `Bcfg
  & info [ "o"; "output-format" ] ~doc ~docv:"FORMAT"

let term =
  let open Term in
  const run $ setup_logs $ setup_output_configuration $ output_format $ query
  $ input
  |> map (Result.map_error to_msg)
  |> term_result ~usage:false

let cmd =
  let doc =
    "$(tname) applies a query to the given $(b,bcfg) configuration file."
  in
  let man =
    [
      `S Manpage.s_description;
      `P
        "$(tname) selects directives from a $(b,bcfg) configuration using a \
         small query language and prints them back, either as $(b,bcfg) or as \
         JSON (to be piped into tools such as $(b,jq)).";
      `P
        "A $(b,bcfg) document is a list of directives, and a directive is a \
         name, a list of parameters and a list of children (themselves \
         directives). A query works on that shape only: it starts from the \
         list of top-level directives and every step of the query turns a list \
         of directives into another list of directives. The result is \
         therefore always a list of directives, which is what $(tname) prints. \
         There is no other kind of value: even a single parameter such as a \
         port number comes out as a directive whose name is that parameter.";
      `P
        "All the examples below run on the configuration file shipped in the \
         $(b,example/) directory of the distribution:";
      `Pre
        "# The virtual host used when no other one matches.\n\
         default www.example.org\n\n\
         service www.example.org public {\n\
        \  memory 128\n\
        \  weight 1.5\n\
        \  log debug\n\
        \  listen 80\n\
        \  listen 443\n\
        \  upstream {\n\
        \    kind tcp\n\
        \    host 10.0.0.2\n\
        \    port 8080\n\
        \  }\n\
        \  tls {\n\
        \    certificate /etc/ssl/www.example.org.pem\n\
        \    key /etc/ssl/www.example.org.key\n\
        \  }\n\
         }\n\n\
         service git.example.org internal {\n\
        \  memory 256\n\
        \  weight 1.\n\
        \  log info\n\
        \  listen 22\n\
        \  upstream {\n\
        \    kind unix\n\
        \    path /run/git.sock\n\
        \  }\n\
         }\n\n\
         service static.example.org public {\n\
        \  memory 64\n\
        \  weight 0.5\n\
        \  log quiet\n\
        \  listen 80\n\
        \  upstream {\n\
        \    kind tcp\n\
        \    host 10.0.0.3\n\
        \    port 8081\n\
        \  }\n\
         }\n\n\
         group production {\n\
        \  member www.example.org\n\
        \  member git.example.org\n\n\
        \  group staging {\n\
        \    member static.example.org\n\
        \  }\n\
         }";
      `S "SELECTING DIRECTIVES";
      `P
        "These constructs choose $(i,which) directives are kept and how deep \
         the query goes.";
      `I
        ( "$(b,foo)",
          "Keeps the directives named \"foo\" at the current level. At the \
           beginning of a query, the current level is the list of top-level \
           directives, so $(b,service) selects the three services of our \
           example." );
      `I
        ( "$(b,*)",
          "Keeps every directive of the current level, whatever its name." );
      `I
        ( "$(b,foo.bar)",
          "Descends: $(b,bar) is applied to the children of the directives \
           selected by $(b,foo). It can be repeated, e.g. \
           $(b,service.upstream.port) reaches the port of every upstream. Note \
           that a query never descends by itself: what is not reached by a \
           $(b,.) is not looked at." );
      `I
        ( "$(b,foo[N])",
          "Takes the N-th parameter (counting from 0) of each selected \
           directive: the parameter becomes the name of the resulting \
           directive and the children are kept. Directives with fewer \
           parameters are dropped. This is how you extract a value: \
           $(b,service.listen) prints \"listen 80\" whereas \
           $(b,service.listen[0]) prints \"80\"." );
      `S "FILTERING DIRECTIVES";
      `P
        "A filter keeps or discards the directives of the current level \
         according to a $(b,pattern) (see below). It never descends and never \
         changes what is selected, so it can be inserted anywhere in a query \
         and repeated: $(b,service\\(public\\)\\(:^tls\\)) keeps the public \
         services that have no $(b,tls) block.";
      `I
        ( "$(b,foo\\(PAT\\))",
          "Keeps the directives having $(i,at least one) parameter matching \
           $(i,PAT), e.g. $(b,service\\(public\\))." );
      `I
        ( "$(b,foo\\(^PAT\\))",
          "The anti-join: keeps the directives having $(i,no) parameter \
           matching $(i,PAT), e.g. $(b,service\\(^public\\)) selects the \
           services that are not public." );
      `I
        ( "$(b,foo\\(:PAT\\))",
          "Keeps the directives having at least one child whose $(i,name) \
           matches $(i,PAT), e.g. $(b,service\\(:tls\\)) selects the services \
           that define a $(b,tls) block." );
      `I
        ( "$(b,foo\\(:^PAT\\))",
          "Keeps the directives having no child whose name matches $(i,PAT), \
           e.g. $(b,service\\(:^tls\\)) selects the services that do $(i,not) \
           define a $(b,tls) block." );
      `I
        ( "$(b,\\(PAT\\)foo)",
          "Keeps the directives whose $(i,name) matches $(i,PAT). Alone, \
           $(b,\\(PAT\\)) filters the names of the current level: \
           $(b,\\(&,!service,!group\\)) selects the top-level directives that \
           are neither a service nor a group, and $(b,group.\\(!member\\)*) \
           selects the children of $(b,group) that are not members." );
      `S "PATTERNS";
      `P
        "A pattern says how a single word (a parameter, or the name of a \
         directive) is matched. The comparison is a plain string equality: \
         there is no globbing and no regular expression.";
      `I ("$(i,word)", "Matches that exact word.");
      `I ("$(b,*)", "Matches any word.");
      `I ("$(b,!PAT)", "Matches when the pattern $(i,PAT) does not match.");
      `I
        ( "$(b,PAT|PAT)",
          "Matches when either side matches. $(b,\\(|,A,B,C\\)) is the same \
           thing with more than two alternatives." );
      `I
        ( "$(b,PAT&PAT)",
          "Matches when both sides match. $(b,\\(&,A,B,C\\)) is the n-ary \
           form. Parentheses group patterns, as in \
           $(b,service\\(\\(public|internal\\)&!internal\\))." );
      `P
        "Beware of the difference between $(b,!) and $(b,^). A filter asks \
         whether $(i,some) parameter matches, so $(b,service\\(!public\\)) \
         keeps a service as soon as it has one parameter that is not \
         \"public\" (its host name always is), which selects everything. To \
         express \"is not public\", use the anti-join \
         $(b,service\\(^public\\)), which requires that $(i,no) parameter \
         matches.";
      `S "SUBSTITUTIONS";
      `P
        "$(b,@\\(QUERY\\)) is a pattern whose words are computed from the \
         document itself. The sub-query is evaluated against the $(i,whole) \
         document (not against the current level) and each resulting directive \
         gives one word: its first parameter, or its name when it has none, \
         exactly as $(b,QUERY[0]) would print it. The pattern matches when the \
         tested word is one of them.";
      `P
        "For instance $(b,service\\(@\\(default[0]\\)\\)) selects the service \
         designated by the $(b,default) directive, and \
         $(b,service\\(@\\(group.member[0]\\)\\)) selects the services that \
         are listed in a group. Since it is a pattern, it composes with the \
         operators above: $(b,service\\(!@\\(group.member[0]\\)\\)) selects \
         the services that no group mentions.";
      `P
        "$(b,\\$\\(QUERY\\)) is an alias of $(b,@\\(QUERY\\)) for those used \
         to $(b,jq). $(b,@) is preferred because it is not special inside \
         shell double quotes. Note that a substitution is only a pattern: it \
         appears where a pattern is expected, never as a query on its own.";
      `S "QUOTING";
      `P
        "Words follow the same lexical rules as the configuration format \
         itself: a value containing characters that are meaningful to the \
         query language (dots, brackets, parentheses, $(b,!), $(b,|), $(b,&), \
         $(b,:), $(b,^), $(b,*), $(b,@)) must be quoted with $(b,'...') or \
         $(b,\"...\"), e.g. $(b,service\\('www.example.org'\\).listen). \
         Unquoted, $(b,www.example.org) would be read as three names separated \
         by dots. Inside quotes, $(b,\\\\xNN) denotes an arbitrary byte, which \
         is the way to name a value that is not valid UTF-8. Single quotes are \
         handy inside shell double quotes, and vice versa.";
      `S "OUTPUT";
      `P
        "By default the result is printed as $(b,bcfg), using the output \
         configuration options (indentation, margin, escaping) described \
         below. The result is a real configuration file: it can be fed back to \
         $(tname).";
      `P
        "With $(b,-o json), the result is printed as JSON. A list of \
         directives becomes an object keyed by directive names; a name \
         appearing several times becomes an array (which means that the shape \
         of the output depends on the document: one $(b,listen) directive \
         gives a string, two give an array). A directive with children becomes \
         an object, and its own parameters, if any, are stored under the \
         $(b,\\$params) key. A directive without children is its parameters: \
         $(b,null) when there is none, a string when there is one, an array \
         otherwise. Values are always strings, since $(b,bcfg) has no notion \
         of number or boolean.";
      `S "LARGE FILES";
      `P
        "A query that contains no substitution never looks outside the \
         top-level directive being examined. Such a query is evaluated in a \
         streaming fashion, one top-level directive at a time, and $(tname) \
         does not need to hold the whole document in memory. As soon as an \
         $(b,@\\(...\\)) appears, the document must be fully parsed first, \
         because the sub-query may refer to any part of it.";
      `S Manpage.s_examples;
      `P "Get the certificate of a given service:";
      `Pre
        "\\$ bcfg query \"service\\('www.example.org'\\).tls.certificate[0]\" \
         services.cfg\n\
         /etc/ssl/www.example.org.pem";
      `P "List the ports of the public services:";
      `Pre
        "\\$ bcfg query 'service\\(public\\).listen[0]' services.cfg\n\
         80\n\
         443\n\
         80";
      `P "Show the services that are not public:";
      `Pre
        "\\$ bcfg query 'service\\(^public\\)[0]' services.cfg\n\
         git.example.org {\n\
        \  memory 256\n\
        \  weight 1.\n\
        \  log info\n\
        \  listen 22\n\
        \  upstream {\n\
        \    kind unix\n\
        \    path /run/git.sock\n\
        \  }\n\
         }";
      `P "Ask for the service designated by another directive of the file:";
      `Pre
        "\\$ bcfg query 'service\\(@\\(default[0]\\)\\).listen[0]' services.cfg\n\
         80\n\
         443";
      `P "Produce a CSV summary with $(b,jq):";
      `Pre
        "\\$ bcfg query -o json 'service[0]' services.cfg \\\\\n\
        \  | jq -r 'to_entries[]\n\
        \           | [ .key, \\([.value.listen] | flatten | join\\(\" \
         \"\\)\\) ]\n\
        \           | @csv'\n\
         \"www.example.org\",\"80 443\"\n\
         \"git.example.org\",\"22\"\n\
         \"static.example.org\",\"80\"";
      `S Manpage.s_see_also;
      `P "$(b,bcfg-validate)(1), $(b,bcfg-lint)(1), $(b,bcfg-iso)(1)";
    ]
  in
  let info = Cmd.info "query" ~doc ~man in
  Cmd.v info term