Add Debian postinst script to update plugin indices after upgrades.

diff --git a/debian/changelog b/debian/changelog
index 4d73b5a921695cded461ab85d41455c9a29f72ea..8b704f2b1663221545fde8dcb41dc58fe134cd49 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+mit-scheme-pucked (9.2.12) birchwood; urgency=low
+
+  * Add a Debian postinst script to update plugin indices after upgrades.
+
+ -- Matt Birkholz <matt@birchwood-abbey.net>  Sat, 30 Dec 2017 00:00:00 -0000
+
 mit-scheme-pucked (9.2.11) birchwood; urgency=low
 
   * New upstream.  Removes md5 and mhash plugins.

diff --git a/debian/postinst.in b/debian/postinst.in
new file mode 100644 (file)
index 0000000..487eee2
--- /dev/null
+++ b/debian/postinst.in
@@ -0,0 +1,13 @@
+#!/bin/sh
+
+set -e
+
+( echo '(update-plugin-indices "@PROJECT@"'
+  echo '                       "@INFODIR@"'
+  echo '                       (system-library-directory-pathname)'
+  echo '                       "@SCMDOCDIR@")' ) \
+| /usr/bin/mit-scheme-pucked --batch-mode
+
+#DEBHELPER#
+
+exit 0

diff --git a/debian/mit-scheme-pucked.prerm b/debian/prerm
similarity index 100%
rename from debian/mit-scheme-pucked.prerm
rename to debian/prerm

diff --git a/debian/rules b/debian/rules
index 885b79378c55d297e85de3f496b9c96380cf8c3c..46d07ab7db0c11b8fbdec81d52bd91b9662fb7c3 100755 (executable)
--- a/debian/rules
+++ b/debian/rules
@@ -2,7 +2,7 @@
 
 #export DH_VERBOSE=1
 
-%:
+%: debian/postinst
        dh $@ --with autoreconf --parallel
 
 override_dh_autoreconf:
@@ -18,3 +18,8 @@ override_dh_auto_configure:
 override_dh_auto_install:
        dh_auto_install --sourcedirectory=src
        dh_auto_install --sourcedirectory=doc -- install-html install-pdf
+
+debian/%: debian/%.in
+       sed -e 's|@SCMDOCDIR@|/usr/share/doc/mit-scheme-pucked|g' \
+           -e 's|@INFODIR@|/usr/share/info|g' \
+           -e 's|@PROJECT@|mit-scheme-pucked|g' < $< > $@

diff --git a/src/ffi/build.scm b/src/ffi/build.scm
index 4eaef492327c86d19081d0437a4d9594e77140c3..0ad55d9ebcabe10a19a15ae3da3a13747f17daca 100644 (file)
--- a/src/ffi/build.scm
+++ b/src/ffi/build.scm
@@ -28,9 +28,11 @@ USA.
 ;;; package: (ffi build)
 
 (define (add-plugin name project infodir scmlibdir scmdocdir)
+  ;; For plugin postinst scripts: register.
   (update-plugin 'add name project infodir scmlibdir scmdocdir))
 
 (define (remove-plugin name project infodir scmlibdir scmdocdir)
+  ;; For plugin prerm scripts: de-register.
   (update-plugin 'remove name project infodir scmlibdir scmdocdir))
 
 (define (update-plugin operation name project infodir scmlibdir scmdocdir)
@@ -39,45 +41,68 @@ USA.
                      (->namestring (pathname-as-directory infodir))))
        (scmdocdir (and (not (string-null? scmdocdir))
                        (->namestring (pathname-as-directory scmdocdir)))))
-    (let ((plugins (updated-plugin-list operation name scmlibdir)))
-      (update-optiondb plugins scmlibdir)
-      (update-info-index project plugins infodir scmdocdir)
-      (update-html-index plugins scmdocdir))))
-
-(define (updated-plugin-list operation plugin scmlibdir)
-  (if (let ((filename (string scmlibdir"optiondb.scm")))
-       (file-exists? filename)) ;i.e. NOT in dpkg-buildpackage chroot
-      (let ((filename (string scmlibdir"plugins.scm")))
-       (if (file-exists? filename)
-           (rewrite-file
-            filename
-            (lambda (in out)
-              (cond ((eq? operation 'add)
-                     (let ((new (cons plugin (delete! plugin (read in)))))
-                       (write new out)
-                       new))
-                    ((eq? operation 'remove)
-                     (let ((new (delete! plugin (read in))))
-                       (write new out)
-                       new))
-                    (else
-                     (error "Unexpected plugin-list operation:" operation)))))
-           (cond ((eq? operation 'add)
-                  (let ((new (list plugin)))
-                    (call-with-exclusive-output-file
+    (if (file-exists? (string scmlibdir"optiondb.scm"))
+       ;; NOT in dpkg-buildpackage's chroot
+       (let ((plugins
+              (let ((filename (string scmlibdir"plugins.scm")))
+                (if (file-exists? filename)
+                    (rewrite-file
                      filename
-                     (lambda (out) (write new out)))
-                    new))
-                 ((eq? operation 'remove)
-                  (warn "plugin list not found:" filename)
-                  '())
-                 (else
-                  (error "Unexpected plugin-list operation:" operation)))))))
+                     (lambda (in out)
+                       (cond ((eq? operation 'add)
+                              (let ((new (cons name
+                                               (delete! name (read in)))))
+                                (write new out)
+                                new))
+                             ((eq? operation 'remove)
+                              (let ((new (delete! name (read in))))
+                                (write new out)
+                                new))
+                             (else
+                              (error "Unexpected plugin-list operation:"
+                                     operation)))))
+                    (cond ((eq? operation 'add)
+                           (let ((new (list name)))
+                             (call-with-exclusive-output-file
+                              filename
+                              (lambda (out) (write new out)))
+                             new))
+                          ((eq? operation 'remove)
+                           (warn "plugin list not found:" filename)
+                           '())
+                          (else
+                           (error "Unexpected plugin-list operation:"
+                                  operation)))))))
+         (update-optiondb plugins scmlibdir)
+         (update-info-index project plugins infodir scmdocdir)
+         (update-html-index plugins scmdocdir)))))
 
 (define (delete-plugin-list)
-  (let ((path (merge-pathnames "plugins.scm"
-                              (system-library-directory-pathname))))
-    (if (file-exists? path) (delete-file path))))
+  ;; For the prerm script: delete the database of plugins (plugins.scm
+  ;; file in the system library directory).
+  (let ((filename (string (->namestring (system-library-directory-pathname))
+                         "plugins.scm")))
+    (if (file-exists? filename)
+       (delete-file filename))))
+
+(define (update-plugin-indices project infodir scmlibdir scmdocdir)
+  ;; For the postinst script: re-initialize the optiondb, Info and
+  ;; HTML indices using the list of currently installed plugins.  (The
+  ;; indices are presumed clobbered by the core upgrade.)
+  (let ((scmlibdir (->namestring (pathname-as-directory scmlibdir)))
+       (infodir (and (not (string-null? infodir))
+                     (->namestring (pathname-as-directory infodir))))
+       (scmdocdir (and (not (string-null? scmdocdir))
+                       (->namestring (pathname-as-directory scmdocdir)))))
+    (let* ((pathname (string scmlibdir"plugins.scm"))
+          (plugins (if (file-exists? pathname)
+                       (call-with-input-file pathname read)
+                       '())))
+      (if (not (null? plugins))
+         (begin
+           (update-optiondb plugins scmlibdir)
+           (update-info-index project plugins infodir scmdocdir)
+           (update-html-index plugins scmdocdir))))))
 
 (define (update-optiondb plugins scmlibdir)
   (let ((filename (string scmlibdir"optiondb.scm")))
@@ -148,7 +173,9 @@ USA.
                                        "\n") out)
 
           ;; Write new list.
-          (let ((names.titles (html-names.titles plugins scmhtmldir)))
+          (let ((names.titles (sort (html-names.titles plugins scmhtmldir)
+                                    (lambda (a b)
+                                      (string<? (cdr a) (cdr b))))))
             (for-each
               (lambda (name.title)
                 (write-string "<li><a href=\"" out)

diff --git a/src/ffi/ffi.pkg b/src/ffi/ffi.pkg
index c8c246cde815f4c6ade96e49b27d6c9aa49acacb..7f0b66f081f34319b68cb9854d2ea0be855d51b4 100644 (file)
--- a/src/ffi/ffi.pkg
+++ b/src/ffi/ffi.pkg
@@ -42,4 +42,6 @@ FFI System Packaging |#
   (files "build")
   (export (ffi)
          add-plugin
-         remove-plugin))
\ No newline at end of file
+         remove-plugin
+         delete-plugin-list
+         update-plugin-indices))
\ No newline at end of file

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 4bfd691dc554c102358c9bf4ce6f5d2b53122654..fe2707ebc44295aa5cf3577b0faa48c02bd653ef 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -606,6 +606,15 @@ USA.
   ((environment-lookup (->environment '(ffi)) 'remove-plugin)
    name project infodir scmlibdir scmdocdir))
 
+(define (delete-plugin-list)
+  (load-option-quietly 'ffi)
+  ((environment-lookup (->environment '(ffi)) 'delete-plugin-list)))
+
+(define (update-plugin-indices project infodir scmlibdir scmdocdir)
+  (load-option-quietly 'ffi)
+  ((environment-lookup (->environment '(ffi)) 'update-plugin-indices)
+   project infodir scmlibdir scmdocdir))
+
 (define (load-option-quietly name)
   (if (not (option-loaded? name))
       (let ((kernel

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 2a9fdcd704621713adafb51d49a02fc5fae02955..bfcef14df600ccb9d143582b52bfa41f173f213a 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3654,7 +3654,9 @@ USA.
          register-c-callback
          set-alien/ctype!
          add-plugin
-         remove-plugin)
+         remove-plugin
+         delete-plugin-list
+         update-plugin-indices)
   (initialization (initialize-package!)))
 
 (define-package (runtime program-copier)

diff --git a/src/runtime/version.scm b/src/runtime/version.scm
index 22b6ced8ae0fcef7dbfd56501c5a2821596933b0..804f63ead2b4653ed5048607f5dccd08448ab0d5 100644 (file)
--- a/src/runtime/version.scm
+++ b/src/runtime/version.scm
@@ -39,7 +39,7 @@ USA.
         (let ((now last-copyright-year)
               (then 1986))
           (iota (+ (- now then) 1) then)))
-   (add-subsystem-identification! "Release" '(9 2 11))
+   (add-subsystem-identification! "Release" '(9 2 12))
    (snarf-microcode-version!)
    (add-event-receiver! event:after-restore snarf-microcode-version!)
    (add-subsystem-identification! "Runtime" '(15 8))))