FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

more mycelium

Browse source
This commit is contained in:
nik gaffney 2009-04-29 18:46:48 +02:00
parent 3c6f475891
commit 45c4c8254d
3 changed files with 47 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
comm/mod_mycelium.erl
View file

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

25
hayfever/jabberer.scm
View file

@ -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")

53
hayfever/xmpp-dave.ss
View file

@ -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