Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Do not use opam-installer to copy files #941

Merged
6 commits merged into from Jul 3, 2018
Merged

Do not use opam-installer to copy files #941

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
43f6ebb
Implement parsing of .install files
jeremiedimino Jul 2, 2018
56e6e04
Implement dune install without opam-installer
jeremiedimino Jul 2, 2018
5ab1f32
Simplify printing of errors
jeremiedimino Jul 3, 2018
cf3fcc5
Explicitly set/unset executable bits
jeremiedimino Jul 3, 2018
d24f3cf
Update printing
jeremiedimino Jul 3, 2018
6fdd06d
Added a comment
jeremiedimino Jul 3, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,8 @@ next

- Add `%{profile}` variable. (#938, @rgrinberg)

- Do not require opam-installer anymore (#941, @diml)

1.0+beta20 (10/04/2018)
-----------------------

Expand Down
85 changes: 59 additions & 26 deletions bin/main.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1053,16 +1053,6 @@ let rules =
& Arg.info [] ~docv:"TARGET"))
, Term.info "rules" ~doc ~man)

let opam_installer () =
match Bin.which "opam-installer" with
| None ->
die "\
Sorry, you need the opam-installer tool to be able to install or
uninstall packages.

I couldn't find the opam-installer binary :-("
| Some fn -> fn

let get_prefix context ~from_command_line =
match from_command_line with
| Some p -> Fiber.return (Path.of_string p)
Expand All @@ -1073,14 +1063,23 @@ let get_libdir context ~libdir_from_command_line =
| Some p -> Fiber.return (Some (Path.of_string p))
| None -> Context.install_ocaml_libdir context

let print_unix_error f =
try
f ()
with Unix.Unix_error (e, _, _) ->
Format.eprintf "@{<error>Error@}: %s@."
(Unix.error_message e)

let set_executable_bits x = x lor 0o111
let clear_executable_bits x = x land (lnot 0o111)

let install_uninstall ~what =
let doc =
sprintf "%s packages using opam-installer." (String.capitalize what)
in
let name_ = Arg.info [] ~docv:"PACKAGE" in
let go common prefix_from_command_line libdir_from_command_line pkgs =
set_common common ~targets:[];
let opam_installer = opam_installer () in
let log = Log.create common in
Scheduler.go ~log ~common
(Main.setup ~log common >>= fun setup ->
Expand All @@ -1095,7 +1094,7 @@ let install_uninstall ~what =
List.map setup.contexts ~f:(fun ctx ->
let fn = Path.append ctx.Context.build_dir fn in
if Path.exists fn then
Left (ctx, fn)
Left (ctx, (pkg, fn))
else
Right fn))
|> List.partition_map ~f:(fun x -> x)
Expand All @@ -1121,23 +1120,57 @@ let install_uninstall ~what =
in
Fiber.parallel_iter install_files_by_context
~f:(fun (context, install_files) ->
let install_files_set = Path.Set.of_list install_files in
get_prefix context ~from_command_line:prefix_from_command_line
>>= fun prefix ->
get_libdir context ~libdir_from_command_line
>>= fun libdir ->
Fiber.parallel_iter install_files ~f:(fun path ->
let purpose = Process.Build_job install_files_set in
Process.run ~purpose ~env:setup.env Strict opam_installer
([ sprintf "-%c" what.[0]
; Path.to_string path
; "--prefix"
; Path.to_string prefix
] @
match libdir with
| None -> []
| Some p -> [ "--libdir"; Path.to_string p ]
))))
>>| fun libdir ->
List.iter install_files ~f:(fun (package, path) ->
let entries = Install.load_install_file path in
let paths =
Install.Section.Paths.make
~package
~destdir:prefix
?libdir
()
in
let files_deleted_in = ref Path.Set.empty in
List.iter entries ~f:(fun { Install.Entry. src; dst; section } ->
let src = src in
let dst = Option.value dst ~default:(Path.basename src) in
let dst =
Path.relative (Install.Section.Paths.get paths section) dst
in
let dir = Path.parent_exn dst in
if what = "install" then begin
Printf.eprintf "Installing %s\n%!"
(Path.to_string_maybe_quoted dst);
Path.mkdir_p dir;
Io.copy_file () ~src ~dst
~chmod:(
if Install.Section.should_set_executable_bit section then
set_executable_bits
else
clear_executable_bits)
end else begin
if Path.exists dst then begin
Printf.eprintf "Deleting %s\n%!"
(Path.to_string_maybe_quoted dst);
print_unix_error (fun () -> Path.unlink dst)
end;
files_deleted_in := Path.Set.add !files_deleted_in dir;
end;
Path.Set.to_list !files_deleted_in
(* This [List.rev] is to ensure we process children
directories before their parents *)
|> List.rev
|> List.iter ~f:(fun dir ->
if Path.exists dir then
match Path.readdir_unsorted dir with
| [] ->
Printf.eprintf "Deleting empty directory %s\n%!"
(Path.to_string_maybe_quoted dst);
print_unix_error (fun () -> Path.rmdir dir)
| _ -> ())))))
in
( Term.(const go
$ common
Expand Down
6 changes: 3 additions & 3 deletions src/action.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -637,7 +637,7 @@ module Promotion = struct
Format.eprintf "Promoting %s to %s.@."
(Path.to_string_maybe_quoted src)
(Path.to_string_maybe_quoted dst);
Io.copy_file ~src ~dst
Io.copy_file ~src ~dst ()
end

module P = Utils.Persistent(struct
Expand Down Expand Up @@ -785,11 +785,11 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
Io.copy_channels ic oc);
Fiber.return ()
| Copy (src, dst) ->
Io.copy_file ~src ~dst;
Io.copy_file ~src ~dst ();
Fiber.return ()
| Symlink (src, dst) ->
if Sys.win32 then
Io.copy_file ~src ~dst
Io.copy_file ~src ~dst ()
else begin
let src =
match Path.parent dst with
Expand Down
2 changes: 1 addition & 1 deletion src/build_system.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -826,7 +826,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
Utils.Cached_digest.file in_source_tree) then begin
if mode = Promote_but_delete_on_clean then
Promoted_to_delete.add in_source_tree;
Io.copy_file ~src:path ~dst:in_source_tree
Io.copy_file ~src:path ~dst:in_source_tree ()
end)
end;
t.hook Rule_completed
Expand Down
173 changes: 138 additions & 35 deletions src/install.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,21 @@ module Section = struct
| Man -> "man"
| Misc -> "misc"

let of_string = function
| "lib" -> Some Lib
| "libexec" -> Some Libexec
| "bin" -> Some Bin
| "sbin" -> Some Sbin
| "toplevel" -> Some Toplevel
| "share" -> Some Share
| "share_root" -> Some Share_root
| "etc" -> Some Etc
| "doc" -> Some Doc
| "stublibs" -> Some Stublibs
| "man" -> Some Man
| "misc" -> Some Misc
| _ -> None

let t =
let open Sexp.Of_sexp in
enum
Expand All @@ -48,35 +63,65 @@ module Section = struct
; "misc" , Misc
]

let should_set_executable_bit = function
| Lib -> false
| Libexec -> true
| Bin -> true
| Sbin -> true
| Toplevel -> false
| Share -> false
| Share_root -> false
| Etc -> false
| Doc -> false
| Stublibs -> true
| Man -> false
| Misc -> false

module Paths = struct
let lib = Path.in_source "lib"
let libexec = Path.in_source "lib"
let bin = Path.in_source "bin"
let sbin = Path.in_source "sbin"
let toplevel = Path.in_source "lib/toplevel"
let share = Path.in_source "share"
let share_root = Path.in_source "share_root"
let etc = Path.in_source "etc"
let doc = Path.in_source "doc"
let stublibs = Path.in_source "lib/stublibs"
let man = Path.in_source "man"
end
type t =
{ lib : Path.t
; libexec : Path.t
; bin : Path.t
; sbin : Path.t
; toplevel : Path.t
; share : Path.t
; share_root : Path.t
; etc : Path.t
; doc : Path.t
; stublibs : Path.t
; man : Path.t
}

let install_dir t ~(package : Package.Name.t) =
let package = Package.Name.to_string package in
match t with
| Bin -> Paths.bin
| Sbin -> Paths.sbin
| Toplevel -> Paths.toplevel
| Share_root -> Paths.share_root
| Stublibs -> Paths.stublibs
| Man -> Paths.man
| Lib -> Path.relative Paths.lib package
| Libexec -> Path.relative Paths.libexec package
| Share -> Path.relative Paths.share package
| Etc -> Path.relative Paths.etc package
| Doc -> Path.relative Paths.doc package
| Misc -> invalid_arg "Install.Section.install_dir"
let make ~package ~destdir ?(libdir=Path.relative destdir "lib") () =
let package = Package.Name.to_string package in
{ bin = Path.relative destdir "bin"
; sbin = Path.relative destdir "sbin"
; toplevel = Path.relative libdir "toplevel"
; share_root = Path.relative libdir "share"
; stublibs = Path.relative libdir "lib/stublibs"
; man = Path.relative destdir "man"
; lib = Path.relative libdir package
; libexec = Path.relative libdir package
; share = Path.relative destdir ("share/" ^ package)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is it OK to concatenate paths like this? I guess package is normalized already (so it does not contain slashes or ".."), but also does it work on windows?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There might be an issue here. However we were doing the same before and we have had no issue so far. I guess we could add a few more constraints on package names

; etc = Path.relative destdir ("etc/" ^ package)
; doc = Path.relative destdir ("doc/" ^ package)
}

let get t section =
match section with
| Lib -> t.lib
| Libexec -> t.libexec
| Bin -> t.bin
| Sbin -> t.sbin
| Toplevel -> t.toplevel
| Share -> t.share
| Share_root -> t.share_root
| Etc -> t.etc
| Doc -> t.doc
| Stublibs -> t.stublibs
| Man -> t.man
| Misc -> invalid_arg "Install.Paths.get"
end
end

module Entry = struct
Expand Down Expand Up @@ -112,8 +157,8 @@ module Entry = struct

let set_src t src = { t with src }

let relative_installed_path t ~package =
let main_dir = Section.install_dir t.section ~package in
let relative_installed_path t ~paths =
let main_dir = Section.Paths.get paths t.section in
let dst =
match t.dst with
| Some x -> x
Expand All @@ -129,15 +174,14 @@ module Entry = struct
in
Path.relative main_dir dst

let add_install_prefix t ~package ~prefix =
let opam_will_install_in_this_dir =
Section.install_dir t.section ~package
in
let add_install_prefix t ~paths ~prefix =
let opam_will_install_in_this_dir = Section.Paths.get paths t.section in
let i_want_to_install_the_file_as =
Path.append prefix (relative_installed_path t ~package)
Path.append prefix (relative_installed_path t ~paths)
in
let dst =
Path.reach i_want_to_install_the_file_as ~from:opam_will_install_in_this_dir
Path.reach i_want_to_install_the_file_as
~from:opam_will_install_in_this_dir
in
{ t with dst = Some dst }
end
Expand Down Expand Up @@ -165,3 +209,62 @@ let gen_install_file entries =
| Some dst -> pr " %S {%S}" src dst);
pr "]");
Buffer.contents buf

let pos_of_opam_value : OpamParserTypes.value -> OpamParserTypes.pos = function
| Bool (pos, _) -> pos
| Int (pos, _) -> pos
| String (pos, _) -> pos
| Relop (pos, _, _, _) -> pos
| Prefix_relop (pos, _, _) -> pos
| Logop (pos, _, _, _) -> pos
| Pfxop (pos, _, _) -> pos
| Ident (pos, _) -> pos
| List (pos, _) -> pos
| Group (pos, _) -> pos
| Option (pos, _, _) -> pos
| Env_binding (pos, _, _, _) -> pos

let load_install_file path =
let open OpamParserTypes in
let file = Opam_file.load path in
let fail (fname, line, col) fmt =
let pos : Lexing.position =
{ pos_fname = fname
; pos_lnum = line
; pos_bol = 0
; pos_cnum = col
}
in
Loc.fail { start = pos; stop = pos } fmt
in
List.concat_map file.file_contents ~f:(function
| Variable (pos, section, files) -> begin
match Section.of_string section with
| None -> fail pos "Unknown install section"
| Some section -> begin
match files with
| List (_, l) ->
List.map l ~f:(function
| String (_, src) ->
{ Entry.
src = Path.of_string src
; dst = None
; section
}
| Option (_, String (_, src),
[String (_, dst)]) ->
{ Entry.
src = Path.of_string src
; dst = Some dst
; section
}
| v ->
fail (pos_of_opam_value v)
"Invalid value in .install file")
| v ->
fail (pos_of_opam_value v)
"Invalid value for install section"
end
end
| Section (pos, _) ->
fail pos "Sections are not allowed in .install file")
Loading