PLaneT update
This commit is contained in:
parent
db9fdaabe8
commit
a84b6dcda1
3 changed files with 25 additions and 17 deletions
|
@ -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
4
main.ss
Normal file
|
@ -0,0 +1,4 @@
|
|||
#lang mzscheme
|
||||
|
||||
(require "xmpp.ss")
|
||||
(provide (all-from "xmpp.ss"))
|
30
xmpp.ss
30
xmpp.ss
|
@ -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)))))))
|
||||
|
||||
|
|
Loading…
Reference in a new issue