[Emacs-diffs] /srv/bzr/emacs/trunk r100003: Implement SELINUX backends.

[Michael Albinus]

------------------------------------------------------------
revno: 100003
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Fri 2010-04-23 16:12:05 +0200
message:
  Implement SELINUX backends.
  
  * net/tramp.el (tramp-file-name-handler-alist): Add
  `file-selinux-context' and `set-file-selinux-context'.
  (tramp-handle-file-selinux-context)
  (tramp-handle-set-file-selinux-context): New defuns.
  (tramp-handle-copy-file, tramp-do-copy-or-rename-file): Handle
  PRESERVE-SELINUX-CONTEXT.
  
  * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add
  `file-selinux-context' and `set-file-selinux-context'.
  (tramp-gvfs-handle-file-selinux-context)
  (tramp-gvfs-handle-set-file-selinux-context): New defuns.
  (tramp-gvfs-handle-copy-file): Handle PRESERVE-SELINUX-CONTEXT.
  
  * net/ange-ftp.el (ange-ftp-copy-file):
  * net/tramp-fish.el (tramp-fish-handle-copy-file):
  * net/tramp-imap.el (tramp-imap-handle-copy-file):
  * net/tramp-smb.el (tramp-smb-handle-copy-file): Add
  PRESERVE-SELINUX-CONTEXT.
modified:
  lisp/ChangeLog
  lisp/net/ange-ftp.el
  lisp/net/tramp-fish.el
  lisp/net/tramp-gvfs.el
  lisp/net/tramp-imap.el
  lisp/net/tramp-smb.el
  lisp/net/tramp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-04-23 05:40:33 +0000
+++ b/lisp/ChangeLog    2010-04-23 14:12:05 +0000
@@ -1,3 +1,26 @@
+2010-04-23  Michael Albinus  <address@hidden>
+
+       Implement SELINUX backends.
+
+       * net/tramp.el (tramp-file-name-handler-alist): Add
+       `file-selinux-context' and `set-file-selinux-context'.
+       (tramp-handle-file-selinux-context)
+       (tramp-handle-set-file-selinux-context): New defuns.
+       (tramp-handle-copy-file, tramp-do-copy-or-rename-file): Handle
+       PRESERVE-SELINUX-CONTEXT.
+
+       * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add
+       `file-selinux-context' and `set-file-selinux-context'.
+       (tramp-gvfs-handle-file-selinux-context)
+       (tramp-gvfs-handle-set-file-selinux-context): New defuns.
+       (tramp-gvfs-handle-copy-file): Handle PRESERVE-SELINUX-CONTEXT.
+
+       * net/ange-ftp.el (ange-ftp-copy-file):
+       * net/tramp-fish.el (tramp-fish-handle-copy-file):
+       * net/tramp-imap.el (tramp-imap-handle-copy-file):
+       * net/tramp-smb.el (tramp-smb-handle-copy-file): Add
+       PRESERVE-SELINUX-CONTEXT.
+
 2010-04-22  Michael Albinus  <address@hidden>
 
        Synchronize with Tramp repository.

=== modified file 'lisp/net/ange-ftp.el'
--- a/lisp/net/ange-ftp.el      2010-03-12 19:13:38 +0000
+++ b/lisp/net/ange-ftp.el      2010-04-23 14:12:05 +0000
@@ -3827,7 +3827,8 @@
     (ange-ftp-call-cont cont result line)))
 
 (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
-                                   keep-date preserve-uid-gid)
+                                   keep-date preserve-uid-gid
+                                   preserve-selinux-context)
   (interactive "fCopy file: \nFCopy %s to file: \np")
   (ange-ftp-copy-file-internal filename
                               newname

=== modified file 'lisp/net/tramp-fish.el'
--- a/lisp/net/tramp-fish.el    2010-04-10 12:50:31 +0000
+++ b/lisp/net/tramp-fish.el    2010-04-23 14:12:05 +0000
@@ -217,7 +217,6 @@
     (file-executable-p . tramp-fish-handle-file-executable-p)
     (file-exists-p . tramp-fish-handle-file-exists-p)
     (file-local-copy . tramp-fish-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-fish-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -229,6 +228,8 @@
     (file-ownership-preserved-p . ignore)
     (file-readable-p . tramp-fish-handle-file-readable-p)
     (file-regular-p . tramp-handle-file-regular-p)
+    (file-remote-p . tramp-handle-file-remote-p)
+    ;; `file-selinux-context' performed by default handler.
     (file-symlink-p . tramp-handle-file-symlink-p)
     ;; `file-truename' performed by default handler
     (file-writable-p . tramp-fish-handle-file-writable-p)
@@ -243,6 +244,7 @@
     (make-symbolic-link . tramp-fish-handle-make-symbolic-link)
     (rename-file . tramp-fish-handle-rename-file)
     (set-file-modes . tramp-fish-handle-set-file-modes)
+    ;; `set-file-selinux-context' performed by default handler.
     (set-file-times . tramp-fish-handle-set-file-times)
     (set-visited-file-modtime . ignore)
     (shell-command . tramp-handle-shell-command)
@@ -307,7 +309,8 @@
         v1 'file-error "Error with add-name-to-file %s" newname)))))
 
 (defun tramp-fish-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+  (filename newname &optional ok-if-already-exists keep-date
+           preserve-uid-gid preserve-selinux-context)
   "Like `copy-file' for Tramp files."
   (tramp-fish-do-copy-or-rename-file
    'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))

=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el    2010-02-15 15:04:53 +0000
+++ b/lisp/net/tramp-gvfs.el    2010-04-23 14:12:05 +0000
@@ -386,7 +386,6 @@
     (file-executable-p . tramp-gvfs-handle-file-executable-p)
     (file-exists-p . tramp-gvfs-handle-file-exists-p)
     (file-local-copy . tramp-gvfs-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
     ;; `file-modes' performed by default handler.
     (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -398,6 +397,8 @@
     (file-ownership-preserved-p . ignore)
     (file-readable-p . tramp-gvfs-handle-file-readable-p)
     (file-regular-p . tramp-handle-file-regular-p)
+    (file-remote-p . tramp-handle-file-remote-p)
+    (file-selinux-context . tramp-gvfs-handle-file-selinux-context)
     (file-symlink-p . tramp-handle-file-symlink-p)
     ;; `file-truename' performed by default handler.
     (file-writable-p . tramp-gvfs-handle-file-writable-p)
@@ -413,6 +414,7 @@
     (process-file . tramp-gvfs-handle-process-file)
     (rename-file . tramp-gvfs-handle-rename-file)
     (set-file-modes . tramp-gvfs-handle-set-file-modes)
+    (set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context)
     (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
     (shell-command . tramp-gvfs-handle-shell-command)
     (start-file-process . tramp-gvfs-handle-start-file-process)
@@ -510,16 +512,21 @@
 ;; File name primitives.
 
 (defun tramp-gvfs-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+  (filename newname &optional ok-if-already-exists keep-date
+           preserve-uid-gid preserve-selinux-context)
   "Like `copy-file' for Tramp files."
-  (copy-file
-   (if (tramp-gvfs-file-name-p filename)
-       (tramp-gvfs-fuse-file-name filename)
-     filename)
-   (if (tramp-gvfs-file-name-p newname)
-       (tramp-gvfs-fuse-file-name newname)
-     newname)
-   ok-if-already-exists keep-date preserve-uid-gid))
+  (let ((args
+        (list
+         (if (tramp-gvfs-file-name-p filename)
+             (tramp-gvfs-fuse-file-name filename)
+           filename)
+         (if (tramp-gvfs-file-name-p newname)
+             (tramp-gvfs-fuse-file-name newname)
+           newname)
+         ok-if-already-exists keep-date preserve-uid-gid)))
+    (when preserve-selinux-context
+      (setq args (append args (list preserve-uid-gid))))
+    (apply 'copy-file args)))
 
 (defun tramp-gvfs-handle-delete-directory (directory &optional recursive)
   "Like `delete-directory' for Tramp files."
@@ -620,6 +627,10 @@
   "Like `file-readable-p' for Tramp files."
   (file-readable-p (tramp-gvfs-fuse-file-name filename)))
 
+(defun tramp-gvfs-handle-file-selinux-context (filename)
+  "Like `file-selinux-context' for Tramp files."
+  (funcall 'file-selinux-context (tramp-gvfs-fuse-file-name filename)))
+
 (defun tramp-gvfs-handle-file-writable-p (filename)
   "Like `file-writable-p' for Tramp files."
   (file-writable-p (tramp-gvfs-fuse-file-name filename)))
@@ -682,6 +693,11 @@
   (with-tramp-gvfs-error-message filename 'set-file-modes
     (tramp-gvfs-fuse-file-name filename) mode))
 
+(defun tramp-gvfs-handle-set-file-selinux-context (filename context)
+  "Like `set-file-selinux-context' for Tramp files."
+  (with-tramp-gvfs-error-message filename 'set-file-selinux-context
+    (tramp-gvfs-fuse-file-name filename) context))
+
 (defun tramp-gvfs-handle-set-visited-file-modtime (&optional time-list)
   "Like `set-visited-file-modtime' for Tramp files."
   (let ((buffer-file-name (tramp-gvfs-fuse-file-name (buffer-file-name))))

=== modified file 'lisp/net/tramp-imap.el'
--- a/lisp/net/tramp-imap.el    2010-03-12 17:47:22 +0000
+++ b/lisp/net/tramp-imap.el    2010-04-23 14:12:05 +0000
@@ -124,7 +124,6 @@
     (file-executable-p . tramp-imap-handle-file-executable-p)
     (file-exists-p . tramp-imap-handle-file-exists-p)
     (file-local-copy . tramp-imap-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-imap-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -136,6 +135,8 @@
     (file-ownership-preserved-p . ignore)
     (file-readable-p . tramp-imap-handle-file-readable-p)
     (file-regular-p . tramp-handle-file-regular-p)
+    (file-remote-p . tramp-handle-file-remote-p)
+    ;; `file-selinux-context' performed by default handler.
     (file-symlink-p . tramp-handle-file-symlink-p)
     ;; `file-truename' performed by default handler
     (file-writable-p . tramp-imap-handle-file-writable-p)
@@ -150,6 +151,7 @@
     (make-symbolic-link . ignore)
     (rename-file . tramp-imap-handle-rename-file)
     (set-file-modes . ignore)
+    ;; `set-file-selinux-context' performed by default handler.
     (set-file-times . ignore) ;; tramp-imap-handle-set-file-times)
     (set-visited-file-modtime . ignore)
     (shell-command . ignore)
@@ -200,7 +202,8 @@
             (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))
 
 (defun tramp-imap-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+  (filename newname &optional ok-if-already-exists keep-date
+           preserve-uid-gid preserve-selinux-context)
   "Like `copy-file' for Tramp files."
   (tramp-imap-do-copy-or-rename-file
    'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))

=== modified file 'lisp/net/tramp-smb.el'
--- a/lisp/net/tramp-smb.el     2010-02-05 11:15:28 +0000
+++ b/lisp/net/tramp-smb.el     2010-04-23 14:12:05 +0000
@@ -164,7 +164,6 @@
     (file-executable-p . tramp-smb-handle-file-exists-p)
     (file-exists-p . tramp-smb-handle-file-exists-p)
     (file-local-copy . tramp-smb-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -176,6 +175,8 @@
     (file-ownership-preserved-p . ignore)
     (file-readable-p . tramp-smb-handle-file-exists-p)
     (file-regular-p . tramp-handle-file-regular-p)
+    (file-remote-p . tramp-handle-file-remote-p)
+    ;; `file-selinux-context' performed by default handler.
     (file-symlink-p . tramp-handle-file-symlink-p)
     ;; `file-truename' performed by default handler.
     (file-writable-p . tramp-smb-handle-file-writable-p)
@@ -190,6 +191,7 @@
     (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
     (rename-file . tramp-smb-handle-rename-file)
     (set-file-modes . tramp-smb-handle-set-file-modes)
+    ;; `set-file-selinux-context' performed by default handler.
     (set-file-times . ignore)
     (set-visited-file-modtime . ignore)
     (shell-command . ignore)
@@ -325,7 +327,8 @@
         'copy-directory (list dirname newname keep-date parents)))))))
 
 (defun tramp-smb-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+  (filename newname &optional ok-if-already-exists keep-date
+           preserve-uid-gid preserve-selinux-context)
   "Like `copy-file' for Tramp files.
 KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
 PRESERVE-UID-GID is completely ignored."

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2010-04-23 02:46:53 +0000
+++ b/lisp/net/tramp.el 2010-04-23 14:12:05 +0000
@@ -2036,6 +2036,8 @@
     (dired-uncache . tramp-handle-dired-uncache)
     (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+    (file-selinux-context . tramp-handle-file-selinux-context)
+    (set-file-selinux-context . tramp-handle-set-file-selinux-context)
     (vc-registered . tramp-handle-vc-registered))
   "Alist of handler functions.
 Operations not mentioned here will be handled by the normal Emacs functions.")
@@ -3028,6 +3030,46 @@
         "chown" nil nil nil
          (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
 
+(defun tramp-handle-file-selinux-context (filename)
+  "Like `file-selinux-context' for Tramp files."
+  (with-parsed-tramp-file-name filename nil
+    (with-file-property v localname "file-selinux-context"
+      (let ((context '(nil nil nil nil))
+           (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
+                           "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
+       (when (zerop (tramp-send-command-and-check
+                     v (format
+                        "%s -d -Z %s"
+                        (tramp-get-ls-command v)
+                        (tramp-shell-quote-argument localname))))
+         (with-current-buffer (tramp-get-connection-buffer v)
+           (goto-char (point-min))
+           (when (re-search-forward regexp (tramp-compat-line-end-position) t)
+             (setq context (list (match-string 1) (match-string 2)
+                                 (match-string 3) (match-string 4))))))
+       ;; Return the context.
+       context))))
+
+(defun tramp-handle-set-file-selinux-context (filename context)
+  "Like `set-file-selinux-context' for Tramp files."
+  (with-parsed-tramp-file-name filename nil
+    (if (and (consp context)
+            (zerop (tramp-send-command-and-check
+                    v (format "chcon %s %s %s %s %s"
+                              (if (stringp (nth 0 context))
+                                  (format "--user=%s" (nth 0 context)) "")
+                              (if (stringp (nth 1 context))
+                                  (format "--role=%s" (nth 1 context)) "")
+                              (if (stringp (nth 2 context))
+                                  (format "--type=%s" (nth 2 context)) "")
+                              (if (stringp (nth 3 context))
+                                  (format "--range=%s" (nth 3 context)) "")
+                              (tramp-shell-quote-argument localname)))))
+       (tramp-set-file-property v localname "file-selinux-context" context)
+      (tramp-set-file-property v localname "file-selinux-context" 'undef)))
+  ;; We always return nil.
+  nil)
+
 ;; Simple functions using the `test' command.
 
 (defun tramp-handle-file-executable-p (filename)
@@ -3473,8 +3515,6 @@
   (filename newname &optional ok-if-already-exists keep-date
            preserve-uid-gid preserve-selinux-context)
   "Like `copy-file' for Tramp files."
-  ;; Check if both files are local -- invoke normal copy-file.
-  ;; Otherwise, use Tramp from local system.
   (setq filename (expand-file-name filename))
   (setq newname (expand-file-name newname))
   (cond
@@ -3482,8 +3522,14 @@
    ((or (tramp-tramp-file-p filename)
        (tramp-tramp-file-p newname))
     (tramp-do-copy-or-rename-file
-     'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
+     'copy filename newname ok-if-already-exists keep-date
+     preserve-uid-gid preserve-selinux-context))
    ;; Compat section.
+   (preserve-selinux-context
+    (tramp-run-real-handler
+     'copy-file
+     (list filename newname ok-if-already-exists keep-date
+          preserve-uid-gid preserve-selinux-context)))
    (preserve-uid-gid
     (tramp-run-real-handler
      'copy-file
@@ -3544,7 +3590,8 @@
      'rename-file (list filename newname ok-if-already-exists))))
 
 (defun tramp-do-copy-or-rename-file
-  (op filename newname &optional ok-if-already-exists keep-date 
preserve-uid-gid)
+  (op filename newname &optional ok-if-already-exists keep-date
+      preserve-uid-gid preserve-selinux-context)
   "Copy or rename a remote file.
 OP must be `copy' or `rename' and indicates the operation to perform.
 FILENAME specifies the file to copy or rename, NEWNAME is the name of
@@ -3553,6 +3600,7 @@
 KEEP-DATE means to make sure that NEWNAME has the same timestamp
 as FILENAME.  PRESERVE-UID-GID, when non-nil, instructs to keep
 the uid and gid if both files are on the same host.
+PRESERVE-SELINUX-CONTEXT activates selinux commands.
 
 This function is invoked by `tramp-handle-copy-file' and
 `tramp-handle-rename-file'.  It is an error if OP is neither of `copy'
@@ -3561,6 +3609,8 @@
     (error "Unknown operation `%s', must be `copy' or `rename'" op))
   (let ((t1 (tramp-tramp-file-p filename))
        (t2 (tramp-tramp-file-p newname))
+       (context (and preserve-selinux-context
+                     (apply 'file-selinux-context (list filename))))
        pr tm)
 
     (when (and (not ok-if-already-exists) (file-exists-p newname))
@@ -3628,6 +3678,9 @@
         ;; One of them must be a Tramp file.
         (error "Tramp implementation says this cannot happen")))
 
+       ;; Handle `preserve-selinux-context'.
+       (when context (apply 'set-file-selinux-context (list newname context)))
+
        ;; In case of `rename', we must flush the cache of the source file.
        (when (and t1 (eq op 'rename))
         (with-parsed-tramp-file-name filename v1