From 45c4c8254db865cd486436076dba254d70952ffe Mon Sep 17 00:00:00 2001 From: nik gaffney Date: Wed, 29 Apr 2009 18:46:48 +0200 Subject: [PATCH] more mycelium --- comm/mod_mycelium.erl | 6 ++--- hayfever/jabberer.scm | 25 +++++++++++++------- hayfever/xmpp-dave.ss | 53 ++++++++++++++++++++++--------------------- 3 files changed, 47 insertions(+), 37 deletions(-) diff --git a/comm/mod_mycelium.erl b/comm/mod_mycelium.erl index b0f9f5b..2d03e76 100644 --- a/comm/mod_mycelium.erl +++ b/comm/mod_mycelium.erl @@ -9,12 +9,12 @@ -export([start/2, stop/1]). -start(_Host, _Opt) -> ok. -stop(_Host) -> ok. - start(_Host, _Opt) -> ?DEBUG("MYCELIUM LOADING...", []). +stop(_Host) -> ok. + ?DEBUG("MYCELIUM UNLOADING...", []). + %%-define(PROCNAME, ejabberd_mycelium). %%-define(BOTNAME, mycelium). diff --git a/hayfever/jabberer.scm b/hayfever/jabberer.scm index 8684e13..6215d11 100644 --- a/hayfever/jabberer.scm +++ b/hayfever/jabberer.scm @@ -1,8 +1,14 @@ -#lang scheme +;#lang scheme/base -(require "xmpp-dave.ss") -(require scheme/class) (require openssl) +(require mzlib/os) +(require "sxml/sxml.ss") +(require "ssax/ssax.ss") +(require "xmpp.ss") ;; hostname +(require scheme/tcp) ;; networking +(require openssl) ;; ssl/tls +(require srfi/13) +(require scheme/class) (define jabberer% (class object% @@ -29,7 +35,8 @@ (define/public (start j p) (set! jid j) (set! pass p) - (set! thr (thread run))) + (run) + #;(set! thr (thread run))) (define/public (stop) (kill-thread thr)) @@ -37,7 +44,7 @@ (define (run) (with-xmpp-session jid pass (set-xmpp-handler 'message message-handler) - (let loop () + (let lxop () (when (not (null? outgoing)) (for-each (lambda (msg) @@ -45,11 +52,13 @@ (xmpp-send (message (car msg) (cadr msg)))) outgoing) (set! outgoing '())) - (sleep 0.5) - (loop)))) + (sleep 0.05) + #;(lxop)))) (super-new))) (define j (make-object jabberer%)) (send j start "plant0000001@fo.am" "plant0000001") -(send j send-msg "dave@fo.am" "woop") +(send j send-msg "plant0000003@fo.am" "woop") + +(printf "wonk4~n") \ No newline at end of file diff --git a/hayfever/xmpp-dave.ss b/hayfever/xmpp-dave.ss index 1187eff..e975a8d 100644 --- a/hayfever/xmpp-dave.ss +++ b/hayfever/xmpp-dave.ss @@ -74,7 +74,7 @@ (require (planet lizorkin/sxml:2:1/sxml)) ;; encoding 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 openssl) ;; ssl/tls @@ -265,10 +265,10 @@ ;; response handler (define (xmpp-response-handler in) (thread (lambda () - (let loop () + (let lxop () (parse-xmpp-response (read-async in)) (sleep 0.1) ;; slight delay to avoid a tight loop - (loop))))) + (lxop))))) ;; jid splicing (assuming the jid is in the format user@host/resource) (define (jid-user jid) @@ -281,7 +281,7 @@ (define (jid-resource jid) (let ((r (jid-resource-0 jid))) - (if (void? r) (gethostname) r))) + (if (void? r) "nix" r))) (define (jid-resource-0 jid) (let ((v (string-index jid #\/))) @@ -301,26 +301,27 @@ ;(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))) - (let-values (((in out) - (ssl-connect host ssl-port 'tls))) - ;;(tcp-connect host port))) - (parameterize ((xmpp-in-port in) - (xmpp-out-port out)) - (file-stream-buffer-mode out 'line) - (xmpp-response-handler in) - (xmpp-send (xmpp-stream host)) - (xmpp-send (xmpp-session host)) - ;(starttls in out) - - (xmpp-send (xmpp-auth user ,pass resource)) - (xmpp-send (presence)) - (xmpp-send (presence #:status "Available")) - ,@body - (close-output-port out) - (close-input-port in))))) - + (define-syntax with-xmpp-session + (syntax-rules () + ((_ 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))) + (parameterize ((xmpp-in-port in) + (xmpp-out-port out)) + (file-stream-buffer-mode out 'line) + (xmpp-response-handler in) + (xmpp-send (xmpp-stream host)) + (xmpp-send (xmpp-session host)) + ;(starttls in out) + (xmpp-send (xmpp-auth user pass resource)) + (xmpp-send (presence)) + (xmpp-send (presence #:status "Available")) + (begin form . forms) + (close-output-port out) + (close-input-port in))))))) + ) ;; end module