From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#27952: 26.0.50; Combine archive-int-to-mode and tar-grind-file-mode Date: Wed, 16 Aug 2017 20:43:17 +0900 Message-ID: <87efsb7n6y.fsf@calancha-pc> References: <8760e3zf6v.fsf@calancha-pc> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1502883865 21367 195.159.176.226 (16 Aug 2017 11:44:25 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 16 Aug 2017 11:44:25 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: stefan monnier To: 27952@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Aug 16 13:44:16 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dhwk5-0004h7-9e for geb-bug-gnu-emacs@m.gmane.org; Wed, 16 Aug 2017 13:44:09 +0200 Original-Received: from localhost ([::1]:40515 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dhwkB-0004NY-Oe for geb-bug-gnu-emacs@m.gmane.org; Wed, 16 Aug 2017 07:44:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54428) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dhwk4-0004KP-4Z for bug-gnu-emacs@gnu.org; Wed, 16 Aug 2017 07:44:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dhwjz-0008GD-43 for bug-gnu-emacs@gnu.org; Wed, 16 Aug 2017 07:44:08 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:59821) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dhwjy-0008Fw-Uw for bug-gnu-emacs@gnu.org; Wed, 16 Aug 2017 07:44:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dhwjy-0002ih-C9 for bug-gnu-emacs@gnu.org; Wed, 16 Aug 2017 07:44:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 16 Aug 2017 11:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27952 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 27952-submit@debbugs.gnu.org id=B27952.150288381810413 (code B ref 27952); Wed, 16 Aug 2017 11:44:02 +0000 Original-Received: (at 27952) by debbugs.gnu.org; 16 Aug 2017 11:43:38 +0000 Original-Received: from localhost ([127.0.0.1]:40269 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dhwja-0002hs-4u for submit@debbugs.gnu.org; Wed, 16 Aug 2017 07:43:38 -0400 Original-Received: from mail-pf0-f178.google.com ([209.85.192.178]:36261) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dhwjY-0002he-5F for 27952@debbugs.gnu.org; Wed, 16 Aug 2017 07:43:36 -0400 Original-Received: by mail-pf0-f178.google.com with SMTP id c28so5295517pfe.3 for <27952@debbugs.gnu.org>; Wed, 16 Aug 2017 04:43:36 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=xwXgytBJ29Jbpxs/AFDHk+JSDgkVca7MYvA8f/UqETo=; b=kMkgbmIY1MsSdKLWp+1SXmvkIqi/lmGwE2bkay2poJ0WDsBZGChjWYbOJxpvTxSGlD JhgRBi7vEw1dqFBAXBPnbsPPS26rwQObutSaRDKAce/px5KmBzUrvcpjCjox7tu1W0yI c5i5Dr0bOkPxKDR65rPvUJU2x1vO84p8miEabpRLx833EQnhZ4uVDufHBhRlFZnMcLrA 0C4WDoYhsDxxVQiKjyoYPJBJiX0RXfx3l9KqPfKXhm2k4BrH4XLeB0FGbiUBmsSBhD8+ w/IHaeLrIfZKZ3VaJcOzQOUBlsdifGC16bpIEauHTzORF6iDQ7yiWcZNmrIp6lhtuLGV aYWg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=xwXgytBJ29Jbpxs/AFDHk+JSDgkVca7MYvA8f/UqETo=; b=tsltWQ+ZPdrhqTvQvdfjvp5QIrM+T0SoVbm9YirDOPj0EjIdiZt3ly24KE8dcckOTR Q2qUC31ZddWXiFplwKHCyGpQMWhXuRmHp3Mnkh4ROSuamZmiNWNGD4eUwjLPSoLwpyD8 X8pl2iER5fhJg0n7TmDOQ35bmSzphLGJQhH3Ah7NLZqmnv5Ae6Uml3VSB+/pmRhLj43F dCbCmAd8i0klU5R/BxsAhKA+0nA+Q1Q19sMlT1YA1Q+KbKNYkSgnxHYH1KULp8hBgpi+ 5BrHcuJ3NsZMCGBmPMeFe/vs0/eR8NFoGGOF96kHVCkXt86rOYi/+eNbf/dD7c/z45jP AAiw== X-Gm-Message-State: AHYfb5h1Jr7ILIB8NKt7nC1Gvu5XflEk8Wkx2e+7uGx+PeHeM5DK+TFl IpQWvfvRSnenSg== X-Received: by 10.99.106.65 with SMTP id f62mr307732pgc.32.1502883809904; Wed, 16 Aug 2017 04:43:29 -0700 (PDT) Original-Received: from calancha-pc (170.224.128.101.dy.bbexcite.jp. [101.128.224.170]) by smtp.gmail.com with ESMTPSA id m3sm2074302pfg.16.2017.08.16.04.43.27 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 16 Aug 2017 04:43:29 -0700 (PDT) In-Reply-To: <8760e3zf6v.fsf@calancha-pc> (Tino Calancha's message of "Fri, 04 Aug 2017 21:32:24 +0900") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:135806 Archived-At: Tino Calancha 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 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