channel-func.c (guile_ssh_channel_get_exit_status): Handle freed channels

* libguile-ssh/channel-func.c (guile_ssh_channel_get_exit_status): Throw
  'wrong-type-arg' if a freed channel is passed as an argument.
* libguile-ssh/channel-type.h (GSSH_VALIDATE_OPEN_CHANNEL): Check if a channel
  is freed.
* tests/client-server.scm ("channel-get-exit-status, freed channel"): New test
  case.
* tests/common.scm (test-error-with-log/=): Check error key and message
  properly.
  (test-error-with-log): Check an error key.
  (test-error-with-log/handler): Remove extra rules.
* NEWS: Update.

5 files changed, 53 insertions, 9 deletions

diff --git a/NEWS b/NEWS
index 397c653..27be873 100644
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,9 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com>
 
 * Unreleased
 ** Bugfixes
+*** In (ssh channel)
+    'channel-get-exit-status' now handles freed channels properly by throwing
+    'wrong-type-arg' error.
 *** In (ssh dist node)
 **** 'node-guile-version' now does not fail
      The procedure would always fail to get Guile version.  Now that should be
diff --git a/libguile-ssh/channel-func.c b/libguile-ssh/channel-func.c
index f657102..4e2980f 100644
--- a/libguile-ssh/channel-func.c
+++ b/libguile-ssh/channel-func.c
@@ -101,11 +101,12 @@ returned (yet). \
 ")
 #define FUNC_NAME s_guile_ssh_channel_get_exit_status
 {
-  struct channel_data *cd = _scm_to_channel_data (channel);
+  struct channel_data *cd = NULL;
   int res;
 
   GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME);
 
+  cd = _scm_to_channel_data (channel);
   res = ssh_channel_get_exit_status (cd->ssh_channel);
   if (res == SSH_ERROR) {
     _gssh_log_warning (FUNC_NAME,
diff --git a/libguile-ssh/channel-type.h b/libguile-ssh/channel-type.h
index 72bd16b..2584dde 100644
--- a/libguile-ssh/channel-type.h
+++ b/libguile-ssh/channel-type.h
@@ -44,6 +44,8 @@ struct channel_data {
 /* Make sure that the channel SCM is open. */
 #define GSSH_VALIDATE_OPEN_CHANNEL(scm, pos, fn)                        \
   do {                                                                  \
+    if (! SCM_PTAB_ENTRY (channel))                                     \
+      scm_wrong_type_arg_msg (fn, pos, scm, "open channel");            \
     SCM_ASSERT_TYPE (SCM_OPPORTP (scm), scm, pos, fn, "open channel");  \
   } while (0)
 
diff --git a/tests/client-server.scm b/tests/client-server.scm
index 702cd3a..e6abf9f 100644
--- a/tests/client-server.scm
+++ b/tests/client-server.scm
@@ -483,6 +483,7 @@
             (else
              (message-reply-success msg))))))))
 
+;; TODO: Fix the bug: the procedure cannot be used to test errors.
 (define (call-with-connected-session/channel-test proc)
   (define (loop count)
     (catch #t
@@ -604,6 +605,22 @@
           (string-match "#<unknown channel \\(freed\\) [0-9a-f]+>"
                         (object->string channel))))))))
 
+(test-error-with-log "channel-get-exit-status, freed channel"
+  'wrong-type-arg
+  (run-client-test
+   start-server/channel-test
+   ;; client
+   (lambda ()
+     (call-with-connected-session
+      (lambda (session)
+        (authenticate-server session)
+        (userauth-none! session)
+        (let ((channel (make-channel session)))
+          (channel-open-session channel)
+          (channel-request-exec channel "uname")
+          (close channel)
+          (channel-get-exit-status channel)))))))
+
 
 ;; data transferring
 ;; FIXME: Probably these TCs can be implemented more elegantly.
diff --git a/tests/common.scm b/tests/common.scm
index e6b11c4..b84f9f0 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -99,11 +99,6 @@
 ;; with HANDLER.
 (define-syntax test-error-with-log/handler
   (syntax-rules ()
-    ((_ name error expr handler)
-     (test-assert-with-log name
-       (catch error
-         (lambda () expr #f)
-         handler)))
     ((_ name expr handler)
      (test-assert-with-log name
        (catch #t
@@ -113,15 +108,41 @@
 ;; Ensure that the specific ERROR is raised during the test and the error is
 ;; raised with the specified MESSAGE.
 (define-syntax-rule (test-error-with-log/= name error expected-message expr)
-  (test-error-with-log/handler error expr
+  (test-error-with-log/handler name expr
                                (lambda (key . args)
-                                 (string=? (cadr args) expected-message))))
+                                 (if (equal? key error)
+                                     (let* ((message (cadr args))
+                                            (result  (string=? message
+                                                               expected-message)))
+                                       (unless result
+                                         (format-log/scm 'nolog name
+                                                         (string-append
+                                                          "Messages do not match: "
+                                                          "expected \"~a\", got \"~a\"")
+                                                         result expected-message))
+                                       result)
+                                     (begin
+                                       (format-log/scm 'nolog name
+                                                       (string-append
+                                                        "Errors do not match: "
+                                                        "expected '~a', got '~a' (args: ~a)")
+                                                       error key args)
+                                       #f)))))
 
 ;; Ensure that the specific ERROR is raised during the test.
 (define-syntax test-error-with-log
   (syntax-rules ()
     ((_ name error expr)
-     (test-error-with-log/handler name error expr (const #t)))
+     (test-error-with-log/handler name expr
+                                  (lambda (key . args)
+                                    (let ((result (equal? key error)))
+                                      (unless result
+                                        (format-log/scm 'nolog name
+                                                        (string-append
+                                                         "Errors do not match: "
+                                                         "expected ~a, got ~a (args: ~a)")
+                                                        error key args))
+                                      result))))
     ((_ name expr)
      (test-error-with-log/handler name expr (const #t)))))