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,7 +28,9 @@ 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"))

24
xmpp.ss
View file

@ -66,20 +66,14 @@
(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))
;;;;;;;;;;; ; ;;;; ; ;;; ; ; ;; ;
;;
@ -184,6 +178,15 @@
(define presence-from (sxpath-element "presence/@from/text()"))
(define presence-status (sxpath-element "presence/status/text()"))
;;;;;;;;;; ; ; ; ;; ;
;;
;; rosters
;;
;;;;;; ; ;; ;
;;;; ;; ; ;;; ;
;;
;; tls & sasl
@ -303,7 +306,7 @@
(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)))
@ -317,11 +320,10 @@
(send (xmpp-stream host))
(send (xmpp-session host))
;(starttls in out)
(send (xmpp-auth user pass resource))
(send (presence))
(send (presence #:status "Available"))
body
(begin form . forms)
(close-output-port out)
(close-input-port in)))))))