Skip to content

Commit

Permalink
env: add '--raw' flag to output as environment variable bindings
Browse files Browse the repository at this point in the history
  • Loading branch information
rjbou committed Dec 3, 2024
1 parent ff46b96 commit 17cd038
Show file tree
Hide file tree
Showing 5 changed files with 85 additions and 32 deletions.
1 change: 1 addition & 0 deletions master_changes.md
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,7 @@ users)
## Clean

## Env
* [NEW] Add `--raw` option to output env as environment variable binding, useful for CI environment populating [#6316 @rjbou - fix #5791]

## Opamfile

Expand Down
29 changes: 18 additions & 11 deletions src/client/opamCommands.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1302,9 +1302,15 @@ let option cli =
$global_options cli $fieldvalue $global cli)

module Common_config_flags = struct
let sexp cli =
mk_flag ~cli cli_original ["sexp"]
"Print environment as an s-expression rather than in shell format"
let env_format cli =
mk_vflag ~cli None [
cli_original, Some `sexp, ["sexp"],
"Print environment as an s-expression rather than in shell format";
cli_from cli2_4, Some `raw, ["raw"],
"Print environment as variable bindings rather than in shell format.\
Useful to populate CI environment."
]


let inplace_path cli =
mk_flag ~cli cli_original ["inplace-path"]
Expand Down Expand Up @@ -1402,7 +1408,7 @@ let config cli =
let open Common_config_flags in

let config global_options
command shell sexp inplace_path
command shell env_format inplace_path
set_opamroot set_opamswitch params () =
apply_global_options cli global_options;
let shell = match shell with
Expand All @@ -1418,7 +1424,7 @@ let config cli =
| Some sw ->
`Ok (OpamConfigCommand.env gt sw
~set_opamroot ~set_opamswitch
~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish)
~csh:(shell=SH_csh) ~env_format ~fish:(shell=SH_fish)
~pwsh ~cmd:(shell=SH_cmd)
~inplace_path))
| Some `revert_env, [] ->
Expand All @@ -1428,7 +1434,7 @@ let config cli =
| Some sw ->
`Ok (OpamConfigCommand.ensure_env gt sw;
OpamConfigCommand.print_eval_env
~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish)
~csh:(shell=SH_csh) ~env_format ~fish:(shell=SH_fish)
~pwsh ~cmd:(shell=SH_cmd)
(OpamEnv.add [] [])))
| Some `list, [] ->
Expand Down Expand Up @@ -1640,7 +1646,8 @@ let config cli =

mk_command_ret ~cli cli_original "config" ~doc ~man
Term.(const config
$global_options cli $command $shell_opt cli cli_original $sexp cli
$global_options cli $command $shell_opt cli cli_original
$env_format cli
$inplace_path cli
$set_opamroot cli $set_opamswitch cli
$params)
Expand Down Expand Up @@ -1711,7 +1718,7 @@ let env cli =
after printing the list of not up-to-date variables."
in
let env
global_options shell sexp inplace_path set_opamroot set_opamswitch
global_options shell env_format inplace_path set_opamroot set_opamswitch
revert check () =
apply_global_options cli global_options;
if check then
Expand All @@ -1733,19 +1740,19 @@ let env cli =
| Some sw ->
OpamConfigCommand.env gt sw
~set_opamroot ~set_opamswitch
~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish)
~csh:(shell=SH_csh) ~env_format ~fish:(shell=SH_fish)
~pwsh ~cmd:(shell=SH_cmd)
~inplace_path);
| true ->
OpamConfigCommand.print_eval_env
~csh:(shell=SH_csh) ~sexp ~fish:(shell=SH_fish)
~csh:(shell=SH_csh) ~env_format ~fish:(shell=SH_fish)
~pwsh ~cmd:(shell=SH_cmd)
(OpamEnv.add [] [])
in
let open Common_config_flags in
mk_command ~cli cli_original "env" ~doc ~man
Term.(const env
$global_options cli $shell_opt cli cli_original $sexp cli
$global_options cli $shell_opt cli cli_original $env_format cli
$inplace_path cli $set_opamroot cli $set_opamswitch cli
$revert $check)

Expand Down
42 changes: 28 additions & 14 deletions src/client/opamConfigCommand.ml
Original file line number Diff line number Diff line change
Expand Up @@ -130,6 +130,16 @@ let print_sexp_env output env =
aux env;
output ")\n"

let print_raw_env output env =
let rec aux = function
| [] -> ()
| (k, v, _) :: r ->
if name_not_in_env k r then
Printf.ksprintf output "%s=%s\n" k v;
aux r
in
aux env

let rec print_fish_env output env =
let set_arr_cmd ?(modf=fun x -> x) k v =
let v = modf @@ OpamStd.String.split v ':' in
Expand Down Expand Up @@ -182,7 +192,7 @@ let print_without_cr s =
output_string stdout s;
flush stdout

let print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env =
let print_eval_env ~csh ~env_format ~fish ~pwsh ~cmd env =
let env = (env : OpamTypes.env :> (string * string * string option) list) in
let output_normally = OpamConsole.msg "%s" in
let never_with_cr =
Expand All @@ -191,18 +201,22 @@ let print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env =
else
output_normally
in
if sexp then
match env_format with
| Some `sexp ->
print_sexp_env output_normally env
else if csh then
print_csh_env never_with_cr env
else if fish then
print_fish_env never_with_cr env
else if pwsh then
print_pwsh_env output_normally env
else if cmd then
print_cmd_env output_normally env
else
print_env never_with_cr env
| Some `raw ->
print_raw_env output_normally env
| None ->
if csh then
print_csh_env never_with_cr env
else if fish then
print_fish_env never_with_cr env
else if pwsh then
print_pwsh_env output_normally env
else if cmd then
print_cmd_env output_normally env
else
print_env never_with_cr env

let check_writeable l =
let map_writeable ({OpamTypes.envu_op; _} as update) =
Expand Down Expand Up @@ -330,7 +344,7 @@ let ensure_env gt switch =
ignore (ensure_env_aux gt switch)

let env gt switch ?(set_opamroot=false) ?(set_opamswitch=false)
~csh ~sexp ~fish ~pwsh ~cmd ~inplace_path =
~csh ~env_format ~fish ~pwsh ~cmd ~inplace_path =
log "config-env";
let opamroot_not_current =
let current = gt.root in
Expand Down Expand Up @@ -370,7 +384,7 @@ let env gt switch ?(set_opamroot=false) ?(set_opamswitch=false)
let env =
ensure_env_aux ~set_opamroot ~set_opamswitch ~force_path gt switch
in
print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env
print_eval_env ~csh ~env_format ~fish ~pwsh ~cmd env
[@@ocaml.warning "-16"]

let subst gt fs =
Expand Down
19 changes: 12 additions & 7 deletions src/client/opamConfigCommand.mli
Original file line number Diff line number Diff line change
Expand Up @@ -16,23 +16,28 @@ open OpamStateTypes

(** {2 `opam config` subcommand and their associated commands } *)

(** Display the current environment. Booleans csh, sexp and fish set an
alternative output (unspecified if more than one is true, sh-style by
default). [inplace_path] changes how the PATH variable is updated when there
is already an opam entry: either at the same rank, or pushed in front. *)
(** Display the current environment. Booleans [csh], [env_format] and [fish]
set an alternative output (unspecified if more than one is true, sh-style
by default). [inplace_path] changes how the PATH variable is updated when
there is already an opam entry: either at the same rank, or pushed in
front. *)
val env:
'a global_state -> switch ->
?set_opamroot:bool -> ?set_opamswitch:bool ->
csh:bool -> sexp:bool -> fish:bool -> pwsh:bool -> cmd:bool ->
inplace_path:bool -> unit
csh:bool -> env_format:[< `sexp | `raw ] option -> fish:bool ->
pwsh:bool -> cmd:bool -> inplace_path:bool ->
unit

(** Ensures that the environment file exists in the given switch, regenerating
it, if necessary. *)
val ensure_env: 'a global_state -> switch -> unit

(** Like [env] but allows one to specify the precise env to print rather than
compute it from a switch state *)
val print_eval_env: csh:bool -> sexp:bool -> fish:bool -> pwsh:bool -> cmd:bool -> env -> unit
val print_eval_env:
csh:bool -> env_format:[< `sexp | `raw ] option -> fish:bool -> pwsh:bool ->
cmd:bool -> env
-> unit

(** Display the content of all available packages variables *)
val list: 'a switch_state -> name list -> unit
Expand Down
26 changes: 26 additions & 0 deletions tests/reftests/env.test
Original file line number Diff line number Diff line change
Expand Up @@ -651,3 +651,29 @@ OPAM_PACKAGE_NAME=another-package
OPAM_PACKAGE_VERSION=another-version
OPAM_SWITCH_PREFIX=${BASEDIR}/OPAM/bd
PATH=${BASEDIR}/OPAM/bd/bin:another-path
### : opam env outputs :
### opam switch create outputs --empty
### <pkg:op.1>
opam-version: "2.0"
setenv: [ PKGVAR = "piou"]
### opam install op -y
The following actions will be performed:
=== install 1 package
- install op 1

<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
-> installed op.1
Done.
### opam exec -- opam env --sexp | grep -v "OPAM_LAST_ENV|MANPATH|PATH"
(
("OPAM_SWITCH_PREFIX" "${BASEDIR}/OPAM/outputs")
("PKGVAR" "piou")
)
### opam exec -- opam env --raw | grep -v "OPAM_LAST_ENV|MANPATH|PATH"
OPAM_SWITCH_PREFIX=${BASEDIR}/OPAM/outputs
PKGVAR=piou
### opam exec -- opam env --raw --sexp
opam: options '--sexp' and '--raw' cannot be present at the same time
Usage: opam env [OPTION]…
Try 'opam env --help' or 'opam --help' for more information.
# Return code 2 #

0 comments on commit 17cd038

Please sign in to comment.