[gnunet-scheme] branch master updated (e690ca1 -> d5c2c78)

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a change to branch master
in repository gnunet-scheme.

    from e690ca1  cadet/client: Process received msg:cadet:local:data messages.
     new 2ea09ee  cadet/client: Correct message queue that received messages 
are injected in.
     new c0ee31f  examples/web: Correct SXML of chat form.
     new d5c2c78  examples/web: Implement the cadet-start-chat form.

The 3 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 examples/web.scm            | 70 +++++++++++++++++++++++++++++++++++++++++----
 gnu/gnunet/cadet/client.scm |  2 +-
 2 files changed, 65 insertions(+), 7 deletions(-)

diff --git a/examples/web.scm b/examples/web.scm
index 5c7319b..d2e4468 100644
--- a/examples/web.scm
+++ b/examples/web.scm
@@ -26,16 +26,30 @@
             (gnu extractor enum)
             (gnu gnunet block)
             (gnu gnunet crypto)
+            (gnu gnunet crypto struct)
             (gnu gnunet utils bv-slice)
+            (gnu gnunet utils cut-syntax)
+            ((gnu gnunet utils hat-let)
+             #:select (let^))
             (gnu gnunet config db)
             (gnu gnunet config fs)
+            ((gnu gnunet netstruct syntactic)
+             #:select (sizeof set%!))
             (rnrs hashtables)
+            (gnu gnunet message protocols)
             ((gnu gnunet nse client)
              #:prefix #{nse:}#)
             ((gnu gnunet dht client)
              #:prefix #{dht:}#)
             ((gnu gnunet cadet client)
              #:prefix #{cadet:}#)
+            (gnu gnunet cadet struct)
+            ((gnu gnunet data-string)
+             #:select (string->data))
+            ((gnu gnunet mq handler)
+             #:select (message-handlers message-handler))
+            ((gnu gnunet mq)
+             #:select (send-message!))
             (web response)
             (web server)
             (web uri)
@@ -109,7 +123,7 @@ for success is used."
            (input (@ (type "text") (id "cadet-port-name") (name "port"))))
        (li (label (@ (for "cadet-message"))
                   "Message to send (text)")
-           (input (@ (type "text" (id "cadet-message") (name "message"))))))
+           (input (@ (type "text") (id "cadet-message") (name "message")))))
     (input (@ (type "submit") (value "Connect!")))))
 
 (define (cadet-chat-forms)
@@ -149,6 +163,41 @@ for success is used."
              (decode/data (assoc-ref parameters "data-encoding")
                           (assoc-ref parameters "data"))))))
 
+(define (process-cadet-chat cadet-server parameters)
+  (define (connected) (values))
+  (define handlers
+    (message-handlers
+     (message-handler
+      (type (symbol-value message-type msg:cadet:command-line-traffic))
+      ((interpose exp) exp)
+      ((well-formed? slice) #true)
+      ((handle! slice)
+       (let^ ((! data (slice-slice slice (sizeof 
/:msg:cadet:command-line-traffic '())))
+             (! string (data->string data)))
+            ;; TODO: would be nice to view the message on a web page
+            (format #t "Message received: ~s~%" string))))))
+  (define channel
+    (cadet:open-channel! cadet-server
+                        (parameters->cadet-address parameters)
+                        handlers))
+  (define mq (cadet:channel-message-queue channel))
+  (define message (string->utf8
+                  (string-append (assoc-ref parameters "message")
+                                 "\n")))
+  (define s (make-slice/read-write
+            (+ (sizeof /:msg:cadet:command-line-traffic '())
+               (bytevector-length message))))
+  (define header (slice-slice s 0 (sizeof /:msg:cadet:command-line-traffic 
'())))
+  (define-syntax set*
+    (cut-syntax set%! /:msg:cadet:command-line-traffic <> header <>))
+  (set* '(header size) (slice-length s))
+  (set* '(header type)
+       (value->index (symbol-value message-type 
msg:cadet:command-line-traffic)))
+  (slice-copy! (bv-slice/read-write message)
+              (slice-slice s (sizeof /:msg:cadet:command-line-traffic '())))
+  (send-message! mq s)
+  (pk 'p channel mq))
+
 (define (try-utf8->string bv) ; TODO: less duplication
   (catch 'decoding-error
     (lambda () (utf8->string bv))
@@ -176,6 +225,12 @@ If incorrect, return @code{#false}. TODO more validation."
                         #:desired-replication-level
                         desired-replication-level))))
 
+(define (parameters->cadet-address parameters)
+  (pk 'p parameters)
+  (cadet:make-cadet-address
+   (bv-slice/read-write (string->eddsa-public-key (assoc-ref parameters 
"peer")))
+   (hash/sha512 (bv-slice/read-write (string->utf8 (assoc-ref parameters 
"port"))))))
+
 (define (process-search-dht dht-server parameters)
   (define search-result)
   (define found? (make-condition))
@@ -242,12 +297,15 @@ merely a race?")))
        (if current-estimate
            (estimate->html current-estimate)
            '(p "No etimate yet")))))
-    ("/cadet-chat"
-     (respond/html `(div (p "You can only send a message to an already 
existing chat here,
+    ("/cadet-chat" ; TODO check method and Content-Type, validation ...
+     (if (pk 'b body)
+        (process-cadet-chat cadet-server (urlencoded->alist body))
+        (respond/html
+         `(div (p "You can only send a message to an already existing chat 
here,
 not start new chats or view conversation.")
-                        (p "Run gnunet-cadet --open-port=PORT to run a new 
chat!")
-                        (p "Send a message to a chat!")
-                        ,cadet-start-chat-form)))
+               (p "Run gnunet-cadet --open-port=PORT to run a new chat!")
+               (p "Send a message to a chat!")
+               ,cadet-start-chat-form))))
     ("/search-dht" ; TODO check method and Content-Type, validation ...
      (if (pk 'b body)
         (process-search-dht dht-server (urlencoded->alist body))
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index f8b3e71..868b461 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -194,7 +194,7 @@
                     ???))
                 ;; TODO: while the message is being processed, other messages
                 ;; cannot be accepted -- document this limitation.
-                (inject-message! mq tail))))
+                (inject-message! (channel-message-queue channel) tail))))
         (message-handler
          (type (symbol-value message-type msg:cadet:local:acknowledgement))
          ((interpose exp) exp)

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.