Merge branch 'master' into wip-better-logging

3 files changed, 53 insertions, 21 deletions

diff --git a/doc/version.texi b/doc/version.texi
index 0fa494d..eda6d1c 100644
--- a/doc/version.texi
+++ b/doc/version.texi
@@ -1,4 +1,4 @@
-@set UPDATED 20 December 2015
-@set UPDATED-MONTH December 2015
+@set UPDATED 25 February 2016
+@set UPDATED-MONTH February 2016
 @set EDITION 0.9.0
 @set VERSION 0.9.0
diff --git a/tests/client-server.scm b/tests/client-server.scm
index c60a36f..e8e8ea0 100644
--- a/tests/client-server.scm
+++ b/tests/client-server.scm
@@ -67,7 +67,6 @@
 
 (define (simple-server-proc server)
   "start a SERVER that accepts a connection and handles a key exchange."
-  (server-listen server)
   (let ((s (server-accept server)))
     (server-handle-key-exchange s)))
 
@@ -336,7 +335,6 @@
 
    ;; server
    (lambda (server)
-     (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
        (make-session-loop session
@@ -384,12 +382,30 @@
 
 (define (make-session/channel-test)
   "Make a session for a channel test."
-  (let ((session (make-session-for-test)))
-    (sleep 1)
-    (connect! session)
-    (authenticate-server session)
-    (userauth-none! session)
-    session))
+  (define max-tries 30)
+  (let loop ((session (make-session-for-test))
+             (count   max-tries))
+    (if (not (eq? (connect! session) 'ok))
+        (begin
+          (format-log/scm 'nolog
+                          "make-session/channel-test"
+                          "Unable to connect in ~d tries: ~a~%"
+                          (- max-tries count)
+                          session)
+          (disconnect! session)
+          (set! session #f)
+          (sleep 1)
+          (if (zero? count)
+              (format-log/scm 'nolog
+                              "make-session/channel-test"
+                              "~a"
+                              "Giving up ...")
+              (loop (make-session-for-test)
+                    (1- count))))
+        (begin
+          (authenticate-server session)
+          (userauth-none! session)
+          session))))
 
 (test-assert "make-channel"
   (run-client-test
diff --git a/tests/common.scm b/tests/common.scm
index 2a04971..b789683 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -55,6 +55,7 @@
             run-client-test
             run-client-test/separate-process
             run-server-test
+            format-log/scm
             poll))
 
 
@@ -105,18 +106,26 @@
 
 (define (make-server-for-test)
   "Make a server with predefined parameters for a test."
+  (define mtx (make-mutex 'allow-external-unlock))
+  (lock-mutex mtx)
+  (dynamic-wind
+    (const #f)
+    (lambda ()
+      ;; FIXME: This hack is aimed to give every server its own unique
+      ;; port to listen to.  Clients will pick up new port number
+      ;; automatically through global `port' symbol as well.
+      (set! *port* (get-unused-port))
 
-  ;; FIXME: This hack is aimed to give every server its own unique
-  ;; port to listen to.  Clients will pick up new port number
-  ;; automatically through global `port' symbol as well.
-  (set! *port* (get-unused-port))
-
-  (make-server
-   #:bindaddr %addr
-   #:bindport *port*
-   #:rsakey   %rsakey
-   #:dsakey   %dsakey
-   #:log-verbosity 'rare))
+      (let ((s (make-server
+                #:bindaddr %addr
+                #:bindport *port*
+                #:rsakey   %rsakey
+                #:dsakey   %dsakey
+                #:log-verbosity 'rare)))
+        (server-listen s)
+        s))
+    (lambda ()
+      (unlock-mutex mtx))))
 
 
 ;;; Port helpers.
@@ -273,16 +282,23 @@ main procedure."
 SERVER-PROC as an argument.  CLIENT-PROC is expected to be a thunk that should
 be executed in the parent process.  The procedure returns a result of
 CLIENT-PROC call."
+  (format-log/scm 'nolog "run-client-test" "Making a server ...")
   (let ((server (make-server-for-test)))
+    (format-log/scm 'nolog "run-client-test" "Server: ~a" server)
+    (format-log/scm 'nolog "run-client-test" "Spawning processes ...")
     (multifork
      ;; server
      (lambda ()
        (dynamic-wind
          (const #f)
          (lambda ()
+           (format-log/scm 'nolog "run-client-test"
+                           "Server process is up and running")
            (set-log-userdata! (string-append (get-log-userdata) " (server)"))
            (server-set! server 'log-verbosity 'rare)
            (server-proc server)
+           (format-log/scm 'nolog "run-client-test"
+                           "Server procedure is finished")
            (primitive-exit 0))
          (lambda ()
            (primitive-exit 1))))