message.scm (message-type, message-session): New procedures

* modules/ssh/message.scm (message-type, message-session): New procedures.
  (message-get-type, message-get-session): Deprecate.
* libguile-ssh/message-func.c (guile_ssh_message_get_type): Rename to
  'gssh_message_type'.
  (guile_ssh_message_get_session): Rename to 'gssh_message_session'.
* examples/ssshd.scm.in: Use new procedures intstead of deprecated ones.
* tests/common.scm: Likewise.
* NEWS: Update.

8 files changed, 42 insertions, 25 deletions

diff --git a/NEWS b/NEWS
index 1cd181e..d9bc398 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,7 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com>
   notice and this notice are preserved.
 
 * Unreleased
+** Deprecation
 *** In (ssh key)
     - 'get-key-type' (use 'key-type' instead)
     - 'get-public-key-hash' (use 'public-key-hash' instead)
@@ -15,6 +16,9 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com>
     - 'channel-get-stream (use 'channel-stream' instead)
     - 'channel-set-stream!' (use 'channel-stream-set!' instead)
     - 'channel-get-session' (use 'channel-session' instead)
+*** In (ssh message)
+    - 'message-get-type'  (use 'message-type' instead)
+    - 'message-get-session' (use 'message-session' instead)
 
 * Changes in version 0.10.2 (2016-11-25)
 ** New procedures
diff --git a/examples/echo/server.scm.in b/examples/echo/server.scm.in
index 82a6416..3f14464 100644
--- a/examples/echo/server.scm.in
+++ b/examples/echo/server.scm.in
@@ -190,7 +190,7 @@ Options:
           ;; Handle messages from the connected SSH client.
           (let session-loop ((msg (server-message-get session)))
             (if msg
-                (let ((msg-type (message-get-type msg)))
+                (let ((msg-type (message-type msg)))
                   (format #t "Message: ~a~%" msg-type)
                   ;; Check the type of the message
                   (case (car msg-type)
diff --git a/examples/ssshd.scm.in b/examples/ssshd.scm.in
index ba52818..dae4688 100644
--- a/examples/ssshd.scm.in
+++ b/examples/ssshd.scm.in
@@ -314,7 +314,7 @@ Options:
           (if (not msg)
               (error (get-error session)))
 
-          (let ((msg-type (message-get-type msg)))
+          (let ((msg-type (message-type msg)))
 
             (format #t "Message type: ~a~%" msg-type)
 
diff --git a/libguile-ssh/message-func.c b/libguile-ssh/message-func.c
index 795e9c1..80f1857 100644
--- a/libguile-ssh/message-func.c
+++ b/libguile-ssh/message-func.c
@@ -264,12 +264,7 @@ _ssh_message_type_to_scm (ssh_message msg)
 }
 
 
-SCM_DEFINE (guile_ssh_message_get_type,
-            "message-get-type", 1, 0, 0,
-            (SCM msg),
-            "\
-Get type of the message MSG.\
-")
+SCM_GSSH_DEFINE (gssh_message_type, "%gssh-message-type", 1, (SCM msg))
 {
   struct message_data *message_data = _scm_to_message_data (msg);
   return _ssh_message_type_to_scm (message_data->message);
@@ -531,12 +526,8 @@ Return value is undefined.\
 #undef FUNC_NAME
 
 
-SCM_DEFINE (guile_ssh_message_get_session,
-            "message-get-session", 1, 0, 0,
-            (SCM message),
-            "\
-Get the session from which the MESSAGE was received.  Return the session.\
-")
+SCM_GSSH_DEFINE (gssh_message_session, "%gssh-message-session", 1,
+                 (SCM message))
 {
   struct message_data *md = _scm_to_message_data (message);
   return md->session;
diff --git a/modules/ssh/message.scm b/modules/ssh/message.scm
index e387cd3..80ed4a2 100644
--- a/modules/ssh/message.scm
+++ b/modules/ssh/message.scm
@@ -41,9 +41,11 @@
             message?
             message-reply-default
             message-reply-success
-            message-get-type
+            message-type
+            message-get-type            ; deprecated
             message-get-req
-            message-get-session
+            message-session
+            message-get-session         ; deprecated.
 
             message-service-reply-success
             service-req:service
@@ -102,6 +104,26 @@
 (define (subsystem-req:subsystem req) (vector-ref req 0))
 
 
+(define (message-type message)
+  "Get type of a MESSAGE."
+  (%gssh-message-type message))
+
+(define (message-get-type message)
+  (issue-deprecation-warning "'message-get-type' is deprecated."
+                             "  Use 'message-type' instead.")
+  (%gssh-message-type message))
+
+(define (message-session message)
+  "Get the session from which the MESSAGE was received.  Return the session."
+  (%gssh-message-session message))
+
+(define (message-get-session message)
+  (issue-deprecation-warning "'message-get-session' is deprecated."
+                             "  Use 'message-session' instead.")
+  (%gssh-message-session message))
+
+
+
 (define (message-reply-success msg . args)
   "Reply 'success' to the message MSG.  This procedure is a convenient
 wrapper for other '*-reply-success' procedures.  The right procedure
diff --git a/tests/client-server.scm b/tests/client-server.scm
index 9c7dbaf..48a710c 100644
--- a/tests/client-server.scm
+++ b/tests/client-server.scm
@@ -463,7 +463,7 @@
   (start-server-loop server
     (let ((channel #f))
       (lambda (msg)
-        (let ((msg-type (message-get-type msg)))
+        (let ((msg-type (message-type msg)))
           (srvmsg msg-type)
           (case (car msg-type)
             ((request-channel-open)
diff --git a/tests/common.scm b/tests/common.scm
index c5dac55..308315e 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -128,7 +128,7 @@
 (define (start-session-loop session body)
   (let session-loop ((msg (server-message-get session)))
     (when (and msg (not (eof-object? msg)))
-      (body msg (message-get-type msg)))
+      (body msg (message-type msg)))
     (when (connected? session)
       (session-loop (server-message-get session)))))
 
@@ -236,7 +236,7 @@ disconnected when the PROC is finished."
 (define (start-server/dt-test server rwproc)
   (start-server-loop server
     (lambda (msg)
-      (case (car (message-get-type msg))
+      (case (car (message-type msg))
         ((request-channel-open)
          (let ((channel (message-channel-request-open-reply-accept msg)))
            (poll channel rwproc)))
@@ -248,7 +248,7 @@ disconnected when the PROC is finished."
   (start-server-loop server
     (let ((channel #f))
       (lambda (msg)
-        (let ((msg-type (message-get-type msg)))
+        (let ((msg-type (message-type msg)))
           (case (car msg-type)
             ((request-channel-open)
              (set! channel (message-channel-request-open-reply-accept msg)))
@@ -273,7 +273,7 @@ disconnected when the PROC is finished."
     (server-handle-key-exchange session)
 
     (let* ((proc (lambda (session message user-data)
-                   (let ((type (message-get-type message))
+                   (let ((type (message-type message))
                          (req  (message-get-req  message)))
                      (format (current-error-port) "global req: type: ~a~%"
                              type)
diff --git a/tests/server-client.scm b/tests/server-client.scm
index ea7929d..194ecb9 100644
--- a/tests/server-client.scm
+++ b/tests/server-client.scm
@@ -87,7 +87,7 @@
          (message? msg))))))
 
 
-(test-assert-with-log "message-get-type"
+(test-assert-with-log "message-type"
   (run-server-test
 
    ;; client
@@ -106,7 +106,7 @@
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
        (let ((msg (server-message-get session)))
-         (let ((msg-type (message-get-type msg))
+         (let ((msg-type (message-type msg))
                (expected-type '(request-service)))
            (message-auth-set-methods! msg '(none))
            (message-reply-success msg)
@@ -114,7 +114,7 @@
            (equal? msg-type expected-type)))))))
 
 
-(test-assert-with-log "message-get-session"
+(test-assert-with-log "message-session"
   (run-server-test
 
    ;; client
@@ -133,7 +133,7 @@
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
        (let* ((msg (server-message-get session))
-              (x   (message-get-session msg)))
+              (x   (message-session msg)))
          (message-auth-set-methods! msg '(none))
          (message-reply-success msg)
          (disconnect! x)