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 (module xmpp scheme
(provide (all-defined-out) (provide (all-defined-out)
;open-connection ;; with-xmpp-session
;open-ssl-connection ;; xmpp-stream xmpp-session xmpp-auth
;with-xmpp-session ;; send message presence iq
;; jid-user jid-host jid-resource
) )
(require (planet lizorkin/sxml:2:1/sxml)) ;; encoding xml (require (planet lizorkin/sxml:2:1/sxml)) ;; encoding xml
(require (planet lizorkin/ssax:2:0/ssax)) ;; decoding xml (require (planet lizorkin/ssax:2:0/ssax)) ;; decoding xml
(require mzlib/os) ;; hostname (require mzlib/os) ;; hostname
(require mzlib/defmacro) ;; with-xmpp-session macro
(require scheme/tcp) ;; networking (require scheme/tcp) ;; networking
(require openssl) ;; ssl/tls (require openssl) ;; ssl/tls
(require srfi/13) ;; jid decoding (require srfi/13) ;; jid decoding
@ -301,10 +301,12 @@
(printf "sending iO: ~a ~%~%" str) (printf "sending iO: ~a ~%~%" str)
(fprintf (xmpp-out-port) "~A~%" str) (flush-output (xmpp-out-port))) (fprintf (xmpp-out-port) "~A~%" str) (flush-output (xmpp-out-port)))
(defmacro with-xmpp-session (jid pass . body) (define-syntax with-xmpp-session
`(let ((host (jid-host ,jid)) (syntax-rules ()
(user (jid-user ,jid)) ((_ jid pass . body)
(resource (jid-resource ,jid))) (let ((host (jid-host jid))
(user (jid-user jid))
(resource (jid-resource jid)))
(let-values (((in out) (let-values (((in out)
(ssl-connect host ssl-port 'tls))) (ssl-connect host ssl-port 'tls)))
;;(tcp-connect host port))) ;;(tcp-connect host port)))
@ -316,12 +318,11 @@
(send (xmpp-session host)) (send (xmpp-session host))
;(starttls in out) ;(starttls in out)
(send (xmpp-auth user ,pass resource)) (send (xmpp-auth user pass resource))
(send (presence)) (send (presence))
(send (presence #:status "Available")) (send (presence #:status "Available"))
,@body body
(close-output-port out) (close-output-port out)
(close-input-port in))))) (close-input-port in)))))))
) ;; end module ) ;; end module