zzkt/gibberish
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity

PLaneT update

Browse source
This commit is contained in:
nik gaffney 2009-04-18 18:59:49 +02:00
parent db9fdaabe8
commit a84b6dcda1
3 changed files with 25 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
README.md
View file

@ -11,7 +11,7 @@ currently documented in the file `xmpp.ss`
## Installation ## Installation
(require (planet zzkt/xmpp:1:1/xmpp)) (require (planet zzkt/xmpp))
## Session ## Session
@ -28,8 +28,10 @@ messages, presence updates or queries.
(with-xmpp-session jid pass (with-xmpp-session jid pass
(send (message "user@host" "some random message"))) (send (message "user@host" "some random message")))
Where `jid` is the senders jid and `pass` is the password Where `jid` is the senders jid and `pass` is the password. A presence
update can be sent as `(send (presence #:status "garden path"))` and
queries are similar `(send (iq #:type get))`
## Response Handlers ## Response Handlers

4
main.ss Normal file
View file

@ -0,0 +1,4 @@
#lang mzscheme
(require "xmpp.ss")
(provide (all-from "xmpp.ss"))

30
xmpp.ss
View file

@ -65,21 +65,15 @@
;;; ;;;
(module xmpp scheme (module xmpp scheme
(provide (all-defined-out)
;; with-xmpp-session
;; xmpp-stream xmpp-session xmpp-auth
;; send message presence iq
;; jid-user jid-host jid-resource
)
(require (planet lizorkin/sxml:2:1/sxml)) ;; encoding xml (require (planet lizorkin/sxml:2:1/sxml)) ;; encoding xml
(require (planet lizorkin/ssax:2:0/ssax)) ;; decoding xml (require (planet lizorkin/ssax:2:0/ssax)) ;; decoding xml
(require mzlib/os) ;; hostname (require mzlib/os) ;; hostname
(require scheme/tcp) ;; networking (require scheme/tcp) ;; networking
(require openssl) ;; ssl/tls (require openssl) ;; ssl/tls
(require srfi/13) ;; jid decoding (require srfi/13) ;; jid decoding
(require net/base64) ;; sasl
(provide (all-defined-out))
;;;;;;;;;;; ; ;;;; ; ;;; ; ; ;; ; ;;;;;;;;;;; ; ;;;; ; ;;; ; ; ;; ;
;; ;;
@ -183,6 +177,15 @@
(define presence-show (sxpath-element "presence/show/text()")) (define presence-show (sxpath-element "presence/show/text()"))
(define presence-from (sxpath-element "presence/@from/text()")) (define presence-from (sxpath-element "presence/@from/text()"))
(define presence-status (sxpath-element "presence/status/text()")) (define presence-status (sxpath-element "presence/status/text()"))
;;;;;;;;;; ; ; ; ;; ;
;;
;; rosters
;;
;;;;;; ; ;; ;
;;;; ;; ; ;;; ; ;;;; ;; ; ;;; ;
;; ;;
@ -303,13 +306,13 @@
(define-syntax with-xmpp-session (define-syntax with-xmpp-session
(syntax-rules () (syntax-rules ()
((_ jid pass . body) ((_ jid pass form . forms)
(let ((host (jid-host jid)) (let ((host (jid-host jid))
(user (jid-user jid)) (user (jid-user jid))
(resource (jid-resource jid))) (resource (jid-resource jid)))
(let-values (((in out) (let-values (((in out)
(ssl-connect host ssl-port 'tls))) (ssl-connect host ssl-port 'tls)))
;;(tcp-connect host port))) ;;(tcp-connect host port)))
(parameterize ((xmpp-in-port in) (parameterize ((xmpp-in-port in)
(xmpp-out-port out)) (xmpp-out-port out))
(file-stream-buffer-mode out 'line) (file-stream-buffer-mode out 'line)
@ -317,11 +320,10 @@
(send (xmpp-stream host)) (send (xmpp-stream host))
(send (xmpp-session host)) (send (xmpp-session host))
;(starttls in out) ;(starttls in out)
(send (xmpp-auth user pass resource))
(send (xmpp-auth user pass resource))
(send (presence)) (send (presence))
(send (presence #:status "Available")) (send (presence #:status "Available"))
body (begin form . forms)
(close-output-port out) (close-output-port out)
(close-input-port in))))))) (close-input-port in)))))))