Subject: bug#27952: 26.0.50; Combine archive-int-to-mode and tar-grind-file-mode

From: Tino Calancha <[email-masked]>
Date: Wed, 16 Aug 2017 20:43:17 +0900

Tino Calancha <[email-masked]> writes:

> These functions are almost identical; archive-int-to-mode has a FIXME
> suggesting merging it with tar-grind-file-mode.
*)  Updated the patch after Bug#28092 has being fixed.
**) Now `archive-int-to-mode' also shows the sticky bit info as
    `tar-grind-file-mode' does:
     (archive-int-to-mode 996)
     => "-rwxr--r-T"
     (archive-int-to-mode 997)
     => "-rwxr--r-t"
     (tar-grind-file-mode 996)
     => "rwxr--r-T"
     (tar-grind-file-mode 997)
     => "rwxr--r-t"
     ;; `archive-int-to-mode' already was showing the 's' bit info, so
     ;; the fact that wasn't showing the sticky bit must be a mistake.

***) Added new tests.

Please, let me know if you want to have this patch in.
Tino

--8<-----------------------------cut here---------------start------------->8---
commit 74d1a07379a88f62fdb0e497111fdf4845723806
Author: Tino Calancha <[email-masked]>
Date:   Wed Aug 16 20:23:34 2017 +0900

    Combine archive-int-to-mode and tar-grind-file-mode
    
    These functions are almost identical.  Extract a new function
    'file-modes-number-to-symbolic' from them; use it to define
    'archive-int-to-mode' and 'tar-grind-file-mode' (Bug#27952).
    * lisp/files.el (file-modes-number-to-symbolic-1):
    New defun extracted from 'archive-int-to-mode' and 'tar-grind-file-mode'.
    (file-modes-number-to-symbolic):
    New defun;  like `file-modes-number-to-symbolic-1' with 2 optional arguments:
    'detailed' and 'from'.
    
    * lisp/tar-mode.el (tar-grind-file-mode)
    * lisp/arc-mode.el (archive-int-to-mode):
    Use file-modes-number-to-symbolic in its definition.
    
    * test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode):
    Update test.
    
    * test/lisp/files-tests.el (file-modes-symbolic-to-number)
    (file-modes-number-to-symbolic)
    (file-modes-number-to-symbolic-inverse): Add tests.

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 938c143b8e..c1987ee774 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -550,25 +550,10 @@ archive-l-e
     result))
 
 (defun archive-int-to-mode (mode)
-  "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
-  ;; FIXME: merge with tar-grind-file-mode.
-  (string
-    (if (zerop (logand  8192 mode))
-	(if (zerop (logand 16384 mode)) ?- ?d)
-      ?c) ; completeness
-    (if (zerop (logand   256 mode)) ?- ?r)
-    (if (zerop (logand   128 mode)) ?- ?w)
-    (if (zerop (logand    64 mode))
-	(if (zerop (logand  2048 mode)) ?- ?S)
-      (if (zerop (logand  2048 mode)) ?x ?s))
-    (if (zerop (logand    32 mode)) ?- ?r)
-    (if (zerop (logand    16 mode)) ?- ?w)
-    (if (zerop (logand     8 mode))
-	(if (zerop (logand  1024 mode)) ?- ?S)
-      (if (zerop (logand  1024 mode)) ?x ?s))
-    (if (zerop (logand     4 mode)) ?- ?r)
-    (if (zerop (logand     2 mode)) ?- ?w)
-    (if (zerop (logand     1 mode)) ?- ?x)))
+  "Construct a `-rw-r--r--' string indicating MODE.
+MODE should be an integer which is a file mode value.
+For instance, if mode is 448, then it produces `-rwx------'."
+  (file-modes-number-to-symbolic mode))
 
 (defun archive-calc-mode (oldmode newmode &optional error)
   "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
diff --git a/lisp/files.el b/lisp/files.el
index b05d453b0e..664ea943d9 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7143,6 +7143,95 @@ file-modes-rights-to-number
 	      op char-right)))
     num-rights))
 
+(defun file-modes-number-to-symbolic-1 (mode)
+  (string
+   (if (zerop (logand  8192 mode))
+       (if (zerop (logand 16384 mode)) ?- ?d)
+     ?c) ; completeness
+   (if (zerop (logand   256 mode)) ?- ?r)
+   (if (zerop (logand   128 mode)) ?- ?w)
+   (if (zerop (logand    64 mode))
+       (if (zerop (logand  2048 mode)) ?- ?S)
+     (if (zerop (logand  2048 mode)) ?x ?s))
+   (if (zerop (logand    32 mode)) ?- ?r)
+   (if (zerop (logand    16 mode)) ?- ?w)
+   (if (zerop (logand     8 mode))
+       (if (zerop (logand  1024 mode)) ?- ?S)
+     (if (zerop (logand  1024 mode)) ?x ?s))
+   (if (zerop (logand     4 mode)) ?- ?r)
+   (if (zerop (logand     2 mode)) ?- ?w)
+   (if (zerop (logand 512 mode))
+       (if (zerop (logand   1 mode)) ?- ?x)
+     (if (zerop (logand   1 mode)) ?T ?t))))
+
+(defun file-modes-number-to-symbolic (mode &optional detailed from)
+  "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------.
+If optional arg DETAILED is non-nil, then use the format 'u=rwx,g=,o='.
+If optional argument FROM is non-nil, then it's the original file mode
+ to compare with MODE.  FROM is ignored unless DETAILED is non-nil.
+
+For instance, if MODE is 448, DETAILED is non-nil, and FROM is 400,
+the output is 'u+x,g-w'.
+
+Note: This is not the inverse of `file-modes-symbolic-to-number';
+The reason is that this function might return an string containing 'S'
+or 'T' i.e., not valid characters for `file-modes-symbolic-to-number'.
+For example, (file-modes-symbolic-to-number \"o=t\") returns 512;
+and (file-modes-number-to-symbolic 512 t) returns \"o=T\"."
+  (let ((mode (file-modes-number-to-symbolic-1 mode))
+        (from (and from (substring (file-modes-number-to-symbolic-1 from) 1))))
+    (if (not detailed)
+        mode
+      (let ((replace-fn (lambda (x)
+                          (replace-regexp-in-string
+                           ",\\`" ""
+                           (replace-regexp-in-string
+                            "u=," ""
+                            (replace-regexp-in-string
+                             "g=," ""
+                             (replace-regexp-in-string
+                              "o=\\'" "" x)))))))
+        (setq mode (substring mode 1))
+        (cond (from
+               (let* ((res "u")
+                      (special-bit-fn (lambda (x y c C &optional inv) ; c or C in (x y)
+                                        (cond ((eq x c) ; xc
+                                               (cond ((eq y ?-) (string (if inv ?- ?+) ?x c))
+                                                     ((eq y ?x) (string (if inv ?- ?+) c))
+                                                     ((eq y C) (string (if inv ?- ?+) ?x))))
+                                              ((eq x C) ; just c
+                                               (cond ((eq y ?-) (string (if inv ?- ?+) c))
+                                                     ((eq y ?x) (if inv (string ?+ ?x c) (string ?- ?x ?+ c)))
+                                                     ((eq y c) (string (if inv ?+ ?-) ?x))))
+                                              (t nil))))
+                      (compare-fn (lambda (x y)
+                                    (cond ((eq x y) "")
+                                          ;; sticky bit or setuid setgid changes.
+                                          ((or (eq x ?t) (eq x ?T) (eq y ?t) (eq y ?T)
+                                               (eq x ?s) (eq x ?S) (eq y ?s) (eq y ?S))
+                                           (if (or (eq x ?t) (eq x ?T) (eq y ?t) (eq y ?T))
+                                               (or (funcall special-bit-fn x y ?t ?T)
+                                                   (funcall special-bit-fn y x ?t ?T 'inv))
+                                             (or (funcall special-bit-fn x y ?s ?S)
+                                                 (funcall special-bit-fn y x ?s ?S 'inv))))
+                                          ((eq x ?-) (string ?- y))
+                                          ((eq y ?-) (string ?+ x))))))
+                 (dotimes (i (length mode))
+                   (let ((x (aref mode i))
+                         (y (aref from i)))
+                     (when (= i 3) (setq res (concat res ",g")))
+                     (when (= i 6) (setq res (concat res ",o")))
+                     (setq res (concat res (funcall compare-fn x y)))))
+                 (funcall replace-fn res)))
+              (t
+               (funcall replace-fn
+                        (replace-regexp-in-string
+                         "-" ""
+                         (format "u=%s,g=%s,o=%s"
+                                 (substring mode 0 3)
+                                 (substring mode 3 6)
+                                 (substring mode 6))))))))))
+
 (defun file-modes-symbolic-to-number (modes &optional from)
   "Convert symbolic file modes to numeric file modes.
 MODES is the string to convert, it should match
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index b0d3177694..1843cfcc4a 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -470,23 +470,9 @@ tar-clip-time-string
 
 (defun tar-grind-file-mode (mode)
   "Construct a `rw-r--r--' string indicating MODE.
-MODE should be an integer which is a file mode value."
-  (string
-   (if (zerop (logand 256 mode)) ?- ?r)
-   (if (zerop (logand 128 mode)) ?- ?w)
-   (if (zerop (logand 2048 mode))
-       (if (zerop (logand  64 mode)) ?- ?x)
-     (if (zerop (logand  64 mode)) ?S ?s))
-   (if (zerop (logand  32 mode)) ?- ?r)
-   (if (zerop (logand  16 mode)) ?- ?w)
-   (if (zerop (logand 1024 mode))
-       (if (zerop (logand   8 mode)) ?- ?x)
-     (if (zerop (logand   8 mode)) ?S ?s))
-   (if (zerop (logand   4 mode)) ?- ?r)
-   (if (zerop (logand   2 mode)) ?- ?w)
-   (if (zerop (logand 512 mode))
-       (if (zerop (logand   1 mode)) ?- ?x)
-     (if (zerop (logand   1 mode)) ?T ?t))))
+MODE should be an integer which is a file mode value.
+For instance, if mode is 448, then it produces `rwx------'."
+  (substring (file-modes-number-to-symbolic mode) 1))
 
 (defun tar-header-block-summarize (tar-hblock &optional mod-p)
   "Return a line similar to the output of `tar -vtf'."
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index 8c8465d366..f136becf55 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -26,7 +26,7 @@
   (let ((alist (list (cons 448 "-rwx------")
                      (cons 420 "-rw-r--r--")
                      (cons 292 "-r--r--r--")
-                     (cons 512 "----------")
+                     (cons 512 "---------T")
                      (cons 1024 "------S---") ; Bug#28092
                      (cons 2048 "---S------"))))
     (dolist (x alist)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index a2f2b74312..fc3017027d 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -344,6 +344,71 @@ files-tests--with-temp-file
         (cdr path-res)
         (insert-directory-wildcard-in-dir-p (car path-res)))))))
 
+(ert-deftest file-modes-symbolic-to-number ()
+  (let ((alist '(("a=rwx" . 511)
+                 ("o=t" . 512)
+                 ("o=xt" . 513)
+                 ("o=tx" . 513) ; Order doesn't matter.
+                 ("u=rwx,g=rx,o=rx" . 493)
+                 ("u=rwx,g=,o=" . 448)
+                 ("u=rwx" . 448) ; Empty permissions can be ignored.
+                 ("u=rw,g=r,o=r" . 420)
+                 ("u=rw,g=r,o=t" . 928)
+                 ("u=rw,g=r,o=xt" . 929)
+                 ("u=rwxs,g=rs,o=xt" . 4065)
+                 ("u=rws,g=rs,o=t" . 4000)
+                 ("u=rws,g=rs,o=r" . 3492)
+                 ("a=r" . 292)
+                 ("u=S")
+                 ("u=T")
+                 ("u=Z"))))
+    (dolist (x alist)
+      (if (cdr-safe x)
+          (equal (cdr-safe x) (file-modes-symbolic-to-number (car x)))
+        (should-error (file-modes-symbolic-to-number (car x)))))))
+
+(ert-deftest file-modes-number-to-symbolic ()
+  (let ((from 644)
+        (fn #'file-modes-number-to-symbolic)
+        ;; Alist of the form (MODE RES1 RES2 RES3),
+        ;; MODE is the first argument of FN.
+        ;; RES1, the result of calling FN with 1 argument.
+        ;; RES2, the result of calling FN with 2nd arg non-nil.
+        ;; RES3, the result of calling FN with 2nd arg non-nil and 3rd arg FROM.
+        (alist '((493 "-rwxr-xr-x" "u=rwx,g=rx,o=rx" "u+r+x,g+r+x,o+xt")
+                 (448 "-rwx------" "u=rwx,g=,o=" "u+r+x,o-r-t")
+                 (420 "-rw-r--r--" "u=rw,g=r,o=r" "u+r,g+r,o-t")
+                 (928 "-rw-r----T" "u=rw,g=rx,o=r" "u+r,g+r,o-r")
+                 (929 "-rw-r----t" "u=rw,g=rx,o=rx" "u+r,g+r,o-r+x")
+                 (4065 "-rwsr-S--t" "u=rws,g=rS,o=t" "u+r+xs,g+r+s,o-r+x")
+                 (4000 "-rwSr-S--T" "u=rwS,g=rS,o=T" "u+r+s,g+r+s,o-r")
+                 (3492 "-rwSr-Sr--" "u=rwS,g=rS,o=r" "u+r+s,g+r+s,o-t")
+                 (292 "-r--r--r--" "u=r,g=r,o=r" "u+r-w,g+r,o-t")
+                 ("u=S")
+                 ("u=T")
+                 ("u=Z"))))
+    (dolist (x alist)
+      (cond ((cdr-safe x)
+             (let ((res1 (cadr x)) (res2 (caddr x)) (res3 (cadddr x)))
+               (equal res1 (funcall fn (car x)))
+               ;; FROM is ignored when DETAILED is nil.
+               (equal res1 (funcall fn (car x) nil from))
+               (equal res2 (funcall fn (car x) 'detailed))
+               (equal res3 (funcall fn (car x) 'detailed from))))
+            (t (should-error (funcall fn (car x))))))))
+
+(ert-deftest file-modes-number-to-symbolic-inverse ()
+  (dotimes (i 4096) ; from 0 to 7777 in octal.
+    ;; If neithr sticky bit nor set_uid not set_gid are set, then
+    ;; `file-modes-symbolic-to-number' is the inverse of
+    ;; `file-modes-number-to-symbolic'.
+    (when (and (zerop (logand i 512))
+               (zerop (logand i 1024))
+               (zerop (logand i 2048)))
+      (should
+       (= i
+          (file-modes-symbolic-to-number
+           (file-modes-number-to-symbolic i t)))))))
 
 (provide 'files-tests)
 ;;; files-tests.el ends here

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-08-16
Repository revision: 400934b694087f4fe94755d78cbd1569efdb1fa8