Catch C++ xapian exceptions and raise them as scheme exceptions.

Uncaught C++ exceptions crash the guile process without providing
scheme code any opportunity to respond.

* except.i, xapian/error.scm: New files.
* xapian.i.in: Include except.i.
* Makefile.am (SOURCES): Add xapian/error.scm.
(xapian_wrap.cc xapian/wrap.scm &): Depend on except.i.

4 files changed, 85 insertions, 4 deletions

diff --git a/Makefile.am b/Makefile.am
index e88d63b..7c7785e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,5 +1,5 @@
 # guile-xapian --- Guile bindings for Xapian
-# Copyright © 2020, 2021, 2022 Arun Isaac <arunisaac@systemreboot.net>
+# Copyright © 2020, 2021, 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
 # Copyright © 2022 Bob131 <bob@bob131.so>
 #
 # This file is part of guile-xapian.
@@ -50,7 +50,7 @@ CLEANFILES = xapian.i xapian_wrap.cc xapian/wrap.scm
 xapian.i: xapian.i.in Makefile
 	sed -e 's|@libdir[@]|$(libdir)|g' -e 's|@GUILE_EFFECTIVE_VERSION[@]|$(GUILE_EFFECTIVE_VERSION)|g' $< > $@
 
-xapian_wrap.cc xapian/wrap.scm &: xapian.i xapian-head.i xapian-headers.i
+xapian_wrap.cc xapian/wrap.scm &: xapian.i xapian-head.i xapian-headers.i except.i
 	$(MKDIR_P) xapian
 	$(SWIG_GEN)$(SWIG) $(SWIG_FLAGS) -I$(srcdir) -scmstub -o xapian_wrap.cc -guile -package xapian -c++ $<
 
@@ -59,7 +59,7 @@ xapian_wrap.cc xapian/wrap.scm &: xapian.i xapian-head.i xapian-headers.i
 moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
 godir  = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
 
-SOURCES = xapian/wrap.scm xapian/xapian.scm
+SOURCES = xapian/error.scm xapian/wrap.scm xapian/xapian.scm
 GOBJECTS = $(SOURCES:%.scm=%.go)
 
 nobase_mod_DATA = $(SOURCES)
diff --git a/except.i b/except.i
new file mode 100644
index 0000000..fce1471
--- /dev/null
+++ b/except.i
@@ -0,0 +1,50 @@
+/* guile-xapian --- Guile bindings for Xapian
+ * Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
+ *
+ * This file is part of guile-xapian.
+ *
+ * guile-xapian is free software: you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 2 of the
+ * License, or (at your option) any later version.
+ *
+ * guile-xapian is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with guile-xapian.  If not, see
+ * <https://www.gnu.org/licenses/>.
+ */
+
+%{
+void handle_exception() {
+  string msg;
+  try {
+    throw;
+  } catch (const Xapian::Error &e) {
+    // TODO: Handle each Xapian error class separately and raise
+    // different scheme conditions for each.
+    msg = e.get_description();
+  } catch (const std::exception &e) {
+    msg = "std::exception: ";
+    msg += e.what();
+  } catch (...) {
+    msg = "unknown error in Xapian";
+  }
+  scm_call_1(scm_c_public_ref("xapian error", "raise-xapian-exception"),
+             scm_from_stringn(msg.c_str(),
+                              msg.length(),
+                              "us-ascii",
+                              SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE));
+}
+%}
+
+%exception {
+    try {
+	$function
+    } catch (...) {
+      handle_exception();
+    }
+}
diff --git a/xapian.i.in b/xapian.i.in
index f1ffe07..ff4ce80 100644
--- a/xapian.i.in
+++ b/xapian.i.in
@@ -1,5 +1,5 @@
 /* guile-xapian --- Guile bindings for Xapian
- * Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
+ * Copyright © 2020, 2023 Arun Isaac <arunisaac@systemreboot.net>
  * Copyright © 2021, 2022 Bob131 <bob@bob131.so>
  *
  * This file is part of guile-xapian.
@@ -89,6 +89,7 @@
 }
 
 %include xapian-head.i
+%include except.i
 %include xapian-headers.i
 
 %extend Xapian::ValueIterator {
diff --git a/xapian/error.scm b/xapian/error.scm
new file mode 100644
index 0000000..4187dda
--- /dev/null
+++ b/xapian/error.scm
@@ -0,0 +1,30 @@
+;;; guile-xapian --- Guile bindings for Xapian
+;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guile-xapian.
+;;;
+;;; guile-xapian is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 2 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; guile-xapian is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guile-xapian.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (xapian error)
+  #:use-module (rnrs conditions)
+  #:use-module (rnrs exceptions)
+  #:export (raise-xapian-exception))
+
+(define-condition-type &xapian-error &error
+  make-xapian-error xapian-error?
+  (message xapian-error-message))
+
+(define (raise-xapian-exception message)
+  (raise (make-xapian-error message)))