Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

PLaneT update

  • Loading branch information...
commit a84b6dcda1ed9d346250e5940f470046b851f417 1 parent db9fdaa
@zzkt authored
Showing with 25 additions and 17 deletions.
  1. +5 −3 README.md
  2. +4 −0 main.ss
  3. +16 −14 xmpp.ss
View
8 README.md
@@ -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
View
4 main.ss
@@ -0,0 +1,4 @@
+#lang mzscheme
+
+(require "xmpp.ss")
+(provide (all-from "xmpp.ss"))
View
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)))))))
Please sign in to comment.
Something went wrong with that request. Please try again.