[m-rev.] for review: attempt to preserve file mode when copying

[Julien Fischer]

For review by anyone.

We could return any errors raised by stat() and chmod() instead of 
ignoring them, but since any such errors would have been raised when
we opened the files, it doesn't seem worth it.

-------------------------------------------

Attempt to preserve file mode when copying.

Make the Mercury implementation of copying attempt to preserve the file mode if
we are on system that supports stat() and chmod().

compiler/copy_util.m:
     As above.

configure.ac:
runtime/mercury_conf.h.in:
     Check for the presence of the chmod() function.

Julien.

diff --git a/compiler/copy_util.m b/compiler/copy_util.m
index da625c3..246611e 100644
--- a/compiler/copy_util.m
+++ b/compiler/copy_util.m
@@ -183,6 +183,7 @@ copy_file_to_directory(Globals, ProgressStream, SourceFile, DestinationDir,

  do_copy_file(Source, Destination, Res, !IO) :-
      io.open_binary_input(Source, SourceRes, !IO),
+    get_file_mode(Source, SourceFileMode, !IO),
      (
          SourceRes = ok(SourceStream),
          io.open_binary_output(Destination, DestRes, !IO),
@@ -190,7 +191,8 @@ do_copy_file(Source, Destination, Res, !IO) :-
              DestRes = ok(DestStream),
              copy_bytes(SourceStream, DestStream, Res, !IO),
              io.close_binary_input(SourceStream, !IO),
-            io.close_binary_output(DestStream, !IO)
+            io.close_binary_output(DestStream, !IO),
+            set_file_mode(Destination, SourceFileMode, !IO)
          ;
              DestRes = error(Error),
              Res = error(Error)
@@ -303,5 +305,97 @@ should_reduce_stack_usage(yes).
  ").

  %-----------------------------------------------------------------------------%
+%
+% Getting and setting file modes.
+%
+
+    % This type describes the result of retrieving a file mode.
+    %
+:- type file_mode
+    --->    unknown_file_mode
+            % The file mode is unavailable, either due an error or not being
+            % supported on this system.
+
+    ;       have_file_mode(uint64).
+            % We have a file mode, which is returned in the argument.
+            % (We return the file mode as uint64 to avoid having to
+            % conditionally define a foreign type to represent it.)
+
+:- pred get_file_mode(file_name::in, file_mode::out, io::di, io::uo) is det.
+
+get_file_mode(FileName, FileMode, !IO) :-
+    do_get_file_mode(FileName, RawFileMode, IsOk, !IO),
+    (
+        IsOk = yes,
+        FileMode = have_file_mode(RawFileMode)
+    ;
+        IsOk = no,
+        FileMode = unknown_file_mode
+    ).
+
+:- pragma foreign_decl("C", "
+#if defined(MR_HAVE_SYS_TYPES_H)
+    #include <sys/types.h>
+#endif
+#if defined(MR_HAVE_SYS_STAT_H)
+    #include <sys/stat.h>
+#endif
+#if defined(MR_HAVE_UNISTD_H)
+    #include <unistd.h>
+#endif
+").
+
+:- pred do_get_file_mode(file_name::in, uint64::out, bool::out, io::di, io::uo)
+    is det.
+
+:- pragma foreign_proc("C",
+    do_get_file_mode(FileName::in, RawFileMode::out, IsOk::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+#if defined(MR_HAVE_STAT)
+    struct stat statbuf;
+
+    if (stat(FileName, &statbuf) == 0) {
+        IsOk = MR_YES;
+        RawFileMode = statbuf.st_mode;
+    } else {
+        IsOk = MR_NO;
+        RawFileMode = 0;
+    }
+#else
+    IsOk = MR_NO;
+    RawFileMode = 0;
+#endif
+").
+
+% For the non-C backends.
+do_get_file_mode(_, 0u64, no, !IO).
+
+:- pred set_file_mode(file_name::in, file_mode::in, io::di, io::uo) is det.
+
+set_file_mode(FileName, FileMode, !IO) :-
+    (
+        FileMode = unknown_file_mode
+    ;
+        FileMode = have_file_mode(RawFileMode),
+        do_set_file_mode(FileName, RawFileMode, !IO)
+    ).
+
+:- pred do_set_file_mode(file_name::in, uint64::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    do_set_file_mode(FileName::in, RawFileMode::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+#if defined(MR_HAVE_CHMOD)
+    (void) chmod(FileName, (mode_t) RawFileMode);
+#endif
+").
+
+% For the non-C backends.
+do_set_file_mode(_, _, !IO).
+
+%-----------------------------------------------------------------------------%
  :- end_module copy_util.
  %-----------------------------------------------------------------------------%
diff --git a/configure.ac b/configure.ac
index bd1260b..fef1984 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1465,7 +1465,7 @@ mercury_check_for_functions \
          access sleep opendir readdir closedir mkdir symlink readlink \
          gettimeofday setenv putenv _putenv posix_spawn sched_setaffinity \
          sched_getaffinity sched_getcpu sched_yield mkstemp mkdtemp \
-        setrlimit getcontext dl_iterate_phdr
+        setrlimit getcontext dl_iterate_phdr chmod

  mercury_check_for_stdio_functions \
          snprintf _snprintf vsnprintf _vsnprintf
diff --git a/runtime/mercury_conf.h.in b/runtime/mercury_conf.h.in
index 168f9bc..b3a1889 100644
--- a/runtime/mercury_conf.h.in
+++ b/runtime/mercury_conf.h.in
@@ -293,6 +293,7 @@
  //  MR_HAVE_BUILTIN_BSWAP16     we have the __builtin_bswap16() function.
  //  MR_HAVE_BUILTIN_BSWAP32     we have the __builtin_bswap32() function.
  //  MR_HAVE_BUILTIN_BSWAP64     we have the __builtin_bswap64() function.
+//  MR_HAVE_CHMOD               we have the chmod() function.

  #undef  MR_HAVE_GETPID
  #undef  MR_HAVE_SETPGID
@@ -372,6 +373,7 @@
  #undef  MR_HAVE_BUILTIN_BSWAP16
  #undef  MR_HAVE_BUILTIN_BSWAP32
  #undef  MR_HAVE_BUILTIN_BSWAP64
+#undef  MR_HAVE_CHMOD

  // We use mprotect() and signals to catch stack and heap overflows.
  // In order to detect such overflows, we need to be able to figure out