guix-devel
[Top][All Lists]
Advanced

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

[PATCH 3/3] emacs: Do not allow to modify system profiles.


From: Alex Kost
Subject: [PATCH 3/3] emacs: Do not allow to modify system profiles.
Date: Sat, 13 Feb 2016 22:04:43 +0300

Fixes <http://bugs.gnu.org/22607>.
Reported by myglc2 <address@hidden>.

Remove possibilities to install/delete packages to/from a system profile
both for "Package List" and "Package Info" buffers.

* emacs/guix-profiles.el (guix-system-profile-regexp): New variable.
(guix-system-profile?): New procedure.
* emacs/guix-ui-package.el (guix-package-info-insert-output): Do not
display "Install"/"Delete" button for a system profile.
(guix-package-assert-non-system-profile): New procedure.
(guix-package-execute-actions): Use it.
---
 emacs/guix-profiles.el   |  8 ++++++++
 emacs/guix-ui-package.el | 27 ++++++++++++++++++++++-----
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/emacs/guix-profiles.el b/emacs/guix-profiles.el
index 43ad1d4..12cf46d 100644
--- a/emacs/guix-profiles.el
+++ b/emacs/guix-profiles.el
@@ -40,6 +40,14 @@
 (defvar guix-current-profile guix-default-profile
   "Current profile.")
 
+(defvar guix-system-profile-regexp
+  (concat "\\`" (regexp-quote guix-system-profile))
+  "Regexp matching system profiles.")
+
+(defun guix-system-profile? (profile)
+  "Return non-nil, if PROFILE is a system one."
+  (string-match-p guix-system-profile-regexp profile))
+
 (defun guix-profile-prompt (&optional default)
   "Prompt for profile and return it.
 Use DEFAULT as a start directory.  If it is nil, use
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
index 78d2c40..c92108b 100644
--- a/emacs/guix-ui-package.el
+++ b/emacs/guix-ui-package.el
@@ -454,17 +454,22 @@ current OUTPUT is installed (if there is such output in
                              (string= (guix-entry-value entry 'output)
                                       output))
                            installed))
-         (action-type (if installed-entry 'delete 'install)))
+         (action-type (if installed-entry 'delete 'install))
+         (profile (guix-ui-current-profile)))
     (guix-info-insert-indent)
     (guix-format-insert output
                         (if installed-entry
                             'guix-package-info-installed-outputs
                           'guix-package-info-uninstalled-outputs)
                         guix-package-info-output-format)
-    (guix-package-info-insert-action-button action-type entry output)
-    (when obsolete
-      (guix-info-insert-indent)
-      (guix-package-info-insert-action-button 'upgrade entry output))
+    ;; Do not allow to install/delete anything to/from a system profile,
+    ;; so add action buttons only for non-system profiles.
+    (when (and profile
+               (not (guix-system-profile? profile)))
+      (guix-package-info-insert-action-button action-type entry output)
+      (when obsolete
+        (guix-info-insert-indent)
+        (guix-package-info-insert-action-button 'upgrade entry output)))
     (insert "\n")
     (when installed-entry
       (guix-info-insert-entry installed-entry 'installed-output 2))))
@@ -723,10 +728,22 @@ take an entry as argument."
             'upgrade nil
             (guix-package-installed-outputs entry)))))
 
+(defun guix-package-assert-non-system-profile ()
+  "Verify that the current profile is not a system one.
+The current profile is the one used by the current buffer."
+  (let ((profile (guix-ui-current-profile)))
+    (and profile
+         (guix-system-profile? profile)
+         (user-error "Packages cannot be installed or removed to/from \
+profile '%s'.
+Use 'guix system reconfigure' shell command to modify a system profile."
+                     profile))))
+
 (defun guix-package-execute-actions (fun)
   "Perform actions on the marked packages.
 Use FUN to define actions suitable for `guix-process-package-actions'.
 FUN should take action-type as argument."
+  (guix-package-assert-non-system-profile)
   (let ((actions (delq nil
                        (mapcar fun '(install delete upgrade)))))
     (if actions
-- 
2.6.3




reply via email to

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