Merge pull request #3350 from dra27/windows-filenames

Deal with Windows path conventions (backslashes, .exe, etc.)

src/client/opamAction.ml

@@ -22,6 +22,23 @@ module PackageActionGraph = OpamSolver.ActionGraph
 (* Install the package files *)
 let process_dot_install st nv build_dir =
   let root = st.switch_global.root in
+  let (warning, had_windows_warnings) =
+    if OpamFormatConfig.(!r.strict) then
+      let had_warnings = ref false in
+      let install_warning dst warning =
+        let () =
+          match warning with
+          | `Add_exe | `Install_script | `Cygwin | `Cygwin_libraries ->
+            had_warnings := true
+          | _ ->
+            ()
+        in
+        OpamSystem.default_install_warning dst warning
+      in
+      (install_warning, (fun () -> !had_warnings))
+    else
+      (OpamSystem.default_install_warning, (fun () -> false))
+  in
   if OpamStateConfig.(!r.dryrun) then
     OpamConsole.msg "Installing %s.\n" (OpamPackage.to_string nv)
   else
@@ -66,12 +83,28 @@ let process_dot_install st nv build_dir =
           OpamFilename.mkdir dst_dir;
         );
         List.iter (fun (base, dst) ->
+            let (base, append) =
+              if exec && not (OpamFilename.exists (OpamFilename.create build_dir base.c)) then
+                let base' =
+                  {base with c = OpamFilename.Base.add_extension base.c "exe"} in
+                if OpamFilename.exists (OpamFilename.create build_dir base'.c) then begin
+                  OpamConsole.warning ".install file is missing .exe extension for %s" (OpamFilename.Base.to_string base.c);
+                  (base', true)
+                end else
+                  (base, false)
+              else
+                (base, false) in
             let src_file = OpamFilename.create build_dir base.c in
+            if append then warning (OpamFilename.to_string src_file) `Add_exe;
             let dst_file = match dst with
               | None   -> OpamFilename.create dst_dir (OpamFilename.basename src_file)
-              | Some d -> OpamFilename.create dst_dir d in
+              | Some d ->
+                  if append && not (OpamFilename.Base.check_suffix d ".exe") then
+                    OpamFilename.create dst_dir (OpamFilename.Base.add_extension d "exe")
+                  else
+                    OpamFilename.create dst_dir d in
             if check ~src:build_dir ~dst:dst_dir base then
-              OpamFilename.install ~exec ~src:src_file ~dst:dst_file ();
+              OpamFilename.install ~warning ~exec ~src:src_file ~dst:dst_file ();
           ) files in
 
       let module P = OpamPath.Switch in
@@ -115,12 +148,12 @@ let process_dot_install st nv build_dir =
           let src_file = OpamFilename.create (OpamFilename.cwd ()) src.c in
           if OpamFilename.exists dst
           && OpamConsole.confirm "Overwriting %s?" (OpamFilename.to_string dst) then
-            OpamFilename.install ~src:src_file ~dst ()
+            OpamFilename.install ~warning ~src:src_file ~dst ()
           else begin
             OpamConsole.msg "Installing %s to %s.\n"
               (OpamFilename.Base.to_string src.c) (OpamFilename.to_string dst);
             if OpamConsole.confirm "Continue?" then
-              OpamFilename.install ~src:src_file ~dst ()
+              OpamFilename.install ~warning ~src:src_file ~dst ()
           end
         ) (I.misc install);
 
@@ -138,7 +171,10 @@ let process_dot_install st nv build_dir =
             (String.concat "" (List.map print !warnings))
         in
         failwith msg
-      )
+      );
+
+      if had_windows_warnings () then
+        failwith "Strict mode is enabled - previous warnings considered fatal"
     )
 
 let download_package st nv =

src/core/opamFilename.ml

@@ -186,10 +186,18 @@ let open_in filename =
   try open_in (to_string filename)
   with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
 
+let open_in_bin filename =
+  try open_in_bin (to_string filename)
+  with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
+
 let open_out filename =
   try open_out (to_string filename)
   with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
 
+let open_out_bin filename =
+  try open_out_bin (to_string filename)
+  with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
+
 let write filename raw =
   OpamSystem.write (to_string filename) raw
 
@@ -229,8 +237,8 @@ let copy ~src ~dst =
 let copy_dir ~src ~dst =
   if src <> dst then OpamSystem.copy_dir (Dir.to_string src) (Dir.to_string dst)
 
-let install ?exec ~src ~dst () =
-  if src <> dst then OpamSystem.install ?exec (to_string src) (to_string dst)
+let install ?warning ?exec ~src ~dst () =
+  if src <> dst then OpamSystem.install ?warning ?exec (to_string src) (to_string dst)
 
 let move ~src ~dst =
   if src <> dst then

src/core/opamFilename.mli

@@ -136,7 +136,9 @@ val read: t -> string
 
 (** Open a channel from a given file. *)
 val open_in: t -> in_channel
+val open_in_bin: t -> in_channel
 val open_out: t -> out_channel
+val open_out_bin: t -> out_channel
 
 (** Removes everything in [filename] if existed. *)
 val remove: t -> unit
@@ -193,7 +195,7 @@ val copy: src:t -> dst:t -> unit
 
 (** Installs a file to a destination. Optionally set if the destination should
     be set executable *)
-val install: ?exec:bool -> src:t -> dst:t -> unit -> unit
+val install: ?warning:OpamSystem.install_warning_fn -> ?exec:bool -> src:t -> dst:t -> unit -> unit
 
 (** Symlink a file. If symlink is not possible on the system, use copy instead.
     With [relative], creates a relative link through the closest common ancestor

src/core/opamSystem.ml

@@ -11,6 +11,10 @@
 
 open OpamCompat
 
+type install_warning =
+  [ `Add_exe | `Install_dll | `Install_script | `Install_unknown | `Cygwin | `Cygwin_libraries ]
+type install_warning_fn = string -> install_warning -> unit
+
 exception Process_error of OpamProcess.result
 exception Internal_error of string
 exception Command_not_found of string
@@ -526,7 +530,13 @@ let read_command_output ?verbose ?env ?metadata ?allow_stdin cmd =
 let verbose_for_base_commands () =
   OpamCoreConfig.(!r.verbose_level) >= 3
 
-let copy_file src dst =
+let cygify f =
+  if Sys.win32 then
+    List.map (Lazy.force f)
+  else
+    fun x -> x
+
+let copy_file_aux f src dst =
   if (try Sys.is_directory src
       with Sys_error _ -> raise (File_not_found src))
   then internal_error "Cannot copy %s: it is a directory." src;
@@ -535,7 +545,9 @@ let copy_file src dst =
   if file_or_symlink_exists dst
   then remove_file dst;
   mkdir (Filename.dirname dst);
-  command ~verbose:(verbose_for_base_commands ()) ["cp"; src; dst ]
+  command ~verbose:(verbose_for_base_commands ()) ("cp"::(cygify f [src; dst]))
+
+let copy_file = copy_file_aux (get_cygpath_function ~command:"cp")
 
 let copy_dir src dst =
   if Sys.file_exists dst then
@@ -552,10 +564,12 @@ let copy_dir src dst =
      command ~verbose:(verbose_for_base_commands ())
        [ "cp"; "-PRp"; src; dst ])
 
-let mv src dst =
+let mv_aux f src dst =
   if file_or_symlink_exists dst then remove_file dst;
   mkdir (Filename.dirname dst);
-  command ~verbose:(verbose_for_base_commands ()) ["mv"; src; dst ]
+  command ~verbose:(verbose_for_base_commands ()) ("mv"::(cygify f [src; dst]))
+
+let mv = mv_aux (get_cygpath_function ~command:"mv")
 
 let is_exec file =
   let stat = Unix.stat file in
@@ -564,7 +578,90 @@ let is_exec file =
 
 let file_is_empty f = Unix.((stat f).st_size = 0)
 
-let install ?exec src dst =
+let classify_executable file =
+  let c = open_in file in
+  (* On a 32-bit system, this could fail for a PE image with a 2GB+ DOS header =-o *)
+  let input_int_little c =
+    let b1 = input_byte c in
+    let b2 = input_byte c in
+    let b3 = input_byte c in
+    let b4 = input_byte c in
+    b1 lor (b2 lsl 8) lor (b3 lsl 16) lor (b4 lsl 24) in
+  let input_short_little c =
+    let b1 = input_byte c in
+    let b2 = input_byte c in
+    b1 lor (b2 lsl 8) in
+  set_binary_mode_in c true;
+  try
+    match really_input_string c 2 with
+      "#!" ->
+        close_in c;
+        `Script
+    | "MZ" ->
+        let is_pe =
+          try
+            (* Offset to PE header at 0x3c (but we've already read two bytes) *)
+            ignore (really_input_string c 0x3a);
+            ignore (really_input_string c (input_int_little c - 0x40));
+            let magic = really_input_string c 4 in
+            magic = "PE\000\000"
+          with End_of_file ->
+            close_in c;
+            false in
+        if is_pe then
+          try
+            let arch =
+              (* NB It's not necessary to determine PE/PE+ headers for x64/x86 determination *)
+              match input_short_little c with
+                0x8664 ->
+                  `x86_64
+              | 0x14c ->
+                  `x86
+              | _ ->
+                  raise End_of_file
+            in
+            ignore (really_input_string c 14);
+            let size_of_opt_header = input_short_little c in
+            let characteristics = input_short_little c in
+            (* Executable images must have a PE "optional" header and be marked executable *)
+            (* Could also validate IMAGE_FILE_32BIT_MACHINE (0x100) for x86 and IMAGE_FILE_LARGE_ADDRESS_AWARE (0x20) for x64 *)
+            if size_of_opt_header <= 0 || characteristics land 0x2 = 0 then
+              raise End_of_file;
+            close_in c;
+            if characteristics land 0x2000 <> 0 then
+              `Dll arch
+            else
+              `Exe arch
+          with End_of_file ->
+            close_in c;
+            `Unknown
+        else
+          `Exe `i386
+    | _ ->
+        close_in c;
+        `Unknown
+  with End_of_file ->
+    close_in c;
+    `Unknown
+
+let default_install_warning dst = function
+| `Add_exe ->
+    OpamConsole.warning "Automatically adding .exe to %s" dst
+| `Install_dll ->
+    (* TODO Installation of .dll to bin is unfortunate, but not sure if it should be a warning *)
+    ()
+| `Install_script ->
+    (* TODO Generate a .cmd wrapper (and warn about it - they're not perfect) *)
+    OpamConsole.warning "%s is a script; the command won't be available" dst;
+| `Install_unknown ->
+    (* TODO Installation of a non-executable file is unexpected, but not sure if it should be a warning/error *)
+    ()
+| `Cygwin ->
+    OpamConsole.warning "%s is a Cygwin-linked executable" dst
+| `Cygwin_libraries ->
+    OpamConsole.warning "%s links with a Cygwin-compiled DLL (almost certainly a packaging or environment error)" dst
+
+let install ?(warning=default_install_warning) ?exec src dst =
   if Sys.is_directory src then
     internal_error "Cannot install %s: it is a directory." src;
   if (try Sys.is_directory dst with Sys_error _ -> false) then
@@ -573,8 +670,42 @@ let install ?exec src dst =
   let exec = match exec with
     | Some e -> e
     | None -> is_exec src in
-  command ("install" :: "-m" :: (if exec then "0755" else "0644") ::
-     [ src; dst ])
+  begin
+    if Sys.win32 then
+      if exec then begin
+        let (dst, cygcheck) =
+          match classify_executable src with
+            `Exe _ ->
+              if not (Filename.check_suffix dst ".exe") && not (Filename.check_suffix dst ".dll") then begin
+                warning dst `Add_exe;
+                (dst ^ ".exe", true)
+              end else
+                (dst, true)
+          | `Dll _ ->
+              warning dst `Install_dll;
+              (dst, true)
+          | `Script ->
+              warning dst `Install_script;
+              (dst, false)
+          | `Unknown ->
+              warning dst `Install_unknown;
+              (dst, false)
+        in
+        copy_file src dst;
+        if cygcheck then
+          match OpamStd.Sys.is_cygwin_variant dst with
+            `Native ->
+              ()
+          | `Cygwin ->
+              warning dst `Cygwin
+          | `CygLinked ->
+              warning dst `Cygwin_libraries
+      end else
+        copy_file src dst
+    else
+      command ("install" :: "-m" :: (if exec then "0755" else "0644") ::
+         [ src; dst ])
+  end
 
 let cpu_count () =
   try

src/core/opamSystem.mli

@@ -54,10 +54,24 @@ val copy_dir: string -> string -> unit
 
 val mv: string -> string -> unit
 
+type install_warning = [ `Add_exe          (* [.exe] had to be added *)
+                       | `Install_dll      (* Installation of [.dll] to bin/libexec *)
+                       | `Install_script   (* Installation of script on Windows *)
+                       | `Install_unknown  (* Installation of unknown file to bin/libexec *)
+                       | `Cygwin           (* Installation of a Cygwin-linked executable *)
+                       | `Cygwin_libraries (* Installation of a binary linked to a Cygwin library *)
+                       ]
+(** Warnings which come from {!install} *)
+
+type install_warning_fn = string -> install_warning -> unit
+
+val default_install_warning : install_warning_fn
+(** The default warning function - displays a message on OpamConsole *)
+
 (** [install ?exec src dst] copies file [src] as file [dst] using [install].
     If [exec], make the resulting file executable (otherwise, look at the
     permissions of the original file to decide). *)
-val install: ?exec:bool -> string -> string -> unit
+val install: ?warning:install_warning_fn -> ?exec:bool -> string -> string -> unit
 
 (** Checks if a file is an executable (regular file with execution
     permission) *)
@@ -286,3 +300,12 @@ val forward_to_back : string -> string
 
 (** On Unix, a no-op. On Windows, convert \ to / *)
 val back_to_forward : string -> string
+
+(** Identifies kinds of executable files. At present, only useful on Windows.
+    Executable or DLLs are recognised based on their content, not on their
+    filename. Any file beginning "#!" is assumed to be a shell script and all
+    files are classified [`Unknown]. *)
+val classify_executable : string -> [ `Exe of [ `i386 | `x86 | `x86_64 ]
+                                    | `Dll of [ `x86 | `x86_64 ]
+                                    | `Script
+                                    | `Unknown ]

src/format/dune

@@ -10,4 +10,4 @@
                (:include ../ocaml-context-flags.sexp)))
   (wrapped     false))
 
-(ocamllex opamLineLexer)
+(ocamllex opamLineLexer opamInterpLexer)