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.
This commit is contained in:
		
							parent
							
								
									0338132e65
								
							
						
					
					
						commit
						260795b736
					
				
					 2 changed files with 30 additions and 5 deletions
				
			
		|  | @ -40,6 +40,14 @@ | ||||||
| (defvar guix-current-profile guix-default-profile | (defvar guix-current-profile guix-default-profile | ||||||
|   "Current 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) | (defun guix-profile-prompt (&optional default) | ||||||
|   "Prompt for profile and return it. |   "Prompt for profile and return it. | ||||||
| Use DEFAULT as a start directory.  If it is nil, use | Use DEFAULT as a start directory.  If it is nil, use | ||||||
|  |  | ||||||
|  | @ -454,17 +454,22 @@ current OUTPUT is installed (if there is such output in | ||||||
|                              (string= (guix-entry-value entry 'output) |                              (string= (guix-entry-value entry 'output) | ||||||
|                                       output)) |                                       output)) | ||||||
|                            installed)) |                            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-info-insert-indent) | ||||||
|     (guix-format-insert output |     (guix-format-insert output | ||||||
|                         (if installed-entry |                         (if installed-entry | ||||||
|                             'guix-package-info-installed-outputs |                             'guix-package-info-installed-outputs | ||||||
|                           'guix-package-info-uninstalled-outputs) |                           'guix-package-info-uninstalled-outputs) | ||||||
|                         guix-package-info-output-format) |                         guix-package-info-output-format) | ||||||
|  |     ;; 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) |       (guix-package-info-insert-action-button action-type entry output) | ||||||
|       (when obsolete |       (when obsolete | ||||||
|         (guix-info-insert-indent) |         (guix-info-insert-indent) | ||||||
|       (guix-package-info-insert-action-button 'upgrade entry output)) |         (guix-package-info-insert-action-button 'upgrade entry output))) | ||||||
|     (insert "\n") |     (insert "\n") | ||||||
|     (when installed-entry |     (when installed-entry | ||||||
|       (guix-info-insert-entry installed-entry 'installed-output 2)))) |       (guix-info-insert-entry installed-entry 'installed-output 2)))) | ||||||
|  | @ -723,10 +728,22 @@ take an entry as argument." | ||||||
|             'upgrade nil |             'upgrade nil | ||||||
|             (guix-package-installed-outputs entry))))) |             (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) | (defun guix-package-execute-actions (fun) | ||||||
|   "Perform actions on the marked packages. |   "Perform actions on the marked packages. | ||||||
| Use FUN to define actions suitable for `guix-process-package-actions'. | Use FUN to define actions suitable for `guix-process-package-actions'. | ||||||
| FUN should take action-type as argument." | FUN should take action-type as argument." | ||||||
|  |   (guix-package-assert-non-system-profile) | ||||||
|   (let ((actions (delq nil |   (let ((actions (delq nil | ||||||
|                        (mapcar fun '(install delete upgrade))))) |                        (mapcar fun '(install delete upgrade))))) | ||||||
|     (if actions |     (if actions | ||||||
|  |  | ||||||
		Reference in a new issue