[Gd-chatter] r10751 - in trunk/libraries: xml-parser xmpp xmpp/xmpp-test
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Tue May 23 23:17:17 CEST 2006
Author: turbo24prg
Date: Tue May 23 23:17:14 2006
New Revision: 10751
Modified:
trunk/libraries/xml-parser/interface.dylan
trunk/libraries/xml-parser/productions.dylan
trunk/libraries/xml-parser/simple-xml.dylan
trunk/libraries/xmpp/client.dylan
trunk/libraries/xmpp/iq.dylan
trunk/libraries/xmpp/xmpp-exports.dylan
trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan
Log:
Bug: 7313
* stream-initiation
* authentication (non-sasl, plain-text)
* simple "bot" ;)
* thx!
Modified: trunk/libraries/xml-parser/interface.dylan
==============================================================================
--- trunk/libraries/xml-parser/interface.dylan (original)
+++ trunk/libraries/xml-parser/interface.dylan Tue May 23 23:17:14 2006
@@ -67,7 +67,7 @@
// N.B. it is (very) preferable to use make-element instead of make
// when working in conjuction with the xml-parser library
define open class <element> (<attributes>, <node-mixin>, <mutable-collection>)
- slot element-parent :: <node-mixin>, init-keyword: parent:;
+ slot element-parent :: false-or(<node-mixin>) = #f, init-keyword: parent:;
virtual slot text;
end class <element>;
Modified: trunk/libraries/xml-parser/productions.dylan
==============================================================================
--- trunk/libraries/xml-parser/productions.dylan (original)
+++ trunk/libraries/xml-parser/productions.dylan Tue May 23 23:17:14 2006
@@ -447,7 +447,7 @@
["/>", no!(*last-tag-name*), set!(content, "")] }
end meta element;
-define meta start-tag (elt-name, attribs, started-new-element) => (elt-name, started-new-element)
+define meta start-tag (elt-name, attribs, started-new-element) => (elt-name, attribs, started-new-element)
scan-beginning-of-tag(elt-name, attribs), {
[">", set!(started-new-element, #t)],
["/>", set!(started-new-element, #f)]
Modified: trunk/libraries/xml-parser/simple-xml.dylan
==============================================================================
--- trunk/libraries/xml-parser/simple-xml.dylan (original)
+++ trunk/libraries/xml-parser/simple-xml.dylan Tue May 23 23:17:14 2006
@@ -225,6 +225,7 @@
define method add-element (element :: <element>, node :: <element>)
=> (res :: <element>);
element.node-children := add(element.node-children, node);
+ node.element-parent := element;
element;
end method add-element;
Modified: trunk/libraries/xmpp/client.dylan
==============================================================================
--- trunk/libraries/xmpp/client.dylan (original)
+++ trunk/libraries/xmpp/client.dylan Tue May 23 23:17:14 2006
@@ -3,6 +3,10 @@
author:
copyright:
+define constant *stanza-lock* = make(<lock>);
+define constant *parsed-stanza* = make(<notification>, lock: *stanza-lock*);
+define variable *available-stanza* :: false-or(<element>) = #f;
+
define class <xmpp-client> (<object>)
slot jid :: <jid>,
required-init-keyword: jid:;
@@ -12,50 +16,58 @@
virtual slot password;
end class <xmpp-client>;
-define method connect (client :: <xmpp-client>, #key port :: <integer> = 5222)
+define method connect (client :: <xmpp-client>, #key port :: <integer> = 5222, stream)
+ => (connected :: <boolean>);
start-sockets();
client.socket := make(<tcp-socket>, host: client.jid.domain, port: port);
- client.state := #"connected";
- format-out("TEST: %s\n", real-name("foo:bar"));
make(<thread>, priority: $background-priority, function: curry(listen, client));
+ if (~ stream)
+ stream := make(<xmpp-stream>, to: client.jid.domain);
+ end if;
+ let answer = send(client, start-tag(stream), awaits-result?: #t);
+ if (answer.name = #"stream:stream")
+ client.state := #"connected";
+ #t;
+ else
+ client.state := #"disconnected";
+ #f;
+ end if;
end method connect;
define method listen (client :: <xmpp-client>)
block ()
-// let parser-depth = 0;
let stream-running? = #f;
let parsing-tag? = #f;
- let parser-buffer = "";
+ let tag = "";
let current-element = #f;
-
- // keep watching that start tags match end tags
let tag-queue = make(<deque>);
-
+
while (~ stream-at-end?(client.socket))
let received = read-element(client.socket);
-
+
block(read-next)
if (parsing-tag? = #f)
if (received = '<')
parsing-tag? := #t;
- parser-buffer := add!(parser-buffer, received);
+ tag := add!(tag, received);
read-next();
- elseif (size(tag-queue) = 0 & received ~= '\n')
+ elseif (~ stream-running? & received ~= '\n')
//!!! error: not well-formed xml: chars not contained in root element
format-out("!!! error: not well-formed xml: chars not contained in root element\n");
- elseif (size(tag-queue) > 0 & current-element & received ~= '\n')
+ elseif (stream-running? & current-element & received ~= '\n')
//!!! collect chars into text of current-element!!!
- current-element.text := add!(current-element.text, received);
+ current-element.text := add!(current-element.text, received);
+ read-next();
end if;
else
if (received = '>')
// seems as we got an element
- parser-buffer := add!(parser-buffer, received);
- format-out(">>> %s\n", parser-buffer);
+ tag := add!(tag, received);
+ format-out(">>> %s\n", tag);
// could be the start tag of an element
- let (index, start-tag, attributes, opened-element?) = scan-start-tag(parser-buffer);
+ let (index, start-tag, attributes, opened-element?) = scan-start-tag(tag);
if (start-tag & opened-element?)
format-out("!!! (start) %s\n", start-tag);
// should be closed later
@@ -71,13 +83,15 @@
end if;
current-element := element;
format-out("!!! (current element) %=\n", current-element);
- if (current-element.name = #"stream:stream" & size(tag-queue) = 1 & ~ stream-running?)
+ if (current-element.name = #"stream:stream" & ~ stream-running?)
stream-running? := #t;
//!!! do something
+ format-out("!!! (X) %=\n", current-element);
+ make(<thread>, function: curry(dispatch, current-element));
current-element := #f;
end if;
// cleanup
- parser-buffer := "";
+ tag := "";
parsing-tag? := #f;
read-next();
elseif (start-tag & ~ opened-element?)
@@ -87,21 +101,21 @@
for (attribute in attributes)
add-attribute(element, attribute);
end for;
- if (current-element)
- add-element(current-element, element);
- end if;
// empty stanza
- if (size(tag-queue) = 1)
+ if (size(tag-queue) < 2)
format-out("!!! (X) %=\n", element);
+ make(<thread>, function: curry(dispatch, element));
+ else
+ add-element(current-element, element);
end if;
// cleanup
- parser-buffer := "";
+ tag := "";
parsing-tag? := #f;
read-next();
end if;
// could be the end tag of an element
- let (index, end-tag, opened-element?) = scan-end-tag(parser-buffer);
+ let (index, end-tag, opened-element?) = scan-end-tag(tag);
if (end-tag)
format-out("!!! (end) %s\n", end-tag);
// should close the last started tag
@@ -110,22 +124,20 @@
pop-last(tag-queue);
format-out("!!! now at depth: %d\n", size(tag-queue));
// dispatch
- if (end-tag = "stream:stream" & ~ current-element)
- stream-running? := #f;
- //!!! shutdown
- else
- format-out("!!! (-) %=\n", current-element);
- format-out("!!! (+) %=\n", current-element.element-parent);
-// if (~ current-element.element-parent)
- if (size(tag-queue) = 1)
- format-out("!!! (X) %=\n", current-element);
- //!!! do something!!!
+ format-out("!!! (-) %=\n", current-element);
+ format-out("!!! (+) %=\n", current-element.element-parent);
+ if (size(tag-queue) < 2)
+ format-out("!!! (X) %=\n", current-element);
+ if (end-tag = "stream:stream" & ~ current-element)
+ stream-running? := #f;
+ //!!! what do do here? thread?!
+ else
+ make(<thread>, function: curry(dispatch, current-element));
end if;
- //@listener.receive wird ausgeführt wenn @current keinen parent hat
- current-element := current-element.element-parent;
end if;
+ current-element := current-element.element-parent;
// cleanup
- parser-buffer := "";
+ tag := "";
parsing-tag? := #f;
read-next();
else
@@ -135,10 +147,10 @@
end if;
// could be a xml declaration
- let (index, processing-instruction) = scan-xml-decl(parser-buffer);
+ let (index, processing-instruction) = scan-xml-decl(tag);
if (processing-instruction)
format-out("!!! %=: %s\n", object-class(processing-instruction), processing-instruction.name);
- parser-buffer := "";
+ tag := "";
parsing-tag? := #f;
read-next();
end if;
@@ -146,7 +158,7 @@
else
//XXX we allow everything in a tag
if (received ~= '\n')
- parser-buffer := add!(parser-buffer, received);
+ tag := add!(tag, received);
end if;
read-next();
end if;
@@ -167,58 +179,62 @@
client.state := #"disconnected";
end method disconnect;
-define method send (client :: <xmpp-client>, data)
+define method send (client :: <xmpp-client>, data :: type-union(<element>, <string>), #key awaits-result?)
write-line(client.socket, as(<string>, data));
force-output(client.socket);
format-out("<<< %s\n", data);
+ if (awaits-result?)
+ let result = #f;
+ with-lock (*stanza-lock*)
+ until (*available-stanza*)
+ wait-for(*parsed-stanza*);
+ end until;
+ result := *available-stanza*;
+ *available-stanza* := #f;
+ end with-lock;
+ result;
+ end if;
end method send;
+define method send-with-id (client :: <xmpp-client>, data :: <element>, #key awaits-result?)
+ if (~ data.id)
+ data.id := "foo";
+ end if;
+
+ send(client, data, awaits-result?: awaits-result?);
+/*
+ if received.kind_of? XMLStanza and received.id == xml.id
+*/
+end method send-with-id;
+
define method password-setter (password, client :: <xmpp-client>)
=> (res);
password;
end method password-setter;
-/*
-define meta start-of-tag(elt-name, sym-name, attribs, s) => (elt-name, attribs)
- "<", scan-name(elt-name), scan-s?(s), scan-xml-attributes(attribs), ">"
-// (push(*tag-name-with-proper-capitalization*, elt-name)),
-//set!(sym-name, as(<symbol>, elt-name))
-end meta start-of-tag;
-
-define meta start-tag
-//(name, s, attribs) => (name)
- "<", ">"
-//, scan-name(name), scan-s?(s), scan-xml-attributes(attribs), ">"
-end meta start-tag;
-
-define meta end-tag (name, s) => (name)
- "</", scan-name(name), scan-s?(s), ">"
-end meta end-tag;
-*/
-/*
-define method valid-xmpp-data? (data :: <string>)
- => (res :: <boolean>);
- if (parse-document(data))
- #t;
+define method dispatch (element :: <element>)
+ with-lock (*stanza-lock*)
+ if (~ *available-stanza*)
+ release-all(*parsed-stanza*);
+ end if;
+ *available-stanza* := element;
+ end with-lock;
+
+ format-out("!!! (X2) %=\n", element);
+end method dispatch;
+
+define method authenticate (client :: <xmpp-client>, password, #key digest = #t)
+ let authentication = #f;
+ let authentication-request = #f;
+ if (digest)
+ //!!!
else
- #f;
+ authentication-request := make-authentication-request(client.jid);
+ authentication := make-authentication(client.jid, password);
end if;
-end method valid-xmpp-data?;
-*/
-
-/*
-define meta start-tag (elt-name, sym-name, attribs, s) => (elt-name, atts)
- "<", scan-name(elt-name), scan-s?(s), scan-xml-attributes(attribs), ">"
-end meta start-tag;
-*/
-
-/*
-define collector maybe-elements (c) => (c)
- loop([scan-maybe-element(c), do(collect(c))])
-end collector maybe-element;
-
-define collector maybe-element (c) => (c)
- "<", loop({[">", do(collect('>')), finish()], [accept(c), do(collect(c))]})
-end collector elements;
-*/
+ //!!!
+ send-with-id(client, authentication-request, awaits-result?: #t);
+ ///!!! verify!!!
+ send-with-id(client, authentication, awaits-result?: #t);
+end method authenticate;
Modified: trunk/libraries/xmpp/iq.dylan
==============================================================================
--- trunk/libraries/xmpp/iq.dylan (original)
+++ trunk/libraries/xmpp/iq.dylan Tue May 23 23:17:14 2006
@@ -87,6 +87,19 @@
iq;
end method make-vcard;
+define method make-authentication-request (jid :: <jid>)
+ => (iq :: <iq>)
+ let iq = make(<iq>, type: #"get");
+ iq.to := jid.domain;
+ let query = with-xml()
+ query(xmlns => "jabber:iq:auth") {
+ username(jid.node)
+ }
+ end with-xml;
+ add-element(iq, query);
+ iq;
+end method make-authentication-request;
+
define method make-authentication (jid :: <jid>, password :: <string>)
=> (iq :: <iq>);
let iq = make(<iq>, type: #"set");
@@ -98,7 +111,7 @@
with-xml() resource(jid.resource) end;
end)
}
- end;
+ end with-xml;
add-element(iq, query);
iq;
end method make-authentication;
Modified: trunk/libraries/xmpp/xmpp-exports.dylan
==============================================================================
--- trunk/libraries/xmpp/xmpp-exports.dylan (original)
+++ trunk/libraries/xmpp/xmpp-exports.dylan Tue May 23 23:17:14 2006
@@ -74,7 +74,7 @@
export <xmpp-client>,
jid, socket, state,
connect, disconnect,
- send;
+ send, authenticate;
export normalize,
id, id-setter,
Modified: trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan
==============================================================================
--- trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan (original)
+++ trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan Tue May 23 23:17:14 2006
@@ -221,70 +221,31 @@
*/
- let client = make(<xmpp-client>, jid: make(<jid>, node: "dylan", domain: "192.168.0.2"));
+ let client = make(<xmpp-client>, jid: make(<jid>, node: "foo", domain: "192.168.0.1", resource: "xmpp"));
let stream = make(<xmpp-stream>, to: client.jid.domain);
-
-// connect(client);
-// send(client, stream);
-// listen(client);
-// let response = read-line(client.socket, on-end-of-stream: #f);
-// if (response) write-line(*standard-output*, response); end if;
-// disconnect(client);
-
-/*
-// format-out("%=\n", object-class(parse-document("<foo>Blub</foo>")));
- block ()
- format-out("%=\n", object-class(parse-document("<foo>Blub")));
-// format-out("%=\n", object-class(parse-document("<foo>Blub</fo")));
-// format-out("%=\n", object-class(parse-document("<foo t='>Blub</foo>")));
-// format-out("%=\n", object-class(parse-document("<foo>Blub</blub>")));
- exception (condition :: <condition>)
- format-out("Error: %=\n", condition);
- format-out("%=\n", object-class(condition));
- end block;
-*/
+
block()
- connect(client);
+ if (~ connect(client))
+ exit-application(1);
+ end if;
format-out("Connected to xmpp server at %s port: %d\n",
client.socket.remote-host.host-name,
client.socket.remote-port);
- send(client, start-tag(stream));
+ authenticate(client, "foo", digest: #f);
+
+ let result = send(client, make(<message>, to: "foo at 192.168.0.1/Psi", body: "foo"), awaits-result?: #t);
+ format-out("### (X3) %=\n", result);
+
while (#t)
end while;
disconnect(client);
format-out("Connection closed. Bye\n");
- exception (condition :: <condition>)
+ cleanup
disconnect(client);
- format-out("xmpp-test: Error: %=\n", condition);
- end block;
-
-/*
- block ()
- format-out("%=\n", scan-xml-decl("<?xml version='1.0'?>"));
- format-out("%=\n", scan-xml-decl("<?xml version=''?>"));
-//format-out("%=\n", scan-xml-decl("<?xml?>"));
- format-out("%=\n", scan-xml-decl("<?xml '"));
- exception (condition :: <condition>)
- format-out("Error: %=: %=\n", condition);
- end block;
-*/
-/*
- block ()
- let (index, element) = scan-maybe-element-data("<foo123'%>");
- format-out("%=\n", element);
- let (index, element) = scan-maybe-element-data("<foo123'%><foo");
- format-out("%=\n", element);
- let (index, element) = scan-maybe-element-data("<foo123'%><foo>");
- format-out("%=\n", element);
- let (index, element) = scan-maybe-element-data("a<foo123'%><foo>", start: 1);
- format-out("%=\n", element);
- let (index, positions) = scan-positions("1 2 3 4");
- format-out("%=\n", positions);
-
exception (condition :: <condition>)
- format-out("Error: %=: %=\n", condition);
+ format-out("xmpp-test: Error: %=\n", condition);
end block;
-*/
+
exit-application(0);
end function main;
More information about the chatter
mailing list