From: Matt Birkholz Date: Fri, 12 Jan 2018 03:38:38 +0000 (-0700) Subject: Add Debian postinst script to update plugin indices after upgrades. X-Git-Tag: mit-scheme-pucked-9.2.12~5 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c8884ccba2014c96b66eabdb37c213f5e9cd29f9;p=mit-scheme.git Add Debian postinst script to update plugin indices after upgrades. --- diff --git a/debian/changelog b/debian/changelog index 4d73b5a92..8b704f2b1 100644 --- 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 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 index 000000000..487eee208 --- /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 885b79378..46d07ab7d 100755 --- 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 4eaef4923..0ad55d9eb 100644 --- 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) + (stringenvironment '(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 2a9fdcd70..bfcef14df 100644 --- 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 22b6ced8a..804f63ead 100644 --- 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))))