more mycelium

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).
 

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)
+                           (sleep 0.05)
-                           (loop))))
+                           #;(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")

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,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)
+  (define-syntax with-xmpp-session
-    `(let ((host (jid-host ,jid))
+    (syntax-rules ()
-           (user (jid-user ,jid))
+      ((_ jid pass form . forms)
-           (resource (jid-resource ,jid)))
+       (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)))
@@ -315,12 +317,11 @@
              (xmpp-send (xmpp-stream host))
              (xmpp-send (xmpp-session host))           
              ;(starttls in out)
-           
+             (xmpp-send (xmpp-auth user pass resource))
-           (xmpp-send (xmpp-auth user ,pass resource))
              (xmpp-send (presence))
              (xmpp-send (presence #:status "Available"))
-           ,@body
+             (begin form . forms)
              (close-output-port out)
-           (close-input-port in)))))
+             (close-input-port in)))))))
 
   ) ;; end module