From 7acff0c906c22bd529bdde24dc4bd39b6705bfa4 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 09:32:17 -0300 Subject: [PATCH 1/9] irc.gitbot: Add formatting for topic change logs --- extra/irc/client/base/base.factor | 2 +- extra/irc/logbot/log-line/log-line.factor | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/extra/irc/client/base/base.factor b/extra/irc/client/base/base.factor index f54e18ac4b..318a1ab1e3 100644 --- a/extra/irc/client/base/base.factor +++ b/extra/irc/client/base/base.factor @@ -19,7 +19,7 @@ SYMBOL: current-irc-client UNION: to-target privmsg notice ; UNION: to-channel join part topic kick rpl-channel-modes - rpl-notopic rpl-topic rpl-names rpl-names-end ; + topic rpl-names rpl-names-end ; UNION: to-one-chat to-target to-channel mode ; UNION: to-many-chats nick quit ; UNION: to-all-chats irc-end irc-disconnected irc-connected ; diff --git a/extra/irc/logbot/log-line/log-line.factor b/extra/irc/logbot/log-line/log-line.factor index b3af41ad3d..255c46e5f3 100644 --- a/extra/irc/logbot/log-line/log-line.factor +++ b/extra/irc/logbot/log-line/log-line.factor @@ -35,3 +35,7 @@ M: participant-mode >log-line M: nick >log-line [ "* " % dup sender>> % " is now known as " % nickname>> % ] "" make ; + +M: topic >log-line + [ "* " % dup sender>> % " has set the topic for " % dup channel>> % + ": \"" % topic>> % "\"" % ] "" make ; From 84032835f5b3a1d12f0f749b33b81a38bef62ea3 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 17:11:41 -0300 Subject: [PATCH 2/9] irc.messages: Use GMT times when building a message --- extra/irc/messages/parser/parser.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/messages/parser/parser.factor b/extra/irc/messages/parser/parser.factor index 1fa07fc772..ee126b2550 100644 --- a/extra/irc/messages/parser/parser.factor +++ b/extra/irc/messages/parser/parser.factor @@ -32,4 +32,4 @@ PRIVATE> [ >>trailing ] tri* [ (>>prefix) ] [ fill-irc-message-slots ] [ swap >>line ] tri - now >>timestamp dup sender >>sender ; + gmt >>timestamp dup sender >>sender ; From 01f7f560b0877dfc3756d7cbcfafedc56021a990 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 17:16:24 -0300 Subject: [PATCH 3/9] irc.logbot: Use make to build timestamped string --- extra/irc/logbot/logbot.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/logbot/logbot.factor b/extra/irc/logbot/logbot.factor index a389304b14..2bf88568f8 100644 --- a/extra/irc/logbot/logbot.factor +++ b/extra/irc/logbot/logbot.factor @@ -16,7 +16,7 @@ SYMBOL: current-stream "irc.freenode.org" 6667 "flogger" f ; : add-timestamp ( string timestamp -- string ) - timestamp>hms "[" prepend "] " append prepend ; + timestamp>hms [ "[" % % "] " % % ] "" make ; : timestamp-path ( timestamp -- path ) timestamp>ymd ".log" append log-directory prepend-path ; From 7f5f8185bf204c151f39c2d70648bf9a9b571d16 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 17:21:31 -0300 Subject: [PATCH 4/9] irc.messages: Set timestamp when constructing, not on parser --- extra/irc/client/internals/internals.factor | 2 +- extra/irc/messages/base/base.factor | 3 ++- extra/irc/messages/parser/parser.factor | 4 ++-- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 5bae054e18..79aaf6bd5a 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -52,7 +52,7 @@ M: to-all-chats message-forwards drop chats> ; M: to-many-chats message-forwards sender>> participant-chats ; GENERIC: process-message ( irc-message -- ) -M: object process-message drop ; +M: object process-message drop ; M: ping process-message trailing>> /PONG ; M: join process-message [ sender>> ] [ chat> ] bi join-participant ; M: part process-message [ sender>> ] [ chat> ] bi part-participant ; diff --git a/extra/irc/messages/base/base.factor b/extra/irc/messages/base/base.factor index d67d226d9b..b785970520 100644 --- a/extra/irc/messages/base/base.factor +++ b/extra/irc/messages/base/base.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs classes.parser classes.tuple +USING: accessors arrays assocs calendar classes.parser classes.tuple combinators fry generic.parser kernel lexer mirrors namespaces parser sequences splitting strings words ; IN: irc.messages.base @@ -51,6 +51,7 @@ M: irc-message post-process-irc-message drop ; GENERIC: fill-irc-message-slots ( irc-message -- ) M: irc-message fill-irc-message-slots + gmt >>timestamp { [ process-irc-trailing ] [ process-irc-prefix ] diff --git a/extra/irc/messages/parser/parser.factor b/extra/irc/messages/parser/parser.factor index ee126b2550..06a41b0aaa 100644 --- a/extra/irc/messages/parser/parser.factor +++ b/extra/irc/messages/parser/parser.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. -USING: kernel fry splitting ascii calendar accessors combinators +USING: kernel fry splitting ascii accessors combinators arrays classes.tuple math.order words assocs irc.messages.base sequences ; IN: irc.messages.parser @@ -32,4 +32,4 @@ PRIVATE> [ >>trailing ] tri* [ (>>prefix) ] [ fill-irc-message-slots ] [ swap >>line ] tri - gmt >>timestamp dup sender >>sender ; + dup sender >>sender ; From 2c46304c75ae76082e25c59ae7cf0b05143ffa5f Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 21:33:21 -0300 Subject: [PATCH 5/9] irc.logbot: Use instead of --- extra/irc/logbot/logbot.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/logbot/logbot.factor b/extra/irc/logbot/logbot.factor index 2bf88568f8..ff8085a9a9 100644 --- a/extra/irc/logbot/logbot.factor +++ b/extra/irc/logbot/logbot.factor @@ -27,7 +27,7 @@ SYMBOL: current-stream ] [ current-stream get [ dispose ] when* [ day-of-year current-day set ] - [ timestamp-path latin1 ] bi + [ timestamp-path latin1 ] bi current-stream set ] if current-stream get ; From 34ec9af2ad82d18492c3670b9dad2c0fd5cff0db Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 21:35:26 -0300 Subject: [PATCH 6/9] irc.client: More robust reconnection --- extra/irc/client/chats/chats.factor | 8 ++-- extra/irc/client/internals/internals.factor | 46 ++++++++++++--------- 2 files changed, 31 insertions(+), 23 deletions(-) diff --git a/extra/irc/client/chats/chats.factor b/extra/irc/client/chats/chats.factor index 7910afb22a..3f6cf4945d 100644 --- a/extra/irc/client/chats/chats.factor +++ b/extra/irc/client/chats/chats.factor @@ -33,7 +33,8 @@ TUPLE: irc-profile server port nickname password ; C: irc-profile TUPLE: irc-client profile stream in-messages out-messages - chats is-running nick connect reconnect-time is-ready + chats is-running nick connect is-ready + reconnect-time reconnect-attempts exceptions ; : ( profile -- irc-client ) @@ -43,8 +44,9 @@ TUPLE: irc-client profile stream in-messages out-messages >>in-messages >>out-messages H{ } clone >>chats - 15 seconds >>reconnect-time + 30 seconds >>reconnect-time + 10 >>reconnect-attempts V{ } clone >>exceptions - [ latin1 ] >>connect ; + [ latin1 drop ] >>connect ; SINGLETONS: irc-chat-end irc-end irc-disconnected irc-connected ; diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 79aaf6bd5a..0a4fe11830 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -3,10 +3,17 @@ USING: accessors assocs arrays concurrency.mailboxes continuations destructors hashtables io irc.client.base irc.client.chats irc.messages kernel namespaces strings words.symbol irc.messages.base irc.client.participants fry threads -combinators irc.messages.parser ; +combinators irc.messages.parser math ; EXCLUDE: sequences => join ; IN: irc.client.internals +: do-connect ( server port quot: ( host port -- stream ) attempts -- stream/f ) + dup 0 > [ + [ drop call( host port -- stream ) ] + [ drop 15 sleep 1- do-connect ] + recover + ] [ 2drop 2drop f ] if ; + : /NICK ( nick -- ) "NICK " prepend irc-print ; : /PONG ( text -- ) "PONG " prepend irc-print ; @@ -15,18 +22,27 @@ IN: irc.client.internals "USER " prepend " hostname servername :irc.factor" append irc-print ; : /CONNECT ( server port -- stream ) - irc> connect>> call( host port -- stream local ) drop ; + irc> [ connect>> ] [ reconnect-attempts>> ] bi do-connect ; : /JOIN ( channel password -- ) [ " :" swap 3append ] when* "JOIN " prepend irc-print ; +: try-connect ( -- stream/f ) + irc> profile>> [ server>> ] [ port>> ] bi /CONNECT ; + +: (terminate-irc) ( -- ) + irc> dup is-running>> [ + f >>is-running + [ stream>> dispose ] keep + [ in-messages>> ] [ out-messages>> ] bi 2array + [ irc-end swap mailbox-put ] each + ] [ drop ] if ; + : (connect-irc) ( -- ) - irc> { - [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] - [ (>>stream) ] - [ t swap (>>is-running) ] - [ in-messages>> [ irc-connected ] dip mailbox-put ] - } cleave ; + try-connect [ + [ irc> ] dip >>stream t >>is-running + in-messages>> [ irc-connected ] dip mailbox-put + ] [ (terminate-irc) ] if* ; : (do-login) ( -- ) irc> nick>> /LOGIN ; @@ -92,9 +108,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ; : (handle-disconnect) ( -- ) irc-disconnected irc> in-messages>> mailbox-put - irc> reconnect-time>> sleep - (connect-irc) - (do-login) ; + (connect-irc) (do-login) ; : handle-disconnect ( error -- ? ) [ irc> exceptions>> push ] when* @@ -155,12 +169,4 @@ M: irc-channel-chat remove-chat [ part new annotate-message irc-send ] [ name>> unregister-chat ] bi ; -: (terminate-irc) ( -- ) - irc> dup is-running>> [ - f >>is-running - [ stream>> dispose ] keep - [ in-messages>> ] [ out-messages>> ] bi 2array - [ irc-end swap mailbox-put ] each - ] [ drop ] if ; - -: (speak) ( message irc-chat -- ) swap annotate-message irc-send ; \ No newline at end of file +: (speak) ( message irc-chat -- ) swap annotate-message irc-send ; From 460de5bbef80253c2a1bb0a691871fa7b2436212 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 22:19:16 -0300 Subject: [PATCH 7/9] irc.messages: Add predicate classes for ctcp and action messages --- extra/irc/messages/messages-tests.factor | 5 ++++- extra/irc/messages/messages.factor | 16 +++++++++++++--- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index 539fba54eb..347bdd00fa 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -71,4 +71,7 @@ IN: irc.messages.tests { name "nickname" } { trailing "Nickname is already in use" } } } [ ":ircserver.net 433 * nickname :Nickname is already in use" - string>irc-message f >>timestamp ] unit-test \ No newline at end of file + string>irc-message f >>timestamp ] unit-test + +{ t } [ ":someuser!n=user@some.where PRIVMSG #factortest :ACTION jumps!" + string>irc-message action? ] unit-test diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index a6bf02f8a7..2006cc24c3 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. USING: kernel fry splitting ascii calendar accessors combinators -arrays classes.tuple math.order words assocs strings irc.messages.base ; +arrays classes.tuple math.order words assocs strings irc.messages.base +combinators.short-circuit math ; EXCLUDE: sequences => join ; IN: irc.messages @@ -61,8 +62,17 @@ IRC: rpl-names-end "366" nickname channel : comment ; IRC: rpl-nickname-in-use "433" _ name ; IRC: rpl-nick-collision "436" nickname : comment ; +PREDICATE: channel-mode < mode name>> first "#&" member? ; +PREDICATE: participant-mode < channel-mode parameter>> ; +PREDICATE: ctcp < privmsg + trailing>> { [ length 1 > ] [ first 1 = ] [ peek 1 = ] } 1&& ; +PREDICATE: action < ctcp trailing>> rest "ACTION" head? ; + M: rpl-names post-process-irc-message ( rpl-names -- ) [ [ blank? ] trim " " split ] change-nicks drop ; -PREDICATE: channel-mode < mode name>> first "#&" member? ; -PREDICATE: participant-mode < channel-mode parameter>> ; +M: ctcp post-process-irc-message ( ctcp -- ) + [ rest but-last ] change-text drop ; + +M: action post-process-irc-message ( action -- ) + [ 7 tail ] change-text call-next-method ; From 7503c9876809f72d98d97dc94d63138d74cf5703 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 22:19:45 -0300 Subject: [PATCH 8/9] irc.logbot: Format for actions --- extra/irc/logbot/log-line/log-line.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/extra/irc/logbot/log-line/log-line.factor b/extra/irc/logbot/log-line/log-line.factor index 255c46e5f3..0960a3cedb 100644 --- a/extra/irc/logbot/log-line/log-line.factor +++ b/extra/irc/logbot/log-line/log-line.factor @@ -11,6 +11,12 @@ GENERIC: >log-line ( object -- line ) M: irc-message >log-line line>> ; +M: ctcp >log-line + [ "CTCP: " % dup sender>> % " " % text>> % ] "" make ; + +M: action >log-line + [ "* " % dup sender>> % " " % text>> % ] "" make ; + M: privmsg >log-line [ "<" % dup sender>> % "> " % text>> % ] "" make ; From 17cbf3dded0dccfea50f3031b54b47b9729ee2ce Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 16 Apr 2009 22:28:40 -0300 Subject: [PATCH 9/9] irc.client: Update test --- extra/irc/client/internals/internals-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/client/internals/internals-tests.factor b/extra/irc/client/internals/internals-tests.factor index d20ae50bcc..8d48f0c0a1 100644 --- a/extra/irc/client/internals/internals-tests.factor +++ b/extra/irc/client/internals/internals-tests.factor @@ -76,7 +76,7 @@ M: mb-writer dispose drop ; ! Test connect { V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [ "someserver" irc-port "factorbot" f - [ 2drop t ] >>connect + [ 2drop ] >>connect [ (connect-irc) (do-login)