ssh/server.scm (server-get): New procedure

* ssh/server-func.c (guile_ssh_server_get): New procedure.
* ssh/server.scm (server-get): Export.
* tests/server.scm ("server-get"): New TC.
* doc/api-servers.texi (Servers): Add description of `server-get'.
* NEWS: Update.

6 files changed, 60 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 44dce66..9136cfe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2014-10-12  Artyom Poptsov  <poptsov.artyom@gmail.com>
 
+	* ssh/server-func.c (guile_ssh_server_get): New procedure.
+	* ssh/server.scm (server-get): Export.
+	* tests/server.scm ("server-get"): New TC.
+	* doc/api-servers.texi (Servers): Add description of `server-get'.
+	* NEWS: Update.
+
 	* ssh/server-type.c (print_server): Print object address.
 
 	* ssh/server-type.h (server_data): Add `options' field.
diff --git a/NEWS b/NEWS
index 6897018..5dcbd6b 100644
--- a/NEWS
+++ b/NEWS
@@ -8,7 +8,11 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com>
   notice and this notice are preserved.
 
 * Unreleased
+** New `server-get' procedure in (ssh server)
+   The procedure can be used to retrieve server options.
 ** Improve printing of Guile-SSH server objects
+** Update documentation
+   - Add description of the new procedures.
 
 * Changes in version 0.7.1 (2014-10-11)
 ** New `%get-libssh-version' procedure in (ssh version)
diff --git a/doc/api-servers.texi b/doc/api-servers.texi
index 0092b2e..1cdada5 100644
--- a/doc/api-servers.texi
+++ b/doc/api-servers.texi
@@ -94,6 +94,12 @@ Expected type of @var{value}: boolean.
 
 @end deffn
 
+@deffn {Scheme Procedure} server-get server option
+Get value of @var{option} for Guile-SSH @var{server}.  Return @var{option}
+value, or @code{#f} if the @var{option} does not set.  Throw
+@code{guile-ssh-error} on error.
+@end deffn
+
 @deffn {Scheme Procedure} server-listen server
 Start listening to the socket.  Throw @code{guile-ssh-error} on error.
 Return value undefined.
diff --git a/ssh/server-func.c b/ssh/server-func.c
index d7f7a3b..0edd32e 100644
--- a/ssh/server-func.c
+++ b/ssh/server-func.c
@@ -179,6 +179,24 @@ Return value is undefined.\
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (guile_ssh_server_get, "server-get", 2, 0, 0,
+            (SCM server, SCM option),
+            "\
+Get a Guile-SSH server option.  Return option value, or `#f' if option is\n\
+not set.  Throw `guile-ssh-error' on error.\
+")
+#define FUNC_NAME s_guile_ssh_server_get
+{
+  struct server_data *sd     = _scm_to_server_data (server);
+  struct symbol_mapping *opt = _scm_to_ssh_const (server_options, option);
+
+  if (! opt)
+    guile_ssh_error1 (FUNC_NAME, "No such option", option);
+
+  return scm_assoc_ref (sd->options, option);
+}
+#undef FUNC_NAME
+
 
 SCM_DEFINE (guile_ssh_server_listen, "server-listen", 1, 0, 0,
             (SCM server),
diff --git a/ssh/server.scm b/ssh/server.scm
index 72bb949..68438e7 100644
--- a/ssh/server.scm
+++ b/ssh/server.scm
@@ -29,6 +29,7 @@
 ;;   make-server
 ;;   server-accept
 ;;   server-set!
+;;   server-get
 ;;   server-listen!
 ;;   server-handle-key-exchange
 ;;   server-message-get
@@ -45,6 +46,7 @@
             make-server
             server-accept
             server-set!
+            server-get
             server-listen
             server-handle-key-exchange
             server-message-get))
diff --git a/tests/server.scm b/tests/server.scm
index a1bc7af..3ce475f 100644
--- a/tests/server.scm
+++ b/tests/server.scm
@@ -114,6 +114,30 @@
                  #:log-verbosity 'nolog
                  #:blocking-mode #f)))
 
+(test-assert "server-get"
+  (let* ((topdir        (getenv "abs_top_srcdir"))
+         (bindaddr      "127.0.0.1")
+         (bindport      123456)
+         (rsakey        (format #f "~a/tests/rsakey" topdir))
+         (dsakey        (format #f "~a/tests/dsakey" topdir))
+         (banner        "banner")
+         (log-verbosity 'nolog)
+         (blocking-mode #f)
+         (server (make-server #:bindaddr      bindaddr
+                              #:bindport      bindport
+                              #:rsakey        rsakey
+                              #:dsakey        dsakey
+                              #:banner        banner
+                              #:log-verbosity log-verbosity
+                              #:blocking-mode blocking-mode)))
+    (and (eq? (server-get server 'bindaddr)      bindaddr)
+         (eq? (server-get server 'bindport)      bindport)
+         (eq? (server-get server 'rsakey)        rsakey)
+         (eq? (server-get server 'dsakey)        dsakey)
+         (eq? (server-get server 'banner)        banner)
+         (eq? (server-get server 'log-verbosity) log-verbosity)
+         (eq? (server-get server 'blocking-mode) blocking-mode))))
+
 (test-assert "server-listen"
   (let* ((topdir  (getenv "abs_top_srcdir"))
          (server  (make-server #:bindaddr "127.0.0.1"