PLaneT update

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

View file

@ -11,7 +11,7 @@ currently documented in the file `xmpp.ss`
## Installation
(require (planet zzkt/xmpp:1:1/xmpp))
(require (planet zzkt/xmpp))
## Session
@ -28,8 +28,10 @@ messages, presence 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
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

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
(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/ssax:2:0/ssax)) ;; decoding xml
(require mzlib/os) ;; hostname
(require scheme/tcp) ;; networking
(require openssl) ;; ssl/tls
(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-from (sxpath-element "presence/@from/text()"))
(define presence-status (sxpath-element "presence/status/text()"))
;;;;;;;;;; ; ; ; ;; ;
;;
;; rosters
;;
;;;;;; ; ;; ;
;;;; ;; ; ;;; ;
;;
@ -303,13 +306,13 @@
(define-syntax with-xmpp-session
(syntax-rules ()
((_ jid pass . body)
((_ jid pass form . forms)
(let ((host (jid-host jid))
(user (jid-user jid))
(resource (jid-resource jid)))
(let-values (((in out)
(ssl-connect host ssl-port 'tls)))
;;(tcp-connect host port)))
;;(tcp-connect host port)))
(parameterize ((xmpp-in-port in)
(xmpp-out-port out))
(file-stream-buffer-mode out 'line)
@ -317,11 +320,10 @@
(send (xmpp-stream host))
(send (xmpp-session host))
;(starttls in out)
(send (xmpp-auth user pass resource))
(send (xmpp-auth user pass resource))
(send (presence))
(send (presence #:status "Available"))
body
(begin form . forms)
(close-output-port out)
(close-input-port in)))))))