mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-23 10:34:07 +00:00
Add SELinux support.
* configure.in: New option: --with(out)-selinux, on by default. Set HAVE_LIBSELINUX if we find libselinux, and substitute LIBSELINUX_LIBS in Makefiles. * src/Makefile.in (LIBSELINUX_LIBS): New. (LIBES): Add $LIBSELINUX_LIBS. * src/eval.c, lisp.h (call7): New function. * src/fileio.c [HAVE_LIBSELINUX]: Include selinux headers. (Ffile_selinux_context, Fset_file_selinux_context): New functions. (Fcopy_file): New parameter preserve-selinux-context. (Frename_file): Preserve selinux context when renaming by copy-file. * lisp/files.el (backup-buffer): Handle SELinux context, and return it if a backup was made by renaming. (backup-buffer-copy): Set SELinux context to the target file. (basic-save-buffer): Set SELinux context of the newly written file. (basic-save-buffer-1): Now it also returns any SELinux context. (basic-save-buffer-2): Set SELinux context of the newly created file, and return it. * lisp/net/tramp.el (tramp-file-name-for-operation): Add file-selinux-context.
This commit is contained in:
parent
a1d830c700
commit
574c05e219
@ -1,3 +1,9 @@
|
||||
2010-04-21 Karel Klíč <kklic@redhat.com>
|
||||
|
||||
* configure.in: New option: --with(out)-selinux, on by default.
|
||||
Set HAVE_LIBSELINUX if we find libselinux, and substitute
|
||||
LIBSELINUX_LIBS in Makefiles.
|
||||
|
||||
2010-04-01 Dan Nicolaescu <dann@ics.uci.edu>
|
||||
|
||||
* configure.in: Remove all references to LIBX11_SYSTEM.
|
||||
|
13
configure.in
13
configure.in
@ -161,6 +161,7 @@ OPTION_DEFAULT_OFF([ns],[use nextstep (Cocoa or GNUstep) windowing system])
|
||||
OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console])
|
||||
OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support])
|
||||
OPTION_DEFAULT_ON([gconf],[don't compile with GConf support])
|
||||
OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
|
||||
|
||||
## For the times when you want to build Emacs but don't have
|
||||
## a suitable makeinfo, and can live without the manuals.
|
||||
@ -1731,6 +1732,17 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
|
||||
fi
|
||||
fi
|
||||
|
||||
dnl SELinux is available for GNU/Linux only.
|
||||
HAVE_LIBSELINUX=no
|
||||
if test "${with_selinux}" = "yes"; then
|
||||
AC_CHECK_LIB([selinux], [lgetfilecon], HAVE_LIBSELINUX=yes, HAVE_LIBSELINUX=no)
|
||||
if test "$HAVE_LIBSELINUX" = yes; then
|
||||
AC_DEFINE(HAVE_LIBSELINUX, 1, [Define to 1 if using SELinux.])
|
||||
LIBSELINUX_LIBS=-lselinux
|
||||
AC_SUBST(LIBSELINUX_LIBS)
|
||||
fi
|
||||
fi
|
||||
|
||||
dnl Do not put whitespace before the #include statements below.
|
||||
dnl Older compilers (eg sunos4 cc) choke on it.
|
||||
HAVE_XAW3D=no
|
||||
@ -3083,6 +3095,7 @@ echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}"
|
||||
echo " Does Emacs use -lgpm? ${HAVE_GPM}"
|
||||
echo " Does Emacs use -ldbus? ${HAVE_DBUS}"
|
||||
echo " Does Emacs use -lgconf? ${HAVE_GCONF}"
|
||||
echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}"
|
||||
|
||||
echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}"
|
||||
echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}"
|
||||
|
@ -1,3 +1,15 @@
|
||||
2010-04-21 Karel Klíč <kklic@redhat.com>
|
||||
|
||||
* files.el (backup-buffer): Handle SELinux context, and return it
|
||||
if a backup was made by renaming.
|
||||
(backup-buffer-copy): Set SELinux context to the target file.
|
||||
(basic-save-buffer): Set SELinux context of the newly written file.
|
||||
(basic-save-buffer-1): Now it also returns any SELinux context.
|
||||
(basic-save-buffer-2): Set SELinux context of the newly created file,
|
||||
and return it.
|
||||
* net/tramp.el (tramp-file-name-for-operation):
|
||||
Add file-selinux-context.
|
||||
|
||||
2010-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* vc.el (vc-checkin, vc-modify-change-comment):
|
||||
|
@ -3625,10 +3625,13 @@ variable `make-backup-files'. If it's done by renaming, then the file is
|
||||
no longer accessible under its old name.
|
||||
|
||||
The value is non-nil after a backup was made by renaming.
|
||||
It has the form (MODES . BACKUPNAME).
|
||||
It has the form (MODES SELINUXCONTEXT 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.
|
||||
BACKUPNAME is the backup file name, which is the old file renamed."
|
||||
(if (and make-backup-files (not backup-inhibited)
|
||||
(not buffer-backed-up)
|
||||
@ -3656,7 +3659,8 @@ BACKUPNAME is the backup file name, which is the old file renamed."
|
||||
(or delete-old-versions
|
||||
(y-or-n-p (format "Delete excess backup versions of %s? "
|
||||
real-file-name)))))
|
||||
(modes (file-modes buffer-file-name)))
|
||||
(modes (file-modes buffer-file-name))
|
||||
(context (file-selinux-context buffer-file-name)))
|
||||
;; Actually write the back up file.
|
||||
(condition-case ()
|
||||
(if (or file-precious-flag
|
||||
@ -3676,10 +3680,10 @@ BACKUPNAME is the backup file name, which is the old file renamed."
|
||||
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
|
||||
(or (nth 9 attr)
|
||||
(not (file-ownership-preserved-p real-file-name)))))))
|
||||
(backup-buffer-copy real-file-name backupname modes)
|
||||
(backup-buffer-copy real-file-name backupname modes context)
|
||||
;; rename-file should delete old backup.
|
||||
(rename-file real-file-name backupname t)
|
||||
(setq setmodes (cons modes backupname)))
|
||||
(setq setmodes (list modes context backupname)))
|
||||
(file-error
|
||||
;; If trouble writing the backup, write it in ~.
|
||||
(setq backupname (expand-file-name
|
||||
@ -3688,7 +3692,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
|
||||
(message "Cannot write backup file; backing up in %s"
|
||||
backupname)
|
||||
(sleep-for 1)
|
||||
(backup-buffer-copy real-file-name backupname modes)))
|
||||
(backup-buffer-copy real-file-name backupname modes context)))
|
||||
(setq buffer-backed-up t)
|
||||
;; Now delete the old versions, if desired.
|
||||
(if delete-old-versions
|
||||
@ -3700,7 +3704,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
|
||||
setmodes)
|
||||
(file-error nil))))))
|
||||
|
||||
(defun backup-buffer-copy (from-name to-name modes)
|
||||
(defun backup-buffer-copy (from-name to-name modes context)
|
||||
(let ((umask (default-file-modes)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
@ -3727,7 +3731,9 @@ BACKUPNAME is the backup file name, which is the old file renamed."
|
||||
;; Reset the umask.
|
||||
(set-default-file-modes umask)))
|
||||
(and modes
|
||||
(set-file-modes to-name (logand modes #o1777))))
|
||||
(set-file-modes to-name (logand modes #o1777)))
|
||||
(and context
|
||||
(set-file-selinux-context to-name context)))
|
||||
|
||||
(defun file-name-sans-versions (name &optional keep-backup-version)
|
||||
"Return file NAME sans backup versions or strings.
|
||||
@ -4257,7 +4263,9 @@ Before and after saving the buffer, this function runs
|
||||
(nthcdr 10 (file-attributes buffer-file-name)))
|
||||
(if setmodes
|
||||
(condition-case ()
|
||||
(set-file-modes buffer-file-name (car setmodes))
|
||||
(progn
|
||||
(set-file-modes buffer-file-name (car setmodes))
|
||||
(set-file-selinux-context buffer-file-name (nth 1 setmodes)))
|
||||
(error nil))))
|
||||
;; If the auto-save file was recent before this command,
|
||||
;; delete it now.
|
||||
@ -4270,7 +4278,7 @@ Before and after saving the buffer, this function runs
|
||||
;; 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 . BACKUPNAME), like backup-buffer.
|
||||
;; It returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer.
|
||||
(defun basic-save-buffer-1 ()
|
||||
(prog1
|
||||
(if save-buffer-coding-system
|
||||
@ -4282,7 +4290,7 @@ Before and after saving the buffer, this function runs
|
||||
(setq buffer-file-coding-system-explicit
|
||||
(cons last-coding-system-used nil)))))
|
||||
|
||||
;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
|
||||
;; This returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer.
|
||||
(defun basic-save-buffer-2 ()
|
||||
(let (tempsetmodes setmodes)
|
||||
(if (not (file-writable-p buffer-file-name))
|
||||
@ -4353,8 +4361,9 @@ Before and after saving the buffer, this function runs
|
||||
;; Since we have created an entirely new file,
|
||||
;; make sure it gets the right permission bits set.
|
||||
(setq setmodes (or setmodes
|
||||
(cons (or (file-modes buffer-file-name)
|
||||
(list (or (file-modes buffer-file-name)
|
||||
(logand ?\666 umask))
|
||||
(file-selinux-context buffer-file-name)
|
||||
buffer-file-name)))
|
||||
;; We succeeded in writing the temp file,
|
||||
;; so rename it.
|
||||
@ -4365,8 +4374,11 @@ Before and after saving the buffer, this function runs
|
||||
;; (setmodes is set) because that says we're superseding.
|
||||
(cond ((and tempsetmodes (not setmodes))
|
||||
;; Change the mode back, after writing.
|
||||
(setq setmodes (cons (file-modes buffer-file-name) buffer-file-name))
|
||||
(set-file-modes buffer-file-name (logior (car setmodes) 128))))
|
||||
(setq setmodes (list (file-modes buffer-file-name)
|
||||
(file-selinux-context 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)))))
|
||||
(let (success)
|
||||
(unwind-protect
|
||||
(progn
|
||||
@ -4380,8 +4392,8 @@ Before and after saving the buffer, this function runs
|
||||
;; the backup by renaming, undo the backing-up.
|
||||
(and setmodes (not success)
|
||||
(progn
|
||||
(rename-file (cdr setmodes) buffer-file-name t)
|
||||
(setq buffer-backed-up nil)))))))
|
||||
(rename-file (nth 2 setmodes) buffer-file-name t)
|
||||
(setq buffer-backed-up nil))))))
|
||||
setmodes))
|
||||
|
||||
(defun diff-buffer-with-file (&optional buffer)
|
||||
|
@ -5326,7 +5326,7 @@ ARGS are the arguments OPERATION has been called with."
|
||||
'dired-compress-file 'dired-uncache
|
||||
'file-accessible-directory-p 'file-attributes
|
||||
'file-directory-p 'file-executable-p 'file-exists-p
|
||||
'file-local-copy 'file-remote-p 'file-modes
|
||||
'file-local-copy 'file-remote-p 'file-modes 'file-selinux-context
|
||||
'file-name-as-directory 'file-name-directory
|
||||
'file-name-nondirectory 'file-name-sans-versions
|
||||
'file-ownership-preserved-p 'file-readable-p
|
||||
|
@ -1,3 +1,14 @@
|
||||
2010-04-21 Karel Klíč <kklic@redhat.com>
|
||||
|
||||
* Makefile.in (LIBSELINUX_LIBS): New.
|
||||
(LIBES): Add $LIBSELINUX_LIBS.
|
||||
* eval.c, lisp.h (call7): New function.
|
||||
* fileio.c [HAVE_LIBSELINUX]: Include selinux headers.
|
||||
(Ffile_selinux_context, Fset_file_selinux_context):
|
||||
New functions.
|
||||
(Fcopy_file): New parameter preserve-selinux-context.
|
||||
(Frename_file): Preserve selinux context when renaming by copy-file.
|
||||
|
||||
2010-04-21 Juanma Barranquero <lekktu@gmail.com>
|
||||
Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
|
@ -243,6 +243,10 @@ shared=no
|
||||
DBUS_OBJ = dbusbind.o
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_LIBSELINUX
|
||||
LIBSELINUX_LIBS = @LIBSELINUX_LIBS@
|
||||
#endif
|
||||
|
||||
/* DO NOT use -R. There is a special hack described in lastfile.c
|
||||
which is used instead. Some initialized data areas are modified
|
||||
at initial startup, then labeled as part of the text area when
|
||||
@ -824,7 +828,7 @@ SOME_MACHINE_LISP = ../lisp/mouse.elc \
|
||||
|
||||
LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \
|
||||
@LIBGPM@ @LIBRESOLV@ LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
|
||||
$(GETLOADAVG_LIBS) ${GCONF_LIBS} \
|
||||
$(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \
|
||||
@FREETYPE_LIBS@ @FONTCONFIG_LIBS@ @LIBOTF_LIBS@ @M17N_FLT_LIBS@ \
|
||||
$(GNULIB_VAR) LIB_MATH LIB_STANDARD $(GNULIB_VAR)
|
||||
|
||||
|
27
src/eval.c
27
src/eval.c
@ -2952,6 +2952,33 @@ call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
|
||||
#endif /* not NO_ARG_ARRAY */
|
||||
}
|
||||
|
||||
/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
|
||||
/* ARGSUSED */
|
||||
Lisp_Object
|
||||
call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7)
|
||||
Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7;
|
||||
{
|
||||
struct gcpro gcpro1;
|
||||
#ifdef NO_ARG_ARRAY
|
||||
Lisp_Object args[8];
|
||||
args[0] = fn;
|
||||
args[1] = arg1;
|
||||
args[2] = arg2;
|
||||
args[3] = arg3;
|
||||
args[4] = arg4;
|
||||
args[5] = arg5;
|
||||
args[6] = arg6;
|
||||
args[7] = arg7;
|
||||
GCPRO1 (args[0]);
|
||||
gcpro1.nvars = 8;
|
||||
RETURN_UNGCPRO (Ffuncall (8, args));
|
||||
#else /* not NO_ARG_ARRAY */
|
||||
GCPRO1 (fn);
|
||||
gcpro1.nvars = 8;
|
||||
RETURN_UNGCPRO (Ffuncall (8, &fn));
|
||||
#endif /* not NO_ARG_ARRAY */
|
||||
}
|
||||
|
||||
/* The caller should GCPRO all the elements of ARGS. */
|
||||
|
||||
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
|
||||
|
186
src/fileio.c
186
src/fileio.c
@ -53,6 +53,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||||
#include <ctype.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifdef HAVE_LIBSELINUX
|
||||
#include <selinux/selinux.h>
|
||||
#include <selinux/context.h>
|
||||
#endif
|
||||
|
||||
#include "lisp.h"
|
||||
#include "intervals.h"
|
||||
#include "buffer.h"
|
||||
@ -331,6 +336,8 @@ Lisp_Object Qfile_accessible_directory_p;
|
||||
Lisp_Object Qfile_modes;
|
||||
Lisp_Object Qset_file_modes;
|
||||
Lisp_Object Qset_file_times;
|
||||
Lisp_Object Qfile_selinux_context;
|
||||
Lisp_Object Qset_file_selinux_context;
|
||||
Lisp_Object Qfile_newer_than_file_p;
|
||||
Lisp_Object Qinsert_file_contents;
|
||||
Lisp_Object Qwrite_region;
|
||||
@ -1894,7 +1901,7 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
|
||||
return;
|
||||
}
|
||||
|
||||
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
|
||||
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
|
||||
"fCopy file: \nGCopy %s to file: \np\nP",
|
||||
doc: /* Copy FILE to NEWNAME. Both args must be strings.
|
||||
If NEWNAME names a directory, copy FILE there.
|
||||
@ -1916,10 +1923,13 @@ last-modified time as the old one. (This works on only some systems.)
|
||||
A prefix arg makes KEEP-TIME non-nil.
|
||||
|
||||
If PRESERVE-UID-GID is non-nil, we try to transfer the
|
||||
uid and gid of FILE to NEWNAME. */)
|
||||
(file, newname, ok_if_already_exists, keep_time, preserve_uid_gid)
|
||||
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. */)
|
||||
(file, newname, ok_if_already_exists, keep_time, preserve_uid_gid, preserve_selinux_context)
|
||||
Lisp_Object file, newname, ok_if_already_exists, keep_time;
|
||||
Lisp_Object preserve_uid_gid;
|
||||
Lisp_Object preserve_uid_gid, preserve_selinux_context;
|
||||
{
|
||||
int ifd, ofd, n;
|
||||
char buf[16 * 1024];
|
||||
@ -1929,6 +1939,10 @@ uid and gid of FILE to NEWNAME. */)
|
||||
int count = SPECPDL_INDEX ();
|
||||
int input_file_statable_p;
|
||||
Lisp_Object encoded_file, encoded_newname;
|
||||
#if HAVE_LIBSELINUX
|
||||
security_context_t con;
|
||||
int fail, conlength = 0;
|
||||
#endif
|
||||
|
||||
encoded_file = encoded_newname = Qnil;
|
||||
GCPRO4 (file, newname, encoded_file, encoded_newname);
|
||||
@ -1949,8 +1963,9 @@ uid and gid of FILE to NEWNAME. */)
|
||||
if (NILP (handler))
|
||||
handler = Ffind_file_name_handler (newname, Qcopy_file);
|
||||
if (!NILP (handler))
|
||||
RETURN_UNGCPRO (call6 (handler, Qcopy_file, file, newname,
|
||||
ok_if_already_exists, keep_time, preserve_uid_gid));
|
||||
RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
|
||||
ok_if_already_exists, keep_time, preserve_uid_gid,
|
||||
preserve_selinux_context));
|
||||
|
||||
encoded_file = ENCODE_FILE (file);
|
||||
encoded_newname = ENCODE_FILE (newname);
|
||||
@ -2004,6 +2019,15 @@ uid and gid of FILE to NEWNAME. */)
|
||||
copyable by us. */
|
||||
input_file_statable_p = (fstat (ifd, &st) >= 0);
|
||||
|
||||
#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));
|
||||
}
|
||||
#endif
|
||||
|
||||
if (out_st.st_mode != 0
|
||||
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
|
||||
{
|
||||
@ -2061,6 +2085,18 @@ uid and gid of FILE to NEWNAME. */)
|
||||
}
|
||||
#endif /* not MSDOS */
|
||||
|
||||
#if HAVE_LIBSELINUX
|
||||
if (conlength > 0)
|
||||
{
|
||||
/* Set the modified context back to the file. */
|
||||
fail = fsetfilecon (ofd, con);
|
||||
if (fail)
|
||||
report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
|
||||
|
||||
freecon (con);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Closing the output clobbers the file times on some systems. */
|
||||
if (emacs_close (ofd) < 0)
|
||||
report_file_error ("I/O error", Fcons (newname, Qnil));
|
||||
@ -2287,7 +2323,7 @@ This is what happens in interactive use with M-x. */)
|
||||
have copy-file prompt again. */
|
||||
Fcopy_file (file, newname,
|
||||
NILP (ok_if_already_exists) ? Qnil : Qt,
|
||||
Qt, Qt);
|
||||
Qt, Qt, Qt);
|
||||
|
||||
count = SPECPDL_INDEX ();
|
||||
specbind (Qdelete_by_moving_to_trash, Qnil);
|
||||
@ -2844,6 +2880,136 @@ See `file-symlink-p' to distinguish symlinks. */)
|
||||
#endif
|
||||
}
|
||||
|
||||
DEFUN ("file-selinux-context", Ffile_selinux_context,
|
||||
Sfile_selinux_context, 1, 1, 0,
|
||||
doc: /* Return SELinux context of file named FILENAME,
|
||||
as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
|
||||
if file does not exist, is not accessible, or SELinux is disabled */)
|
||||
(filename)
|
||||
Lisp_Object filename;
|
||||
{
|
||||
Lisp_Object absname;
|
||||
Lisp_Object values[4];
|
||||
Lisp_Object handler;
|
||||
#if HAVE_LIBSELINUX
|
||||
security_context_t con;
|
||||
int conlength;
|
||||
context_t context;
|
||||
#endif
|
||||
|
||||
absname = expand_and_dir_to_file (filename, current_buffer->directory);
|
||||
|
||||
/* If the file name has special constructs in it,
|
||||
call the corresponding file handler. */
|
||||
handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
|
||||
if (!NILP (handler))
|
||||
return call2 (handler, Qfile_selinux_context, absname);
|
||||
|
||||
absname = ENCODE_FILE (absname);
|
||||
|
||||
values[0] = Qnil;
|
||||
values[1] = Qnil;
|
||||
values[2] = Qnil;
|
||||
values[3] = Qnil;
|
||||
#if HAVE_LIBSELINUX
|
||||
if (is_selinux_enabled ())
|
||||
{
|
||||
conlength = lgetfilecon (SDATA (absname), &con);
|
||||
if (conlength > 0)
|
||||
{
|
||||
context = context_new (con);
|
||||
values[0] = build_string (context_user_get (context));
|
||||
values[1] = build_string (context_role_get (context));
|
||||
values[2] = build_string (context_type_get (context));
|
||||
values[3] = build_string (context_range_get (context));
|
||||
context_free (context);
|
||||
}
|
||||
if (con)
|
||||
freecon (con);
|
||||
}
|
||||
#endif
|
||||
|
||||
return Flist (sizeof(values) / sizeof(values[0]), values);
|
||||
}
|
||||
|
||||
DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
|
||||
Sset_file_selinux_context, 2, 2, 0,
|
||||
doc: /* Set SELinux context of file named FILENAME to CONTEXT
|
||||
as a list ("user", "role", "type", "range"). Has no effect if SELinux
|
||||
is disabled. */)
|
||||
(filename, context)
|
||||
Lisp_Object filename, context;
|
||||
{
|
||||
Lisp_Object absname, encoded_absname;
|
||||
Lisp_Object handler;
|
||||
Lisp_Object user = CAR_SAFE (context);
|
||||
Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
|
||||
Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
|
||||
Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
|
||||
#if HAVE_LIBSELINUX
|
||||
security_context_t con;
|
||||
int fail, conlength;
|
||||
context_t parsed_con;
|
||||
#endif
|
||||
|
||||
absname = Fexpand_file_name (filename, 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_selinux_context);
|
||||
if (!NILP (handler))
|
||||
return call3 (handler, Qset_file_selinux_context, absname, context);
|
||||
|
||||
encoded_absname = ENCODE_FILE (absname);
|
||||
|
||||
#if HAVE_LIBSELINUX
|
||||
if (is_selinux_enabled ())
|
||||
{
|
||||
/* Get current file context. */
|
||||
conlength = lgetfilecon (SDATA (encoded_absname), &con);
|
||||
if (conlength > 0)
|
||||
{
|
||||
parsed_con = context_new (con);
|
||||
/* Change the parts defined in the parameter.*/
|
||||
if (STRINGP (user))
|
||||
{
|
||||
if (context_user_set (parsed_con, SDATA (user)))
|
||||
error ("Doing context_user_set");
|
||||
}
|
||||
if (STRINGP (role))
|
||||
{
|
||||
if (context_role_set (parsed_con, SDATA (role)))
|
||||
error ("Doing context_role_set");
|
||||
}
|
||||
if (STRINGP (type))
|
||||
{
|
||||
if (context_type_set (parsed_con, SDATA (type)))
|
||||
error ("Doing context_type_set");
|
||||
}
|
||||
if (STRINGP (range))
|
||||
{
|
||||
if (context_range_set (parsed_con, SDATA (range)))
|
||||
error ("Doing context_range_set");
|
||||
}
|
||||
|
||||
/* Set the modified context back to the file. */
|
||||
fail = lsetfilecon (SDATA (encoded_absname), context_str (parsed_con));
|
||||
if (fail)
|
||||
report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
|
||||
|
||||
context_free (parsed_con);
|
||||
}
|
||||
else
|
||||
report_file_error("Doing lgetfilecon", Fcons (absname, Qnil));
|
||||
|
||||
if (con)
|
||||
freecon (con);
|
||||
}
|
||||
#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. */)
|
||||
@ -5505,6 +5671,8 @@ syms_of_fileio ()
|
||||
Qfile_modes = intern_c_string ("file-modes");
|
||||
Qset_file_modes = intern_c_string ("set-file-modes");
|
||||
Qset_file_times = intern_c_string ("set-file-times");
|
||||
Qfile_selinux_context = intern_c_string("file-selinux-context");
|
||||
Qset_file_selinux_context = intern_c_string("set-file-selinux-context");
|
||||
Qfile_newer_than_file_p = intern_c_string ("file-newer-than-file-p");
|
||||
Qinsert_file_contents = intern_c_string ("insert-file-contents");
|
||||
Qwrite_region = intern_c_string ("write-region");
|
||||
@ -5540,6 +5708,8 @@ syms_of_fileio ()
|
||||
staticpro (&Qfile_modes);
|
||||
staticpro (&Qset_file_modes);
|
||||
staticpro (&Qset_file_times);
|
||||
staticpro (&Qfile_selinux_context);
|
||||
staticpro (&Qset_file_selinux_context);
|
||||
staticpro (&Qfile_newer_than_file_p);
|
||||
staticpro (&Qinsert_file_contents);
|
||||
staticpro (&Qwrite_region);
|
||||
@ -5773,6 +5943,8 @@ When non-nil, the function `move-file-to-trash' will be used by
|
||||
defsubr (&Sfile_modes);
|
||||
defsubr (&Sset_file_modes);
|
||||
defsubr (&Sset_file_times);
|
||||
defsubr (&Sfile_selinux_context);
|
||||
defsubr (&Sset_file_selinux_context);
|
||||
defsubr (&Sset_default_file_modes);
|
||||
defsubr (&Sdefault_file_modes);
|
||||
defsubr (&Sfile_newer_than_file_p);
|
||||
|
@ -2897,6 +2897,7 @@ extern Lisp_Object call3 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object
|
||||
extern Lisp_Object call4 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
|
||||
extern Lisp_Object call5 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
|
||||
extern Lisp_Object call6 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
|
||||
extern Lisp_Object call7 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
|
||||
EXFUN (Fdo_auto_save, 2);
|
||||
extern Lisp_Object apply_lambda P_ ((Lisp_Object, Lisp_Object, int));
|
||||
extern Lisp_Object internal_catch P_ ((Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object));
|
||||
|
Loading…
Reference in New Issue
Block a user