bug#64995: package.el: Safer package upgrade

bug#64995: package.el: Safer package upgrade

[Tegar Syahputra]

[-- Attachment #1: Type: text/plain, Size: 1187 bytes --]

The current `package-upgrade' from package.el delete old package
before installing the new one. This can be problematic if the user
interrupt the process or if there is some network problems.

Since `package-install' allow the same package to be installed if the
argument is of `package-desc' type. We can use this to make package
upgrade atomic by deferring `package-delete'.

Related thread: https://lists.gnu.org/archive/html/emacs-devel/2023-07/msg00887.html

================================

In GNU Emacs 29.1 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.38,
  cairo version 1.16.0) of 2023-07-25 built on sid
Repository revision: 906ecf442c43da98e6b8c7488f549691901690e9
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12101007
System Description: Debian GNU/Linux trixie/sid

Configured using:
  'configure --prefix=/usr/local --program-suffix=29
  --build=amd64-linux-gnu --enable-gtk-deprecation-warnings
  --enable-check-lisp-object-type --with-json --with-x-toolkit=gtk3
  --with-xwidgets --with-x --with-mailutils --with-imagemagick
  --with-native-compilation --with-file-notification=inotify
  --with-tree-sitter'


[-- Attachment #2: package-upgrade--diff.txt --]
[-- Type: text/plain, Size: 1691 bytes --]

diff -u --label \#\<buffer\ package.el.gz\> --label \#\<buffer\ \*scratch\*\> /tmp/buffer-content-4azQGZ /tmp/buffer-content-x8FLpt
--- #<buffer package.el.gz>
+++ #<buffer *scratch*>
@@ -2275,16 +2275,20 @@
 package using this command, first upgrade the package to a
 newer version from ELPA by using `\\<package-menu-mode-map>\\[package-menu-mark-install]' after `\\[list-packages]'."
   (interactive
-   (list (completing-read
-          "Upgrade package: " (package--upgradeable-packages) nil t)))
-  (let* ((package (if (symbolp name)
-                      name
-                    (intern name)))
-         (pkg-desc (cadr (assq package package-alist))))
-    (if (package-vc-p pkg-desc)
-        (package-vc-upgrade pkg-desc)
-      (package-delete pkg-desc 'force 'dont-unselect)
-      (package-install package 'dont-select))))
+   (list (intern (completing-read
+                  "Upgrade package: " (package--upgradeable-packages) nil t))))
+  (let* ((name (if (symbolp name)
+                   name
+                 (intern name)))
+         (old-pkg-desc (cadr (assq name package-alist)))
+         (new-pkg-desc (cadr (assq name package-archive-contents))))
+    (if (package-vc-p old-pkg-desc)
+        (package-vc-upgrade old-pkg-desc)
+      (unwind-protect
+          (package-install new-pkg-desc 'dont-select)
+        (if (package-installed-p (package-desc-name new-pkg-desc)
+                                 (package-desc-version new-pkg-desc))
+            (package-delete old-pkg-desc 'force 'dont-unselect))))))
 
 (defun package--upgradeable-packages ()
   ;; Initialize the package system to get the list of package

Diff finished.  Mon Jul 31 08:22:46 2023