~ruther/guix-local

260795b7369c51d99c7ab4f3ef24f195938beabf — Alex Kost 10 years ago 0338132
emacs: Do not allow a user to modify system profiles.

Fixes <http://bugs.gnu.org/22607>.
Reported by myglc2 <myglc2@gmail.com>.

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.
2 files changed, 30 insertions(+), 5 deletions(-)

M emacs/guix-profiles.el
M emacs/guix-ui-package.el
M emacs/guix-profiles.el => emacs/guix-profiles.el +8 -0
@@ 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

M emacs/guix-ui-package.el => emacs/guix-ui-package.el +22 -5
@@ 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 a user 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