64 lines
1.9 KiB
Scheme
64 lines
1.9 KiB
Scheme
;#lang scheme/base
|
|
|
|
(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%
|
|
(field
|
|
(incoming '())
|
|
(outgoing '())
|
|
(thr 0)
|
|
(jid "")
|
|
(pass ""))
|
|
|
|
(define/public (get-incoming)
|
|
incoming)
|
|
|
|
(define/public (clear-incoming)
|
|
(set! incoming '()))
|
|
|
|
(define/public (send-msg to msg)
|
|
(set! outgoing (cons (list to msg) outgoing)))
|
|
|
|
(define (message-handler sz)
|
|
(printf "<---- ~a ~a~n" (message-from sz) (message-body sz))
|
|
(set! incoming (cons (list (message-from sz) (message-body sz)) incoming)))
|
|
|
|
(define/public (start j p)
|
|
(set! jid j)
|
|
(set! pass p)
|
|
(run)
|
|
#;(set! thr (thread run)))
|
|
|
|
(define/public (stop)
|
|
(kill-thread thr))
|
|
|
|
(define (run)
|
|
(with-xmpp-session jid pass
|
|
(set-xmpp-handler 'message message-handler)
|
|
(let lxop ()
|
|
(when (not (null? outgoing))
|
|
(for-each
|
|
(lambda (msg)
|
|
(printf "----> ~a ~a~n" (car msg) (cadr msg))
|
|
(xmpp-send (message (car msg) (cadr msg))))
|
|
outgoing)
|
|
(set! outgoing '()))
|
|
(sleep 0.05)
|
|
#;(lxop))))
|
|
(super-new)))
|
|
|
|
(define j (make-object jabberer%))
|
|
|
|
(send j start "plant0000001@fo.am" "plant0000001")
|
|
(send j send-msg "plant0000003@fo.am" "woop")
|
|
|
|
(printf "wonk4~n") |