Implement Ada exception processing

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

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;

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;

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;
 

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);
+}

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_ */

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;

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;

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();