session-func.c (set_callbacks): Validate callbacks

* libguile-ssh/session-func.c (set_callbacks): Ensure that callbacks are
  procedures.
  (scm_is_procedure, validate_callback): New procedures.
* tests/session.scm ("session-set!, invalid values"): Update.

2 files changed, 33 insertions, 3 deletions

diff --git a/libguile-ssh/session-func.c b/libguile-ssh/session-func.c
index dff4b50..af91bb2 100644
--- a/libguile-ssh/session-func.c
+++ b/libguile-ssh/session-func.c
@@ -262,6 +262,29 @@ libssh_connect_status_callback (void *userdata, float status)
   scm_call_2 (scm_callback, scm_from_double (status), scm_userdata);
 }
 
+/* Predicate.  Return 1 if X is a Scheme procedure, 0 otherwise. */
+static inline int
+scm_is_procedure (SCM x)
+{
+  return scm_to_bool (scm_procedure_p (x));
+}
+
+/* Validate callback NAME.  Throw 'guile-ssh-error' exception on an error. */
+static void
+validate_callback (SCM session, const struct session_data *sd, const char* name)
+{
+  if (! scm_is_procedure (callbacks_ref (sd, name)))
+    {
+      enum { BUFSZ = 70 };
+      char msg[BUFSZ];
+
+      snprintf (msg, BUFSZ, "'%s' must be a procedure", name);
+
+      guile_ssh_error1 ("session-set!", msg,
+                        scm_list_2 (session, sd->callbacks));
+    }
+}
+
 /* Set libssh callbacks for a SESSION.  The procedure expects CALLBACKS to be
    an alist object.
 
@@ -282,10 +305,16 @@ set_callbacks (SCM session, struct session_data *sd, SCM callbacks)
   cb->userdata = session;
 
   if (callback_set_p (callbacks, "global-request-callback"))
-    cb->global_request_function = libssh_global_request_callback;
+    {
+      validate_callback (session, sd, "global-request-callback");
+      cb->global_request_function = libssh_global_request_callback;
+    }
 
   if (callback_set_p (callbacks, "connect-status-callback"))
-    cb->connect_status_function = libssh_connect_status_callback;
+    {
+      validate_callback (session, sd, "connect-status-callback");
+      cb->connect_status_function = libssh_connect_status_callback;
+    }
 
   ssh_callbacks_init (cb);
 
diff --git a/tests/session.scm b/tests/session.scm
index e56ed7b..e5c054c 100644
--- a/tests/session.scm
+++ b/tests/session.scm
@@ -87,7 +87,8 @@
                    (log-verbosity     "string" -1 0 1 2 3 4 5)
                    (compression       12345)
                    (compression-level -1 0 10)
-                   (callbacks         "not a list")))
+                   (callbacks         "not a list"
+                                      ((global-request-callback . #f)))))
         (res #t))
     (for-each
      (lambda (opt)