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

defmacro -> define-syntax

Browse source
This commit is contained in:
nik gaffney 2009-04-17 17:30:25 +02:00
parent 9f1434a8da
commit db9fdaabe8
1 changed files with 30 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
xmpp.ss
View file

@ -67,15 +67,15 @@
(module xmpp scheme
(provide (all-defined-out)
;open-connection
;open-ssl-connection
;with-xmpp-session
;; 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 mzlib/defmacro) ;; with-xmpp-session macro
(require scheme/tcp) ;; networking
(require openssl) ;; ssl/tls
(require srfi/13) ;; jid decoding
@ -301,10 +301,12 @@
(printf "sending iO: ~a ~%~%" str)
(fprintf (xmpp-out-port) "~A~%" str) (flush-output (xmpp-out-port)))
(defmacro with-xmpp-session (jid pass . body)
`(let ((host (jid-host ,jid))
(user (jid-user ,jid))
(resource (jid-resource ,jid)))
(define-syntax with-xmpp-session
(syntax-rules ()
((_ jid pass . body)
(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)))
@ -316,12 +318,11 @@
(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
body
(close-output-port out)
(close-input-port in)))))
(close-input-port in)))))))
) ;; end module