From 26fc959a239158c630a2066c2ef2aefd1908a2d9 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Fri, 1 Jun 2018 14:32:57 -0700
Subject: [PATCH] ffi: Add delete-plugin-list and update-plugin-indices

for the Debian install/uninstall scripts.
---
 src/ffi/build.scm   | 92 +++++++++++++++++++++++++++++++++------------
 src/ffi/ffi.pkg     |  4 +-
 src/runtime/ffi.scm |  9 +++++
 3 files changed, 79 insertions(+), 26 deletions(-)

diff --git a/src/ffi/build.scm b/src/ffi/build.scm
index dd3a79d51..4c51d4fc7 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,30 +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)
-  (let ((filename (string scmlibdir"plugins.scm")))
-    (if (file-exists? filename)	 ;i.e. NOT in dpkg-buildpackage chroot
-	(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)))))
-	(begin
-	  (warn "plugin list not found:" filename)
-	  '()))))
+    (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 (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)
+  ;; 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")))
@@ -133,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 7bc6362b7..8ccdf0c75 100644
--- 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 4c5dd8689..3f0fda933 100644
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -608,6 +608,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
-- 
2.25.1