From 5577f236949deb1ea9d16bde7bf9ac6adaa05647 Mon Sep 17 00:00:00 2001 From: nik gaffney Date: Thu, 16 Apr 2009 15:18:01 +0200 Subject: [PATCH] still no SASL --- README.md | 30 ++++++++++++++++- xmpp.ss | 96 ++++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 95 insertions(+), 31 deletions(-) diff --git a/README.md b/README.md index e099f0f..c6fdfff 100644 --- a/README.md +++ b/README.md @@ -12,7 +12,35 @@ currently documented in the file 'xmpp.ss' ## Installation (require (planet zzkt/xmpp:1:0/xmpp)) - + + +## Session + +It is necessary to establish a session with a Jabber server before +sending any messages or presence updates. This can be done manually, +or with the help of with-xmpp-session. + + +## Sending + +Once a session is established, the 'send' function can be used to send +messages, presnece updates or queries. + + (with-xmpp-session jid pass + (send (message user@host "some random message"))) + +Where 'jid' is the senders jid and 'pass' is the password + + +## Response Handlers + +A handler can be registered to repsond to 'message 'presence 'iq or +'other stanzas. Note that an 'iq handler will revive any error +messages from the server + + (set-xmpp-handler 'message print-message) + + ## Example Chat Client (require xmpp) diff --git a/xmpp.ss b/xmpp.ss index b749ea1..5498778 100644 --- a/xmpp.ss +++ b/xmpp.ss @@ -28,8 +28,8 @@ ;;; Still a long way from implementing even a minimal subset of XMPP ;;; ;;; features implemented -;;; - plaintext sessions on port 5222 -;;; - "old sytle" ssl sessions on port 5223 +;;; - plaintext sessions on port 5222 +;;; - "old sytle" ssl sessions on port 5223 (default) ;;; - authenticate using an existing account ;;; - send messages (rfc 3921 sec.4) ;;; - send presence (rfc 3921 sec.5) @@ -54,11 +54,15 @@ ;;; ;;; bugs and/or improvements ;;; - PLaneT installable +;;; - 'send' using call/cc vs 'parameter' i/o ports +;;; - coroutines for sasl negotiation ;;; - read-async & repsonse-handler ;;; - ssax:xml->sxml or lazy:xml->sxml ;;; - default handlers +;;; - syntax for defining sxpath based handlers +;;; - improve parsing ;;; - chatbot exmples -;;; +;;; (module xmpp scheme @@ -68,13 +72,14 @@ ;with-xmpp-session ) - (require (planet lizorkin/sxml:2:1/sxml)) - (require (planet lizorkin/ssax:2:0/ssax)) - (require mzlib/os) - (require mzlib/defmacro) - (require scheme/tcp) - (require openssl) - (require srfi/13) + (require (planet lizorkin/sxml:2:1/sxml)) ;; encoding xml + (require (planet lizorkin/ssax:2:0/ssax)) ;; decoding xml + (require mzlib/os) ;; hostname + (require mzlib/defmacro) ;; with-xmpp-session macro + (require scheme/tcp) ;; networking + (require openssl) ;; ssl/tls + (require srfi/13) ;; jid decoding + (require net/base64) ;; sasl ;;;;;;;;;;; ; ;;;; ; ;;; ; ; ;; ; ;; @@ -117,7 +122,7 @@ ;; intialization (define (xmpp-stream host) - (string-append "")) + (string-append "")) ;; version='1.0' is a MUST for SASL on 5222 but NOT for ssl on 5223 ;; authentication (define (xmpp-auth username password resource) @@ -131,14 +136,12 @@ (ssxml `(iq (@ (to ,host) (type "set") (id "session")) (session (@ (xmlns "urn:ietf:params:xml:ns:xmpp-session")))))) - (define (starttls) "") - ;; messages (define (message to body) (ssxml `(message (@ (to ,to)) (body ,body)))) ;; presence - (define (presence #:from (from "") + (define (presence #:from (from "") #:to (to "") #:type (type "") #:show (show "") @@ -148,6 +151,13 @@ ((string=? type "") "") (else (ssxml `(presence (@ (type ,type))))))) + ;; queries + (define (iq body + #:from (from "") + #:to (to "") + #:type (type "") + #:id (id "")) + (ssxml `(iq (@ (to ,to) (type ,type) ,body)))) ;; curried stanza disection (sxml stanza -> string) (define ((sxpath-element xpath) stanza) @@ -174,6 +184,18 @@ (define presence-from (sxpath-element "presence/@from/text()")) (define presence-status (sxpath-element "presence/status/text()")) + ;;;; ;; ; ;;; ; + ;; + ;; tls & sasl + ;; - http://xmpp.org/rfcs/rfc3920.html#tls + ;; - http://xmpp.org/rfcs/rfc3920.html#sasl + ;; + ;;;; ;; + + (define session->tls? #f) ;; changes state when a tls proceed is recived + + ;; moved to xmpp-sasl until it 'works' + ;;;;;;;;; ; ;; ; ; ;; ;; ; ; ;; @@ -189,6 +211,9 @@ (define (set-xmpp-handler type fcn) (dict-set! xmpp-handlers type fcn)) + (define (remove-xmpp-handler type fcn) + (dict-remove! xmpp-handlers type fcn)) + (define (run-xmpp-handler type sz) (let ((fcn (dict-ref xmpp-handlers type #f))) (when fcn (begin @@ -210,7 +235,7 @@ (run-xmpp-handler 'iq sz)) ((equal? 'presence (caadr sz)) (run-xmpp-handler 'presence sz)) - (else (run-xmpp-handler 'unknown sz)))))) + (else (run-xmpp-handler 'other sz)))))) ;; example handlers to print stanzas or their contents (define (print-message sz) @@ -231,7 +256,10 @@ (cond ((string-ci=? test "")))) + ((string-ci=? test "~%~%" str)) + "")))) ;; response handler @@ -258,7 +286,7 @@ (define (jid-resource-0 jid) (let ((v (string-index jid #\/))) (when v (string-take-right jid (- (string-length jid) v 1))))) - + ;;;; ;; ; ; ;; ;; ;;;; ; ;; @@ -266,6 +294,13 @@ ;; ;;;;; ;; ;;;; ; ;; ; + (define xmpp-in-port (make-parameter (current-input-port))) + (define xmpp-out-port (make-parameter (current-output-port))) + + (define (send str) + (printf "sending iO: ~a ~%~%" str) + (fprintf (xmpp-out-port) "~A~%" str) (flush-output (xmpp-out-port))) + (defmacro with-xmpp-session (jid pass . body) `(let ((host (jid-host ,jid)) (user (jid-user ,jid)) @@ -273,19 +308,20 @@ (let-values (((in out) (ssl-connect host ssl-port 'tls))) ;;(tcp-connect host port))) - (define (send str) (fprintf out "~A~%" str) (flush-output out)) - (file-stream-buffer-mode out 'line) - (xmpp-response-handler in) - (send (xmpp-stream host)) - (send (xmpp-session host)) - ;(send starttls) - (send (xmpp-auth user ,pass resource)) - (send (presence)) - (send (presence #:status "Available")) - ,@body - (close-output-port out) - (close-input-port in)))) - + (parameterize ((xmpp-in-port in) + (xmpp-out-port out)) + (file-stream-buffer-mode out 'line) + (xmpp-response-handler in) + (send (xmpp-stream host)) + (send (xmpp-session host)) + ;(starttls in out) + + (send (xmpp-auth user ,pass resource)) + (send (presence)) + (send (presence #:status "Available")) + ,@body + (close-output-port out) + (close-input-port in))))) ) ;; end module