emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r111251: Add support for preserving A


From: Romain Francoise
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r111251: Add support for preserving ACL entries of files.
Date: Sun, 16 Dec 2012 19:22:27 +0100
User-agent: Bazaar (2.5.0)

------------------------------------------------------------
revno: 111251
committer: Romain Francoise <address@hidden>
branch nick: trunk
timestamp: Sun 2012-12-16 19:22:27 +0100
message:
  Add support for preserving ACL entries of files.
  
        * configure.ac (acl): New option.
        (HAVE_POSIX_ACL): Test for POSIX ACL support.  This is typically
        provided by libacl on GNU/Linux.
  
        * fileio.c (Ffile_acl, Fset_file_acl): New functions.
        (Fcopy_file): Change last arg to `preserve_extended_attributes'
        and copy ACL entries of file in addition to SELinux context if
        set.
        (syms_of_fileio): Add `file-acl' and `set-file-acl'.
  
        * Makefile.in (LIBACL_LIBS): New macro.
        (LIBES): Use it.
  
        * files.el (file-extended-attributes)
        (set-file-extended-attributes): New functions.
        (backup-buffer): Use them to handle both SELinux context and ACL
        entries.
        (backup-buffer-copy): Work with an alist of extended attributes,
        rather than an SELinux context.
        (basic-save-buffer-2): Ditto.
  
        * files.texi (File Attributes): Document ACL support and new
        `file-acl' function.
        (Changing Files): Mention argument name change of `copy-file' and
        document new function `set-file-acl'.
modified:
  ChangeLog
  configure.ac
  doc/lispref/ChangeLog
  doc/lispref/files.texi
  etc/NEWS
  lisp/ChangeLog
  lisp/files.el
  src/ChangeLog
  src/Makefile.in
  src/fileio.c
=== modified file 'ChangeLog'
--- a/ChangeLog 2012-12-14 18:59:00 +0000
+++ b/ChangeLog 2012-12-16 18:22:27 +0000
@@ -1,3 +1,9 @@
+2012-12-16  Romain Francoise  <address@hidden>
+
+       * configure.ac (acl): New option.
+       (HAVE_POSIX_ACL): Test for POSIX ACL support.  This is typically
+       provided by libacl on GNU/Linux.
+
 2012-12-14  Paul Eggert  <address@hidden>
 
        Fix permissions bugs with setgid directories etc. (Bug#13125)

=== modified file 'configure.ac'
--- a/configure.ac      2012-12-14 18:59:00 +0000
+++ b/configure.ac      2012-12-16 18:22:27 +0000
@@ -184,6 +184,7 @@
 OPTION_DEFAULT_ON([gconf],[don't compile with GConf support])
 OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support])
 OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
+OPTION_DEFAULT_ON([acl],[don't compile with ACL support])
 OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
 OPTION_DEFAULT_ON([inotify],[don't compile with inotify (file-watch) support])
 
@@ -2197,6 +2198,23 @@
   AC_DEFINE(HAVE_INOTIFY, 1, [Define to 1 to use inotify.])
 fi
 
+dnl POSIX ACL support: provided by libacl on GNU/Linux, by libc on FreeBSD.
+HAVE_POSIX_ACL=no
+LIBACL_LIBS=
+if test "${with_acl}" = "yes"; then
+  AC_CHECK_LIB([acl], [acl_set_file], HAVE_POSIX_ACL=yes, HAVE_POSIX_ACL=no)
+  if test "$HAVE_POSIX_ACL" = yes; then
+    AC_DEFINE(HAVE_POSIX_ACL, 1, [Define to 1 if using POSIX ACL support.])
+    LIBACL_LIBS=-lacl
+  else
+    AC_CHECK_FUNC(acl_set_file, HAVE_POSIX_ACL=yes, HAVE_POSIX_ACL=no)
+    if test "$HAVE_POSIX_ACL" = yes; then
+      AC_DEFINE(HAVE_POSIX_ACL, 1, [Define to 1 if using POSIX ACL support.])
+    fi
+ fi
+fi
+AC_SUBST(LIBACL_LIBS)
+
 dnl Do not put whitespace before the #include statements below.
 dnl Older compilers (eg sunos4 cc) choke on it.
 HAVE_XAW3D=no

=== modified file 'doc/lispref/ChangeLog'
--- a/doc/lispref/ChangeLog     2012-12-14 18:59:00 +0000
+++ b/doc/lispref/ChangeLog     2012-12-16 18:22:27 +0000
@@ -1,3 +1,10 @@
+2012-12-16  Romain Francoise  <address@hidden>
+
+       * files.texi (File Attributes): Document ACL support and new
+       `file-acl' function.
+       (Changing Files): Mention argument name change of `copy-file' and
+       document new function `set-file-acl'.
+
 2012-12-14  Paul Eggert  <address@hidden>
 
        Fix permissions bugs with setgid directories etc. (Bug#13125)

=== modified file 'doc/lispref/files.texi'
--- a/doc/lispref/files.texi    2012-12-14 18:59:00 +0000
+++ b/doc/lispref/files.texi    2012-12-16 18:22:27 +0000
@@ -1352,6 +1352,36 @@
 support, then the return value is @code{(nil nil nil nil)}.
 @end defun
 
address@hidden access control list
address@hidden ACL entries
+  If Emacs has been compiled with @dfn{ACL} (access control list)
+support, you can use the function @code{file-acl} to retrieve a file's
+ACL entries.  The format is platform-specific; on GNU/Linux and BSD,
+Emacs uses the POSIX ACL interface.  For the function
address@hidden, see @ref{Changing Files}.
+
address@hidden file-acl filename
+This function returns the ACL entries of the file @var{filename}.
+The return value is a string containing the textual representation of
+the ACL entries, like the following:
+
address@hidden
address@hidden
+user::rw-
+group::r--
+group:gnu:rwx
+mask::rwx
+other::r--
address@hidden group
address@hidden example
+
+If the file does not exist or is inaccessible, or if Emacs was unable to
+determine the ACL entries, then the return value is @code{nil}.  The
+latter can happen for local files if Emacs was not compiled with ACL
+support, or for remote files if the file handler returns nil for the
+file's ACL entries.
address@hidden defun
+
 @node Locating Files
 @subsection How to Locate Files in Standard Places
 @cindex locate file in path
@@ -1541,9 +1571,10 @@
 file.  This works only on some operating systems, and only if you have
 the correct permissions to do so.
 
-If the optional argument @var{preserve-selinux} is address@hidden, and
-Emacs has been compiled with SELinux support, this function attempts
-to copy the file's SELinux context (@pxref{File Attributes}).
+If the optional argument @var{preserve-extended-attributes} is
address@hidden, and Emacs has been built with the appropriate support,
+this function attempts to copy the file's extended attributes, such as
+its SELinux context and ACL entries (@pxref{File Attributes}).
 @end deffn
 
 @deffn Command make-symbolic-link filename newname  &optional ok-if-exists
@@ -1684,6 +1715,13 @@
 SELinux support.
 @end defun
 
address@hidden set-file-acl filename acl-string
+This function sets the ACL entries of the file @var{filename} to
address@hidden  @xref{File Attributes}, for a brief description of
+ACLs.  The @var{acl-string} argument should be a string containing the
+textual representation of the desired ACL entries.
address@hidden defun
+
 @node File Names
 @section File Names
 @cindex file names

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-12-16 03:17:50 +0000
+++ b/etc/NEWS  2012-12-16 18:22:27 +0000
@@ -22,6 +22,12 @@
 
 
 * Installation Changes in Emacs 24.4
+
+** Emacs can be compiled with POSIX ACL support.
+This happens by default if a suitable support library is found at
+build time, like libacl on GNU/Linux.  To prevent this, use the
+configure option `--without-acl'.
+
 * Startup Changes in Emacs 24.4
 * Changes in Emacs 24.4
 
@@ -33,6 +39,14 @@
 This unfinished feature was introduced by accident in Emacs 23.1;
 simply disabling Transient Mark mode does the same thing.
 
+** ACL support has been added.
++++
+*** Emacs preserves the ACL entries of files when backing up.
++++
+*** New functions `file-acl' and `set-file-acl' get and set the ACL
+entries of a file.  On GNU/Linux the POSIX ACL interface is used via
+libacl.
+
 * Editing Changes in Emacs 24.4
 
 ** New commands `toggle-frame-maximized' and `cycle-frame-maximized',
@@ -149,6 +163,12 @@
 VAR was bound to nil which was not tremendously useful and just lead to
 spurious warnings about an unused var.
 
+** The return value of `backup-buffer' has changed.
+The second argument is no longer an SELinux context, instead it is an
+alist of extended attributes as returned by the new function
+`file-extended-attributes'.  The attributes can be applied to another
+file using `set-file-extended-attributes'.
+
 * Lisp changes in Emacs 24.4
 
 ** Support for filesystem notifications.
@@ -186,6 +206,10 @@
 
 ** New functions `group-gid' and `group-real-gid'.
 
+** The 6th argument to `copy-file' has been renamed to
+`preserve-extended-attributes' as it now handles both SELinux context
+and ACL entries.
+
 * Changes in Emacs 24.4 on non-free operating systems
 
 +++

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-12-16 03:17:50 +0000
+++ b/lisp/ChangeLog    2012-12-16 18:22:27 +0000
@@ -1,3 +1,13 @@
+2012-12-16  Romain Francoise  <address@hidden>
+
+       * files.el (file-extended-attributes)
+       (set-file-extended-attributes): New functions.
+       (backup-buffer): Use them to handle both SELinux context and ACL
+       entries.
+       (backup-buffer-copy): Work with an alist of extended attributes,
+       rather than an SELinux context.
+       (basic-save-buffer-2): Ditto.
+
 2012-12-16  Timo Myyrä  <address@hidden>
 
        * battery.el (battery-bsd-apm): New function.

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2012-12-14 18:59:00 +0000
+++ b/lisp/files.el     2012-12-16 18:22:27 +0000
@@ -3879,6 +3879,27 @@
   ;; the one at the old location.
   (vc-find-file-hook))
 
+(defun file-extended-attributes (filename)
+  "Return an alist of extended attributes of file FILENAME.
+
+Extended attributes are platform-specific metadata about the file,
+such as SELinux context, list of ACL entries, etc."
+  `((acl . ,(file-acl filename))
+    (selinux-context . ,(file-selinux-context filename))))
+
+(defun set-file-extended-attributes (filename attributes)
+  "Set extended attributes of file FILENAME to ATTRIBUTES.
+
+ATTRIBUTES must be an alist of file attributes as returned by
+`file-extended-attributes'."
+  (dolist (elt attributes)
+    (let ((attr (car elt))
+         (val (cdr elt)))
+      (cond ((eq attr 'acl)
+            (set-file-acl filename val))
+           ((eq attr 'selinux-context)
+            (set-file-selinux-context filename val))))))
+
 (defun backup-buffer ()
   "Make a backup of the disk file visited by the current buffer, if 
appropriate.
 This is normally done before saving the buffer the first time.
@@ -3888,13 +3909,14 @@
 no longer accessible under its old name.
 
 The value is non-nil after a backup was made by renaming.
-It has the form (MODES SELINUXCONTEXT BACKUPNAME).
+It has the form (MODES EXTENDED-ATTRIBUTES BACKUPNAME).
 MODES is the result of `file-modes' on the original
 file; this means that the caller, after saving the buffer, should change
 the modes of the new file to agree with the old modes.
-SELINUXCONTEXT is the result of `file-selinux-context' on the original
-file; this means that the caller, after saving the buffer, should change
-the SELinux context of the new file to agree with the old context.
+EXTENDED-ATTRIBUTES is the result of `file-extended-attributes'
+on the original file; this means that the caller, after saving
+the buffer, should change the extended attributes of the new file
+to agree with the old attributes.
 BACKUPNAME is the backup file name, which is the old file renamed."
   (if (and make-backup-files (not backup-inhibited)
           (not buffer-backed-up)
@@ -3923,7 +3945,8 @@
                                (y-or-n-p (format "Delete excess backup 
versions of %s? "
                                                  real-file-name)))))
                      (modes (file-modes buffer-file-name))
-                     (context (file-selinux-context buffer-file-name)))
+                     (extended-attributes
+                      (file-extended-attributes buffer-file-name)))
                  ;; Actually write the back up file.
                  (condition-case ()
                      (if (or file-precious-flag
@@ -3943,10 +3966,13 @@
                                                   (<= (nth 2 attr) 
backup-by-copying-when-privileged-mismatch)))
                                          (not (file-ownership-preserved-p
                                                real-file-name t))))))
-                         (backup-buffer-copy real-file-name backupname modes 
context)
+                         (backup-buffer-copy real-file-name
+                                             backupname modes
+                                             extended-attributes)
                        ;; rename-file should delete old backup.
                        (rename-file real-file-name backupname t)
-                       (setq setmodes (list modes context backupname)))
+                       (setq setmodes (list modes extended-attributes
+                                            backupname)))
                    (file-error
                     ;; If trouble writing the backup, write it in
                     ;; .emacs.d/%backup%.
@@ -3954,7 +3980,8 @@
                     (message "Cannot write backup file; backing up in %s"
                              backupname)
                     (sleep-for 1)
-                    (backup-buffer-copy real-file-name backupname modes 
context)))
+                    (backup-buffer-copy real-file-name backupname
+                                        modes extended-attributes)))
                  (setq buffer-backed-up t)
                  ;; Now delete the old versions, if desired.
                  (if delete-old-versions
@@ -3966,7 +3993,7 @@
                  setmodes)
            (file-error nil))))))
 
-(defun backup-buffer-copy (from-name to-name modes context)
+(defun backup-buffer-copy (from-name to-name modes extended-attributes)
   (let ((umask (default-file-modes)))
     (unwind-protect
        (progn
@@ -3994,8 +4021,8 @@
       (set-default-file-modes umask)))
   (and modes
        (set-file-modes to-name (logand modes #o1777)))
-  (and context
-       (set-file-selinux-context to-name context)))
+  (and extended-attributes
+       (set-file-extended-attributes to-name extended-attributes)))
 
 (defvar file-name-version-regexp
   "\\(?:~\\|\\.~[-[:alnum:]:address@hidden(?:~[[:digit:]]+\\)?~\\)"
@@ -4593,7 +4620,8 @@
                (condition-case ()
                    (progn
                      (set-file-modes buffer-file-name (car setmodes))
-                     (set-file-selinux-context buffer-file-name (nth 1 
setmodes)))
+                     (set-file-extended-attributes buffer-file-name
+                                                   (nth 1 setmodes)))
                  (error nil))))
          ;; If the auto-save file was recent before this command,
          ;; delete it now.
@@ -4606,7 +4634,8 @@
 ;; This does the "real job" of writing a buffer into its visited file
 ;; and making a backup file.  This is what is normally done
 ;; but inhibited if one of write-file-functions returns non-nil.
-;; It returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer.
+;; It returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
+;; backup-buffer.
 (defun basic-save-buffer-1 ()
   (prog1
       (if save-buffer-coding-system
@@ -4618,7 +4647,8 @@
       (setq buffer-file-coding-system-explicit
            (cons last-coding-system-used nil)))))
 
-;; This returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer.
+;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
+;; backup-buffer.
 (defun basic-save-buffer-2 ()
   (let (tempsetmodes setmodes)
     (if (not (file-writable-p buffer-file-name))
@@ -4693,7 +4723,7 @@
            (setq setmodes (or setmodes
                               (list (or (file-modes buffer-file-name)
                                         (logand ?\666 umask))
-                                    (file-selinux-context buffer-file-name)
+                                    (file-extended-attributes buffer-file-name)
                                     buffer-file-name)))
            ;; We succeeded in writing the temp file,
            ;; so rename it.
@@ -4705,10 +4735,10 @@
        (cond ((and tempsetmodes (not setmodes))
               ;; Change the mode back, after writing.
               (setq setmodes (list (file-modes buffer-file-name)
-                                   (file-selinux-context buffer-file-name)
+                                   (file-extended-attributes buffer-file-name)
                                    buffer-file-name))
               (set-file-modes buffer-file-name (logior (car setmodes) 128))
-              (set-file-selinux-context buffer-file-name (nth 1 setmodes)))))
+              (set-file-extended-attributes buffer-file-name (nth 1 
setmodes)))))
        (let (success)
          (unwind-protect
              (progn

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2012-12-15 15:33:43 +0000
+++ b/src/ChangeLog     2012-12-16 18:22:27 +0000
@@ -1,3 +1,14 @@
+2012-12-16  Romain Francoise  <address@hidden>
+
+       * fileio.c (Ffile_acl, Fset_file_acl): New functions.
+       (Fcopy_file): Change last arg to `preserve_extended_attributes'
+       and copy ACL entries of file in addition to SELinux context if
+       set.
+       (syms_of_fileio): Add `file-acl' and `set-file-acl'.
+
+       * Makefile.in (LIBACL_LIBS): New macro.
+       (LIBES): Use it.
+
 2012-12-15  Paul Eggert  <address@hidden>
 
        * fileio.c (internal_delete_file): Use bool for boolean.

=== modified file 'src/Makefile.in'
--- a/src/Makefile.in   2012-12-13 05:29:15 +0000
+++ b/src/Makefile.in   2012-12-16 18:22:27 +0000
@@ -292,6 +292,8 @@
 LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
 LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
 
+LIBACL_LIBS = @LIBACL_LIBS@
+
 LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
 
 INTERVALS_H = dispextern.h intervals.h composite.h
@@ -406,7 +408,7 @@
    $(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
    $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
    $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
-   $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(LIB_PTHREAD_SIGMASK) \
+   $(LIBACL_LIBS) $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(LIB_PTHREAD_SIGMASK) \
    $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
 
 all: emacs$(EXEEXT) $(OTHER_FILES)

=== modified file 'src/fileio.c'
--- a/src/fileio.c      2012-12-15 15:33:43 +0000
+++ b/src/fileio.c      2012-12-16 18:22:27 +0000
@@ -36,6 +36,10 @@
 #include <selinux/context.h>
 #endif
 
+#ifdef HAVE_POSIX_ACL
+#include <sys/acl.h>
+#endif
+
 #include <c-ctype.h>
 
 #include "lisp.h"
@@ -236,6 +240,8 @@
 static Lisp_Object Qset_file_times;
 static Lisp_Object Qfile_selinux_context;
 static Lisp_Object Qset_file_selinux_context;
+static Lisp_Object Qfile_acl;
+static Lisp_Object Qset_file_acl;
 static Lisp_Object Qfile_newer_than_file_p;
 Lisp_Object Qinsert_file_contents;
 Lisp_Object Qwrite_region;
@@ -1895,9 +1901,10 @@
 If PRESERVE-UID-GID is non-nil, we try to transfer the
 uid and gid of FILE to NEWNAME.
 
-If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
-on the system, we copy the SELinux context of FILE to NEWNAME.  */)
-  (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, 
Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object 
preserve_selinux_context)
+If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
+attributes of FILE to NEWNAME, such as its SELinux context and ACL
+entries (depending on how Emacs was built).  */)
+  (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, 
Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object 
preserve_extended_attributes)
 {
   int ifd, ofd;
   int n;
@@ -1911,6 +1918,9 @@
   security_context_t con;
   int conlength = 0;
 #endif
+#ifdef HAVE_POSIX_ACL
+  acl_t acl = NULL;
+#endif
 
   encoded_file = encoded_newname = Qnil;
   GCPRO4 (file, newname, encoded_file, encoded_newname);
@@ -1933,7 +1943,7 @@
   if (!NILP (handler))
     RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
                           ok_if_already_exists, keep_time, preserve_uid_gid,
-                          preserve_selinux_context));
+                          preserve_extended_attributes));
 
   encoded_file = ENCODE_FILE (file);
   encoded_newname = ENCODE_FILE (newname);
@@ -1986,14 +1996,23 @@
   if (fstat (ifd, &st) != 0)
     report_file_error ("Input file status", Fcons (file, Qnil));
 
+  if (!NILP (preserve_extended_attributes))
+    {
 #if HAVE_LIBSELINUX
-  if (!NILP (preserve_selinux_context) && is_selinux_enabled ())
-    {
-      conlength = fgetfilecon (ifd, &con);
-      if (conlength == -1)
-       report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
+      if (is_selinux_enabled ())
+       {
+         conlength = fgetfilecon (ifd, &con);
+         if (conlength == -1)
+           report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
+       }
+#endif
+
+#ifdef HAVE_POSIX_ACL
+      acl = acl_get_fd (ifd);
+      if (acl == NULL && errno != ENOTSUP)
+       report_file_error ("Getting ACL", Fcons (file, Qnil));
+#endif
     }
-#endif
 
   if (out_st.st_mode != 0
       && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
@@ -2075,6 +2094,17 @@
     }
 #endif
 
+#ifdef HAVE_POSIX_ACL
+  if (acl != NULL)
+    {
+      bool fail = acl_set_fd (ofd, acl) != 0;
+      if (fail && errno != ENOTSUP)
+       report_file_error ("Setting ACL", Fcons (newname, Qnil));
+
+      acl_free (acl);
+    }
+#endif
+
   if (!NILP (keep_time))
     {
       EMACS_TIME atime = get_stat_atime (&st);
@@ -2961,6 +2991,106 @@
   return Qnil;
 }
 
+DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
+       doc: /* Return ACL entries of file named FILENAME, as a string.
+Return nil if file does not exist or is not accessible, or if Emacs
+was unable to determine the ACL entries.  The latter can happen for
+local files if Emacs was not compiled with ACL support, or for remote
+files if the file handler returns nil for the file's ACL entries.  */)
+  (Lisp_Object filename)
+{
+  Lisp_Object absname;
+  Lisp_Object handler;
+#ifdef HAVE_POSIX_ACL
+  acl_t acl;
+  Lisp_Object acl_string;
+  char *str;
+#endif
+
+  absname = expand_and_dir_to_file (filename,
+                                   BVAR (current_buffer, directory));
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = Ffind_file_name_handler (absname, Qfile_acl);
+  if (!NILP (handler))
+    return call2 (handler, Qfile_acl, absname);
+
+#ifdef HAVE_POSIX_ACL
+  absname = ENCODE_FILE (absname);
+
+  acl = acl_get_file (SSDATA (absname), ACL_TYPE_ACCESS);
+  if (acl == NULL)
+    return Qnil;
+
+  str = acl_to_text (acl, NULL);
+  if (str == NULL)
+    {
+      acl_free (acl);
+      return Qnil;
+    }
+
+  acl_string = build_string (str);
+  acl_free (str);
+  acl_free (acl);
+
+  return acl_string;
+#endif
+
+  return Qnil;
+}
+
+DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
+       2, 2, 0,
+       doc: /* Set ACL of file named FILENAME to ACL-STRING.
+ACL-STRING should contain the textual representation of the ACL
+entries in a format suitable for the platform.
+
+Setting ACL for local files requires Emacs to be built with ACL
+support.  */)
+  (Lisp_Object filename, Lisp_Object acl_string)
+{
+  Lisp_Object absname;
+  Lisp_Object handler;
+#ifdef HAVE_POSIX_ACL
+  Lisp_Object encoded_absname;
+  acl_t acl;
+  bool fail;
+#endif
+
+  absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = Ffind_file_name_handler (absname, Qset_file_acl);
+  if (!NILP (handler))
+    return call3 (handler, Qset_file_acl, absname, acl_string);
+
+#ifdef HAVE_POSIX_ACL
+  if (STRINGP (acl_string))
+    {
+      acl = acl_from_text (SSDATA (acl_string));
+      if (acl == NULL)
+       {
+         report_file_error ("Converting ACL", Fcons (absname, Qnil));
+         return Qnil;
+       }
+
+      encoded_absname = ENCODE_FILE (absname);
+
+      fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
+                           acl)
+             != 0);
+      if (fail && errno != ENOTSUP)
+       report_file_error ("Setting ACL", Fcons (absname, Qnil));
+
+      acl_free (acl);
+    }
+#endif
+
+  return Qnil;
+}
+
 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
        doc: /* Return mode bits of file named FILENAME, as an integer.
 Return nil, if file does not exist or is not accessible.  */)
@@ -5630,6 +5760,8 @@
   DEFSYM (Qset_file_times, "set-file-times");
   DEFSYM (Qfile_selinux_context, "file-selinux-context");
   DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
+  DEFSYM (Qfile_acl, "file-acl");
+  DEFSYM (Qset_file_acl, "set-file-acl");
   DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
   DEFSYM (Qinsert_file_contents, "insert-file-contents");
   DEFSYM (Qwrite_region, "write-region");
@@ -5849,6 +5981,8 @@
   defsubr (&Sset_file_modes);
   defsubr (&Sset_file_times);
   defsubr (&Sfile_selinux_context);
+  defsubr (&Sfile_acl);
+  defsubr (&Sset_file_acl);
   defsubr (&Sset_file_selinux_context);
   defsubr (&Sset_default_file_modes);
   defsubr (&Sdefault_file_modes);


reply via email to

[Prev in Thread] Current Thread [Next in Thread]