Implement Ada exception processing

Register a global exception action with the Ada runtime to log uncaught
exceptions to the daemon log and terminate.

8 files changed, 146 insertions, 1 deletions

diff --git a/src/charon-tkm/build_charon.gpr b/src/charon-tkm/build_charon.gpr
index bf6880668..b208667a3 100644
--- a/src/charon-tkm/build_charon.gpr
+++ b/src/charon-tkm/build_charon.gpr
@@ -13,4 +13,8 @@ project Build_Charon is
         & "-Werror";
    end Compiler;
 
+   package Binder is
+      for Default_Switches ("ada") use Build_Common.Ada_Binder_Switches;
+   end Binder;
+
 end Build_Charon;
diff --git a/src/charon-tkm/build_common.gpr b/src/charon-tkm/build_common.gpr
index e32832a28..ac322d713 100644
--- a/src/charon-tkm/build_common.gpr
+++ b/src/charon-tkm/build_common.gpr
@@ -19,4 +19,7 @@ project Build_Common is
                              "-fstack-check",
                              "-gnato",
                              "-g");
+
+   Ada_Binder_Switches   := ("-E");
+
 end Build_Common;
diff --git a/src/charon-tkm/build_tests.gpr b/src/charon-tkm/build_tests.gpr
index 7aa07003a..032c7969e 100644
--- a/src/charon-tkm/build_tests.gpr
+++ b/src/charon-tkm/build_tests.gpr
@@ -3,7 +3,7 @@ with "build_common";
 project Build_Tests is
 
    for Languages use ("Ada", "C");
-   for Source_Dirs use ("src/tkm", "src/ees", "tests");
+   for Source_Dirs use ("src/ees", "src/ehandler", "src/tkm", "tests");
    for Main use ("test_runner");
    for Object_Dir use Build_Common.Obj_Dir;
 
diff --git a/src/charon-tkm/src/ehandler/eh_callbacks.c b/src/charon-tkm/src/ehandler/eh_callbacks.c
new file mode 100644
index 000000000..7dca97c3e
--- /dev/null
+++ b/src/charon-tkm/src/ehandler/eh_callbacks.c
@@ -0,0 +1,28 @@
+/*
+ * Copyright (C) 2012 Reto Buerki
+ * Copyright (C) 2012 Adrian-Ken Rueegsegger
+ * Hochschule fuer Technik Rapperswil
+ *
+ * This program 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.  See <http://www.fsf.org/copyleft/gpl.txt>.
+ *
+ * This program 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.
+ */
+
+#include <sys/types.h>
+#include <signal.h>
+#include <utils/debug.h>
+
+#include "eh_callbacks.h"
+
+void charon_terminate(char *msg)
+{
+	DBG1(DBG_DMN, "critical TKM error, terminating!");
+	DBG1(DBG_DMN, msg);
+	kill(0, SIGTERM);
+}
diff --git a/src/charon-tkm/src/ehandler/eh_callbacks.h b/src/charon-tkm/src/ehandler/eh_callbacks.h
new file mode 100644
index 000000000..1be924913
--- /dev/null
+++ b/src/charon-tkm/src/ehandler/eh_callbacks.h
@@ -0,0 +1,25 @@
+/*
+ * Copyright (C) 2012 Reto Buerki
+ * Copyright (C) 2012 Adrian-Ken Rueegsegger
+ * Hochschule fuer Technik Rapperswil
+ *
+ * This program 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.  See <http://www.fsf.org/copyleft/gpl.txt>.
+ *
+ * This program 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.
+ */
+
+#ifndef EH_CALLBACKS_H_
+#define EH_CALLBACKS_H_
+
+/**
+ * Log given message and terminate charon.
+ */
+void charon_terminate(char *msg);
+
+#endif /** EH_CALLBACKS_H_ */
diff --git a/src/charon-tkm/src/ehandler/exception_handler.adb b/src/charon-tkm/src/ehandler/exception_handler.adb
new file mode 100644
index 000000000..3f165e1cd
--- /dev/null
+++ b/src/charon-tkm/src/ehandler/exception_handler.adb
@@ -0,0 +1,57 @@
+--
+--  Copyright (C) 2012 Reto Buerki
+--  Copyright (C) 2012 Adrian-Ken Rueegsegger
+--  Hochschule fuer Technik Rapperswil
+--
+--  This program 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.  See <http://www.fsf.org/copyleft/gpl.txt>.
+--
+--  This program 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.
+--
+
+with Ada.Exceptions;
+
+with GNAT.Exception_Actions;
+
+with Interfaces.C.Strings;
+
+package body Exception_Handler
+is
+
+   procedure Charon_Terminate (Message : Interfaces.C.Strings.chars_ptr);
+   pragma Import (C, Charon_Terminate, "charon_terminate");
+
+   procedure Bailout (Ex : Ada.Exceptions.Exception_Occurrence);
+   --  Signal critical condition to charon daemon.
+
+   -------------------------------------------------------------------------
+
+   procedure Bailout (Ex : Ada.Exceptions.Exception_Occurrence)
+   is
+   begin
+      if Ada.Exceptions.Exception_Name (Ex) = "_ABORT_SIGNAL" then
+
+         --  Ignore runtime-internal abort signal exception.
+
+         return;
+      end if;
+
+      Charon_Terminate (Message => Interfaces.C.Strings.New_String
+                        (Ada.Exceptions.Exception_Information (Ex)));
+   end Bailout;
+
+   -------------------------------------------------------------------------
+
+   procedure Init
+   is
+   begin
+      GNAT.Exception_Actions.Register_Global_Action
+        (Action => Bailout'Access);
+   end Init;
+
+end Exception_Handler;
diff --git a/src/charon-tkm/src/ehandler/exception_handler.ads b/src/charon-tkm/src/ehandler/exception_handler.ads
new file mode 100644
index 000000000..29dd3d8f4
--- /dev/null
+++ b/src/charon-tkm/src/ehandler/exception_handler.ads
@@ -0,0 +1,24 @@
+--
+--  Copyright (C) 2012 Reto Buerki
+--  Copyright (C) 2012 Adrian-Ken Rueegsegger
+--  Hochschule fuer Technik Rapperswil
+--
+--  This program 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.  See <http://www.fsf.org/copyleft/gpl.txt>.
+--
+--  This program 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.
+--
+
+package Exception_Handler
+is
+
+   procedure Init;
+   pragma Export (C, Init, "ehandler_init");
+   --  Register last-chance exception handler.
+
+end Exception_Handler;
diff --git a/src/charon-tkm/src/tkm/tkm.c b/src/charon-tkm/src/tkm/tkm.c
index cdd4f4ad7..6e27586ed 100644
--- a/src/charon-tkm/src/tkm/tkm.c
+++ b/src/charon-tkm/src/tkm/tkm.c
@@ -26,6 +26,7 @@ typedef struct private_tkm_t private_tkm_t;
 
 extern result_type ees_server_init(const char * const address);
 extern void ees_server_finalize(void);
+extern void ehandler_init(void);
 
 /*
  * Private additions to tkm_t.
@@ -60,6 +61,9 @@ bool tkm_init()
 
 	/* initialize TKM client library */
 	tkmlib_init();
+
+	ehandler_init();
+
 	if (ike_init(IKE_SOCKET) != TKM_OK)
 	{
 		tkmlib_final();