jirc-1.0/0000755000076500007650000000000011271503720010751 5ustar keeskeesjirc-1.0/scripts/0000755000076500007650000000000011271503720012440 5ustar keeskeesjirc-1.0/scripts/jirc0000755000076500007650000010705611271503603013326 0ustar keeskees#!/usr/bin/perl # # Bridges an IRC channel to a Jabber conference room. # # Copyright (C) 2005-2009 Kees Cook # kees@outflux.net, http://outflux.net/ # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # http://www.gnu.org/copyleft/gpl.html # use warnings; use strict; use Getopt::Long qw(:config no_ignore_case bundling); use Pod::Usage; our $VERSION = "1.0"; our $NAME = "jirc"; BEGIN { use IO::Handle; use Config::Simple; use XML::Stream::Parser; use Text::Wrap; use POE qw/ Component::Jabber::ProtocolFactory /; use POE::Component::IRC; use POE::Component::Jabber; use Filter::Template; use POE::Filter::XML; use POE::Filter::XML::Node; use POE::Filter::XML::NS qw/ :JABBER :IQ /; use POE::Filter::XML::Utils; # Jabber communication parsers use Net::Jabber; use Net::Jabber::IQ; use Net::Jabber::Message; use Net::Jabber::Presence; use Net::Jabber::JID; } =head1 NAME jirc - Bridges an IRC channel to a Jabber conference room. =head1 SYNOPSIS jirc [OPTIONS] --config CONFIG -C, --config CONFIG Load config file as specified by CONFIG -V, --version Report version of script -h, --help Show detailed documentation. =head1 OPTIONS =over 8 =item B<-C CONFIG>, B<--config CONFIG> Specify the configuration file to load. Required. =item B<-V>, B<--version> Report the version of this script. =item B<-h>,B<--help> Show detailed documentation. =back =head1 DESCRIPTION The jirc bot logs into an IRC channel and a Jabber conference room. It will relay conversations between the two rooms, identifying each of the speakers in braces ([]). Actions are forwarded as well. There are some in-room commands that jirc responds to: !help Display summary of available jirc commands. !who Display a list of people online on the other end of the bridge. !shutdown Immediately quit the rooms and shutdown. =head1 CONFIGURATION The file specified with the B<--config> option contains field/value pairs, one per line: field: value For example: mode: production The required configuration fields are: =over 8 =item B Can be either "production" or "test". When running in "test" mode, the nicks and channel names all have "-test" appended to them so that jirc behavior can be tested in separate channel. =item B The IRC nickname to sign in with. Since this is a bridge, a short nick is recommended. To avoid confusion, it should match the B. =item B The IDENT username to sign in with. Since this is a bridge, a short name is recommended. To avoid confusion, it should match the B. =item B The IRC Username to sign in with. Since this is a bridge, a description of the bridge and a contact email address is recommended. =item B The IRC channel to join; the IRC side of the bridge. =item B The IRC server to join. =item B The Jabber protocol to use, either "XMPP" or "Legacy". =item B The Jabber identifier, in the form: NAME@SERVER/RESOURCE =item B Not all Jabber servers run on the same IP as the A record for their domain indicates. If your server runs like this, set the correct IP or hostname here. Note that jirc doesn't currently pay attention to SRV records. =item B The password for the Jabber ID. =item B Set to "1" to allow the password to be sent over the wire in plaintext or not - you'll need this for some servers that don't support DIGEST-MD5 with legacy authentication. (Default: 0) =item B How long to wait in seconds between disconnects before attempting a reconnect. (Default: 0) =item B The port to use for Jabber connections. This is normally 5222. =item B The name of the Jabber conference room to join, in the form ROOM@SERVER =item B The Jabber alias to use when joining the Jabber conference room. Since this is a bridge, a short nick is recommend. To avoid confusion, it should match the B. =item B The email address of this bot's owner. =item B The prefix used for the built-in in-room commands. This is normally "!". =item B Suppress bridging of status messages (joins, parts and presence changes). Normally 0. =item B The port to use for IRC connections. This is normally 6667. =item B How many seconds to wait until reconnecting after a missed IRC "TIME" response. This is normally 60. =item B How many seconds between "TIME" requests. This is normally 30. =item B When set to 1, this enables verbose debugging of the IRC side of communications. This is normally 0. =item B When set to 1, this enables verbose debugging of the Jabber side of communications. This is normally 0. =item B When set to 1, this enable verbose debugging of the general operation of the jirc bridge. This is normally 0. =back =head1 AUTHOR Kees Cook =head1 COPYRIGHT Copyright 2005-2009 by Kees Cook . This program is licensed under the terms of the GNU General Public License. =cut sub Version { print "$NAME version $VERSION\n"; print "Copyright 2005-2009 Kees Cook \n"; print "This program is licensed under the terms of the GNU General Public License.\n"; exit(0); } our $opt_help = undef; our $opt_version = undef; our $opt_config = undef; GetOptions( "config|C=s", "help|h", "version|V", ) || pod2usage(2); pod2usage( -exitval => 0, -verbose => 2 ) if ($opt_help); Version() if ($opt_version); pod2usage(2) if (!defined($opt_config)); # TODO: # - irc nick collision # - jabber nick collision # Configuration Management my $cfgfile = new Config::Simple($opt_config); die "Cannot load config file '$opt_config': $!\n" if (!defined($cfgfile)); my %cfg = $cfgfile->vars(); sub jirc_config { my ($param,$default) = @_; if (!defined($cfg{$param})) { if (!defined($default)) { die "Unconfigured setting: '$param'!\n"; } else { $cfg{$param} = $default; } } return $cfg{$param}; } die "Your configurable is not complete. Please check documentation.\n" if (!defined($cfg{'mode'}) || jirc_config('mode') eq "unconfigured"); # Flush! select STDOUT; $|=1; # XML Parser my $parser=new XML::Stream::Parser(style=>'node'); # IRC via POE #sub POE::Kernel::TRACE_REFCNT () { 1 } #sub POE::Kernel::ASSERT_DEFAULT () { 1 } # optional my $IRC_NICKSERV=$cfg{'irc-nickserv'} || ""; my $IRC_IDENTIFY=$cfg{'irc-identify'} || ""; # required my $testmode=jirc_config('mode') eq "test"; my $IRC_NICK=jirc_config('irc-nick'); my $IRC_USER=jirc_config('irc-username'); my $IRC_NAME=jirc_config('irc-ircname'); my $IRC_CHAN=jirc_config('irc-chan'); if ($testmode) { $IRC_NICK.="test"; $IRC_CHAN.="test"; } my $IRC_SERVER=jirc_config('irc-server'); my $IRC_PORT=jirc_config('irc-port'); # How many seconds to wait until reconnecting after a missed "TIME" response my $IRC_RECONNECT_TIMER=jirc_config('irc-reconnect'); # How often to request the "TIME" response, in seconds (must be less than recon) my $IRC_TIME_DELAY=jirc_config('irc-time-delay'); my $IRC_DEBUG=jirc_config('irc-debug'); my $IRC_LINE_MAX=jirc_config('irc-line-max'); my $CMD_PREFIX=jirc_config('prefix'); my $JABBER_PROTOCOL=jirc_config('jabber-protocol'); if ($JABBER_PROTOCOL =~ /xmpp/i) { $JABBER_PROTOCOL = +XMPP; } elsif ($JABBER_PROTOCOL =~ /legacy/i) { $JABBER_PROTOCOL = +LEGACY; } else { die "jabber-protocol must be either 'XMPP' or 'Legacy'\n"; } my $JABBER_ID=jirc_config('jabber-id'); if ($testmode) { $JABBER_ID.="test"; } my $JABBER_PORT=jirc_config('jabber-port'); my $JABBER_PASSWORD=jirc_config('jabber-password'); my $JABBER_PLAINTEXT=jirc_config('jabber-plaintext',0); my $JABBER_RECONNECT_DELAY=jirc_config('jabber-reconnect-delay',0); my $JABBER_CHAN_NAME=jirc_config('jabber-conference'); my $JABBER_CHAN_ALIAS=jirc_config('jabber-alias'); if ($testmode) { $JABBER_CHAN_NAME=~s/^([^\@]+)\@/$1test\@/; $JABBER_CHAN_ALIAS.='test'; } my $JABBER_DEBUG=jirc_config('jabber-debug'); my $JABBER_ADMIN=jirc_config('jabber-admin'); my ($JABBER_NAME, $JABBER_RESOURCE)=split('/',$JABBER_ID,2); my ($JABBER_SCREENNAME,$JABBER_SERVER)=split('@',$JABBER_NAME,2); my ($JABBER_CHAN_SCREENNAME,$JABBER_CHAN_SERVER)=split('@',$JABBER_CHAN_NAME,2); my $JABBER_SERVER_IP=jirc_config('jabber-server-ip', $JABBER_SERVER); my $QUIET_STATUS=jirc_config('quiet-status', 0); # Wrapping $Text::Wrap::columns = $IRC_LINE_MAX; my $irc_client="irc_client"; my $jabber_client="jabber_client"; my $TO_JABBER="jabber"; my $TO_IRC="irc"; #open DEBUG, ">>$irc_client.log" or die "Can't open log file: $!\n"; #DEBUG->autoflush(1); # Track channel membership my %jabber_chan_members; ##################################################################### ## General functions ##################################################################### sub debug { my @list = @_; for (@list) { $_ ||= ''; chomp; #print DEBUG localtime(time).": $_\n"; print localtime(time).": $_\n" if (jirc_config("debug")); } } ##################################################################### ## Jabber ##################################################################### # based on dufus - a POE jabber bot # my %XMPP_CLASS = ( 'iq' => "Net::Jabber::IQ", 'message' => "Net::Jabber::Message", 'presence' => "Net::Jabber::Presence", 'jid' => "Net::Jabber::JID", ); POE::Session->create( options => { debug => $JABBER_DEBUG, trace => $JABBER_DEBUG }, inline_states => { _start => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; $kernel->alias_set('jabberBot'); $heap->{'admin'} = $JABBER_ADMIN; $heap->{'component'} = POE::Component::Jabber->new( IP => $JABBER_SERVER_IP, Port => $JABBER_PORT, Hostname => $JABBER_SERVER, Username => $JABBER_SCREENNAME, Password => $JABBER_PASSWORD, Plaintext => $JABBER_PLAINTEXT, Resource => $JABBER_RESOURCE, ConnectionType => $JABBER_PROTOCOL, Alias => $jabber_client, Debug => $JABBER_DEBUG, ); $kernel->post($jabber_client, 'subscribe', +PCJ_READY, 'jabber_ready'); $kernel->post($jabber_client, 'subscribe', +PCJ_NODERECEIVED, 'jabber_node'); $kernel->post($jabber_client, 'subscribe', +PCJ_SSLFAIL, 'jabber_connect_failure'); $kernel->post($jabber_client, 'subscribe', +PCJ_AUTHFAIL, 'jabber_connect_failure'); $kernel->post($jabber_client, 'subscribe', +PCJ_BINDFAIL, 'jabber_connect_failure'); $kernel->post($jabber_client, 'subscribe', +PCJ_SESSIONFAIL, 'jabber_connect_failure'); $kernel->post($jabber_client, 'subscribe', +PCJ_SOCKETFAIL, 'jabber_connect_failure'); $kernel->post($jabber_client, 'subscribe', +PCJ_SOCKETDISCONNECT, 'jabber_connect_failure'); $kernel->post($jabber_client, 'subscribe', +PCJ_CONNECTFAIL, 'jabber_connect_failure'); $kernel->post($jabber_client, 'connect'); $kernel->sig( INT => 'bot_signal' ); $kernel->sig( ALRM => 'bot_signal' ); $kernel->sig( PIPE => 'bot_signal' ); $kernel->sig( HUP => 'bot_signal' ); $kernel->sig( TERM => 'bot_signal' ); }, _stop => sub { my $kernel = $_[KERNEL]; $kernel->alias_remove('jabberBot'); debug ("Jabber POE::Session Dying"); }, jabber_ready => \&jabber_ready, jabber_node => \&jabber_node, jabber_connect_failure => \&jabber_connect_failure, on_iq => \&jabber_on_iq, on_message => \&jabber_on_message, on_jid => \&jabber_on_jid, on_presence => \&jabber_on_presence, bot_signal => \&jabber_bot_signal, } ); sub jabber_bot_signal() { my ($kernel,$signal) = @_[KERNEL, ARG0]; $kernel->sig_handled(); print STDERR "\n\n$signal\n\n"; if ($signal eq "INT") { exit; } } sub toXNode { my ($sn)=@_; my %hash = $sn->attrib(); my @attribs = map { $_, $hash{$_} } sort keys %hash; my $xn = POE::Filter::XML::Node->new($sn->get_tag(),\@attribs); foreach my $child ($sn->children()) { if ($child->get_tag() eq "__xmlstream__:node:cdata") { $xn->appendText($child->children()); } else { $xn->appendChild(toXNode($child)); } } return $xn; } sub jabber_ready() { my ($kernel, $sender, $heap, $status) = @_[KERNEL, SENDER, HEAP, ARG0]; my $jid = $heap->{'component'}->jid(); $heap->{'jid'} = $jid; ($heap->{'screenname'},$heap->{'resource'}) = split('/',$jid,2); # Mark ourself online my $presence = new Net::XMPP::Presence(); $presence->SetShow('Online'); my $node = toXNode($presence->GetTree()); $kernel->post($jabber_client, 'output', $node); # request roster to get subscribe updates my $iq = new Net::XMPP::IQ(); $iq->SetIQ(type=>'get'); my $query = $iq->NewChild("jabber:iq:roster"); $node = toXNode($iq->GetTree()); $kernel->post($jabber_client, 'output', $node); # Join the channel my $chan = new Net::XMPP::Presence(); $chan->SetPresence(to=>join("/",$JABBER_CHAN_NAME,$JABBER_CHAN_ALIAS)); $node = toXNode($chan->GetTree()); $kernel->post($jabber_client, 'output', $node); } sub jabber_node() { my ($node) = $_[ARG0]; my ($query,$xmlns,$subject); my $str = $node->toString(); debug("XML string: $str"); $parser->parse($str); my $xml = $parser->returnData(1); my $tag = $xml->get_tag(); my $xmpp; my $class = $XMPP_CLASS{$tag}; if (defined($class)) { eval " \$xmpp = new $class(\$xml); "; if (defined($xmpp)) { $_[KERNEL]->post($_[SESSION]->ID,"on_$tag",$xmpp); } else { debug("Failed for instantiate $tag: $str"); } } else { debug("unknown XML: $str"); } } sub jabber_on_iq { my ($kernel, $heap, $iq) = @_[KERNEL, HEAP, ARG0]; debug "iq: ".$iq->GetXML(); } #Thu Jun 23 14:04:48 2005: presence: # Thu Jun 23 14:04:58 2005: presence: # Tue Feb 13 10:52:53 2007: presence(error): Internal Timeout sub jabber_on_presence { my ($kernel, $heap, $presence) = @_[KERNEL, HEAP, ARG0]; if ($presence->GetType() eq "subscribe") { my $reply = $presence->Reply(); $reply->SetType("subscribed"); debug("subscribed"); my $node = toXNode($reply->GetTree()); $kernel->post($jabber_client, 'output', $node); } else { my $type=$presence->GetType() || ""; $type="available" if ($type eq ""); my $from=$presence->GetFrom(); debug "presence($type): ".$presence->GetXML(); if ($type eq "error" && $from =~ m#^$JABBER_CHAN_NAME/([^/]+)$# && $1 eq $JABBER_CHAN_ALIAS) { # got disconnected from the room? # Immediately reconnect. $kernel->post($jabber_client, 'reconnect'); } if ($from =~ m|^$JABBER_CHAN_NAME/([^/]+)$| && $1 ne $JABBER_CHAN_ALIAS) { my $jid=$1; if ($type eq "available") { $jabber_chan_members{$jid}=1; } elsif ($type eq "unavailable") { delete $jabber_chan_members{$jid}; } } } } sub jabber_on_message { my ($kernel, $heap, $message) = @_[KERNEL, HEAP, ARG0]; #debug "message: ".$message->GetXML(); my $type = $message->GetType(); return if $type eq 'error'; my $to = $message->GetTo(); my $from = $message->GetFrom(); my $subject = $message->GetSubject(); my $who = ''; my $channel = ''; my $nick = ''; ($channel,$who) = split('/',$from); my ($jid,$res) = split('/',$to); # from the channel itself: # Tue Feb 15 08:58:28 2005: message: nem has become available debug "jabber_on_message: ".$message->GetXML(); my $body = $message->GetBody(); if ($type eq "chat") { $body =~ s/[\cA-\c_]//ig; # strip control characters jabber_msg('chat', "you said: \"$body\"",$from,$to); } elsif ($type eq 'groupchat') { if (lc($who) eq lc($JABBER_CHAN_ALIAS)) { debug "dropping message from self: ".$message->GetXML(); return; } # Skip delayed messages if ($message->GetX('jabber:x:delay')) { debug "dropping delayed message: ".$message->GetXML(); return; } # Where is this msg coming from? my $prefix=""; if (!defined($who) || $who eq "") { # This is a msg from the conference room my($subject,$reminder)=split(/\s+/,$body,2); # Suppress uninteresting notices if ($body eq "This room supports the MUC protocol." || $subject eq $JABBER_CHAN_ALIAS || $body eq $JABBER_CHAN_SCREENNAME || $body =~ /^\S+ has set the topic to:/ || $QUIET_STATUS || $body =~ /^This room .* is not anonymous$/) { debug "ignoring uninteresting message: ".$message->GetXML(); return; } $prefix="* "; } else { $prefix="[$who] "; } # Check for commands if ($body =~ /^\s*${CMD_PREFIX}(.*)$/) { return if (process_cmd($kernel,$1,$TO_JABBER)); } print "Relaying: ".$message->GetXML()."\n"; if ($body =~ /^\/me ([^\r\n]*)$/) { my $action = $1; to_channel("*** $who $action",$TO_IRC); return; } my @sections = split(/\r?\n/,$body); foreach my $section (@sections) { $section =~ s/[\cA-\c_]//ig; # strip control characters my @lines; if (length($section)+length($prefix)>$IRC_LINE_MAX) { @lines=split(/\n/,wrap($prefix,$prefix,$section)); } else { push(@lines,$prefix.$section); } foreach my $line (@lines) { to_channel($line,$TO_IRC); } } } else { print "Got: ".$message->GetXML()."\n"; print "\tto: $to\n"; print "\tfrom: $from\n"; print "\ttype: $type\n"; print "\tmessage: $message\n"; print "\tsubject: ".($subject||"")."\n"; } } sub jabber_on_jid { my ($kernel, $heap, $jid) = @_[KERNEL, HEAP, ARG0]; debug "jid: ".$jid->GetXML(); } # Too bad PCJ doesn't provide a way to find out which even this was... sub jabber_connect_failure() { my ($kernel,$sender,$error) = @_[KERNEL, SENDER, ARG0]; my ($call, $code, $err) = @_[ARG1..ARG3]; print "Jabber busted: $error, $call, $code, $err\n"; sleep($JABBER_RECONNECT_DELAY); $kernel->post($sender, 'reconnect'); } sub is_utf8($) { my $x = shift; return $x =~ m/\A(?: [\x09\x0A\x0D\x20-\x7E] # ASCII | [\xC2-\xDF][\x80-\xBF] # non-overlong 2-byte | \xE0[\xA0-\xBF][\x80-\xBF] # excluding overlongs | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} # straight 3-byte | \xED[\x80-\x9F][\x80-\xBF] # excluding surrogates | \xF0[\x90-\xBF][\x80-\xBF]{2} # planes 1-3 | [\xF1-\xF3][\x80-\xBF]{3} # planes 4-15 | \xF4[\x80-\x8F][\x80-\xBF]{2} # plane 16 )*\z/x; } sub jabber_msg($$$$) { my $type = shift; my $message = shift; my $to = shift; my $from = shift; my $node = POE::Filter::XML::Node->new('message'); if ($node->can('attr')) { $node->attr('to',$to); $node->attr('from',$from); $node->attr('type',$type); } else { $node->setAttributes(['to' => $to, 'from' => $from, 'type' => $type]); } # Translate IRC-isms into common text-only meanings $message =~ s/\x1F([^\x1F]*)\x1F/_${1}_/gs; $message =~ s/\x02([^\x02]*)\x02/*${1}*/gs; # Encode weird crap since POE::Filter::XML::Node's data isn't safe!! if (!is_utf8($message)) { $message =~ s/([^\x20-\x7F])/'&#' . ord($1) . ';'/gse; } # I was using rawdata, but that doesn't seem to work if ($node->can('insert_tag')) { $node->insert_tag('body')->data($message); } else { $node->appendTextChild('body',$message); } $poe_kernel->post($jabber_client, 'output', $node); } ##################################################################### ## IRC ##################################################################### my ($poeirc) = POE::Component::IRC->spawn('alias' => $irc_client) or die "POE::C::IRC->spawn failed: $!"; POE::Session->create( options => { debug => $IRC_DEBUG, trace => $IRC_DEBUG }, inline_states => { _start=>\&irc_startup, _default=>\&irc_default, reconnect=>\&irc_reconnect, told=>\&irc_told, want_time=>\&irc_want_time, on_time=>\&irc_on_time, # do_op=>\&irc_do_op, irc_001=>\&irc_on_connect, irc_connected=>\&irc_on_connect, # irc_registered=>\&irc_on_connect, irc_public=>\&irc_on_public, irc_join=>\&irc_on_join, irc_part=>\&irc_on_part, irc_quit=>\&irc_on_quit, irc_msg=>\&irc_on_private, irc_ctcp_action=>\&irc_on_action, irc_nick=>\&irc_on_nick, irc_kick=>\&irc_on_kick, irc_invite=>\&irc_on_invite, irc_mode=>\&irc_on_mode, irc_353=>\&irc_on_names, irc_366=>\&irc_on_names_done, irc_332=>\&irc_on_topicraw, irc_391=>\&irc_on_time, irc_topic=>\&irc_on_topic, irc_disconnected=>\&irc_reconnect, }, ); sub irc_default { my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; } sub irc_startup { my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my @args = @_[ARG0..$#_]; my %config; $config{nick}=$IRC_NICK; $config{username}=$IRC_USER; $config{ircname}=$IRC_NAME; $config{nickserv}=$IRC_NICKSERV; $config{identify}=$IRC_IDENTIFY; $config{server}=$IRC_SERVER; $config{port}=$IRC_PORT; $heap->{config} = \%config; $heap->{connect} = { Nick => $config{nick}, Username => $config{username}, Ircname => $config{ircname}, Server => $config{server}, Port => $config{port} || 6667, Ircname => $config{ircname}, Debug => $IRC_DEBUG, }; $kernel->post($irc_client=>register=>'all'); $kernel->post($irc_client=>connect=>$heap->{connect}); } sub irc_get_nick { my ($nick) = @_; return unless $nick; $nick =~ /^(.*)!(.*)@(.*)$/; return $1 or $nick; } sub irc_told { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nick, $channel, $message) = @_[ARG0..$#_]; $message =~ s/^\s*//; $message =~ s/\s*$//; my $sender = $channel || $nick; my ($command, $param) = split(/\s+/, $message, 2); $command = lc($command); if ($command eq "who") { $kernel->post($irc_client, 'names', $param || $channel) if ($channel or $param); } elsif ($command eq "help") { $kernel->post($irc_client, 'privmsg', $sender, "I'm $irc_client. Commands: ${CMD_PREFIX}help, ${CMD_PREFIX}who"); } } ############################################################################# ## Event handlers ############################################################################# sub irc_on_public { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channels, $message) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); return if ($nick eq $IRC_NICK); if ($message =~ /^\s*${CMD_PREFIX}(.*)$/ && process_cmd($kernel,$1,$TO_IRC)) { # don't forward command across to other channel } else { # Why are ACTIONs coming through here instead of irc_on_action?! if ($message =~ /^\cAACTION /) { $message =~ s/^\cAACTION //; to_channel("*** $nick $message",$TO_JABBER); } else { to_channel("[$nick] $message",$TO_JABBER); } #debug("<$nick\@$channels->[0]> $message"); } } # Why doesn't this get called anymore? sub irc_on_action { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channels, $message) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); return if ($nick eq $IRC_NICK); to_channel("*** $nick $message",$TO_JABBER); } sub irc_on_private { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $recipients, $message) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); debug("<$nick> $message"); $message =~ s/^!//; $kernel->yield('told', $nick, undef, $message); } sub irc_on_connect { my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my @args = @_[ARG0..$#_]; debug("Connected to IRC server\n"); $kernel->yield('on_time'); # identify nick if ($heap->{config}{'nickserv'} ne "") { $kernel->post($irc_client, 'privmsg', $heap->{config}{'nickserv'}, 'identify '.$heap->{config}{'identify'}); } my $channel=$IRC_CHAN; $heap->{channels}{$channel}=1; $kernel->post($irc_client=>join=>$channel); # $kernel->delay("do_op", 30); } # we have joined a channel sub irc_on_join { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channel) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); if (lc($nick) eq lc($heap->{config}{nick})) { debug("Joined $channel"); } else { if (! $QUIET_STATUS) { to_channel("* joined: $nick",$TO_JABBER); }; #debug("$nick just joined $channel"); } } sub irc_on_part { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channel, $reason) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); #debug("$nick just left $channel"); if(!$QUIET_STATUS) { to_channel("* left: $nick",$TO_JABBER); }; } sub irc_on_quit { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $reason) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); #debug("$nick just quit ($reason)"); if (! $QUIET_STATUS) { to_channel("* quit: $nick ($reason)",$TO_JABBER); }; } # we're invited to a channel sub irc_on_invite { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channel) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); debug("Invited to $channel by $nick\n"); # $kernel->post($irc_client=>join=>$channel); } # we've been kicked. sub irc_on_kick { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channel, $kicked, $reason) = @_[ARG0..$#_]; my $nick = irc_get_nick($nickstring); $kernel->yield('on_time'); if (lc($kicked) eq lc($heap->{config}{nick})) { debug("Kicked from $channel by $nickstring ($reason)\n"); # remember we were kicked. delete $heap->{channels}{$channel}; # Try to join again anyway. $kernel->post($irc_client=>join=>$channel); } else { to_channel("* kicked: $kicked by $nickstring ($reason)",$TO_JABBER); #debug("$kicked kicked from $channel by $nickstring ($reason)\n"); } } sub irc_on_mode { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($nickstring, $channel, $mode, @ops) = @_[ARG0..$#_]; my $who = irc_get_nick($nickstring) || ""; debug("$who set mode $mode in $channel for ".join(",", @ops)); $kernel->yield('on_time'); my @modes = split(//, $mode); my $type = shift(@modes); # + or -? @modes = grep(/[ovm]/, @modes); # the ones that affect people. # we don't really do much useful unless a mode got added. return unless $type eq "+"; for my $nick (@ops) { $nick = lc($nick); my $m = shift(@modes); if ($nick eq lc($heap->{config}{nick}) and $m eq 'o') { debug("Hey! I got opped!"); $kernel->post($irc_client, 'names', $channel) if $channel; } elsif ($m eq 'o') { # debug("I don't need to op $nick any more, then"); delete $heap->{to_op}{$channel}{lc($nick)}; } elsif ($m eq 'v') { # debug("I don't need to voice $nick any more, then"); delete $heap->{to_voice}{$channel}{lc($nick)}; } } } sub irc_on_nick { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; my ($fromraw, $nick) = @_[ARG0..$#_]; # If people change nicks, we should notice if they need opping. $kernel->yield('on_time'); #debug("$from changed nick to $nick"); my $from = irc_get_nick($fromraw) || ''; if (! $QUIET_STATUS) { to_channel("* nick: $from is now $nick",$TO_JABBER); }; } sub irc_on_names { my ($kernel, $heap, $session, $server, $message) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1]; $kernel->yield('on_time'); my (undef, $channel, @names) = split(/\s/, $message); $names[0] =~ s/^\://; # FFS $heap->{names}{$channel}{$_}++ for (@names); #debug("People in $channel: ".join(",", @names)); @names = map { s/^@//; $_; } grep($_ ne $IRC_NICK,@names); to_channel("* members: ".join(", ",sort { lc($a) cmp lc($b) } @names),$TO_JABBER); } sub irc_on_names_done { my ($kernel, $heap, $session, $server, $message) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1]; my ($channel) = split(/\s/, $message); for (keys(%{$heap->{names}{$channel}})) { # my $op = 1 if s!^@!!; # my $voice = 1 if s!^\+!!; # if (!$op and $kernel->call($session, 'trust', $channel, $_)) { # $heap->{to_op}{lc($channel)}{lc($_)}++; # } elsif (!$op and !$voice and $kernel->call($session, 'believe', $channel, $_)) { # $heap->{to_voice}{lc($channel)}{lc($_)}++; # } } delete $heap->{names}{$channel}; } sub irc_on_topicraw { my ($kernel, $heap, $session, $server, $raw) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1]; my ($channel, $topic) = split(/ :/, $raw, 2); $kernel->call($session, 'irc_topic', undef, $channel, $topic); } sub irc_on_topic { my ($kernel, $heap, $nickraw, $channel, $topic) = @_[KERNEL, HEAP, ARG0, ARG1, ARG2]; my $nick = irc_get_nick($nickraw) || ''; $kernel->yield('on_time'); debug("$nick changed topic of $channel to $topic"); } sub irc_do_op { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; # debug("op?"); # my @all_ops = keys(%{$heap->{to_op}{all}}); # for my $c (keys(%{$heap->{channels}})) { # $heap->{to_op}{$c}{$_}++ for (@all_ops); # } # # foreach my $channel (keys(%{$heap->{to_op}})) { # my @nicks = keys(%{$heap->{to_op}{$channel}}); # next unless $nicks[0]; # debug("In $channel, I need to op ".join(",", @nicks)); # while (@nicks) { # my @s = splice(@nicks, 0, 3); # $kernel->post($irc_client=>mode=>"$channel +ooo ".join(" ", @s)); ## debug(" /mode $channel +ooo ".join(" ", @s)); # } # } # delete $heap->{to_op}; # # foreach my $channel (keys(%{$heap->{to_voice}})) { # my @nicks = keys(%{$heap->{to_voice}{$channel}}); # next unless $nicks[0]; # debug("In $channel, I need to voice ".join(",", @nicks)); # while (@nicks) { # my @s = splice(@nicks, 0, 3); # $kernel->post($irc_client=>mode=>"$channel +vvv ".join(" ", @s)); ## debug(" /mode $channel +vvv ".join(" ", @s)); # } # } # delete $heap->{to_voice}; # # $kernel->delay("do_op", $heap->{config}{delay} || 3); } sub irc_on_time { my ($kernel, $heap) = @_[KERNEL, HEAP]; # Delay reconnect $kernel->delay('reconnect', $IRC_RECONNECT_TIMER); # Delay the TIME request $kernel->delay('want_time', $IRC_TIME_DELAY); return; } sub irc_want_time { my ($kernel, $heap) = @_[KERNEL, HEAP]; # Request time from server $kernel->post($irc_client,'time'); # Refire request $kernel->delay('want_time', $IRC_TIME_DELAY); } # We'll only get here if there hasn't been a ping in the last 200 secs. We can # assume we've lost the connection. sub irc_reconnect { my ($kernel, $heap) = @_[KERNEL, HEAP]; debug("REJOIN: I think I lost my server connection"); debug(" disconnecting.."); $kernel->call($irc_client, 'disconnect'); debug(" shutting down.."); $kernel->call($irc_client, 'shutdown'); debug(" creating new Poco::IRC"); $poeirc = POE::Component::IRC->spawn('alias' => $irc_client); debug(" registering.."); $kernel->post($irc_client=>register=>'all'); $kernel->post($irc_client=>connect=>$heap->{connect}); $kernel->delay('want_time', $IRC_TIME_DELAY); $kernel->delay('reconnect', 30); # Try quite frequently till we get somewhere. } # # Support functions # sub to_channel { my ($msg,$dest)=@_; if ($dest eq $TO_JABBER) { jabber_msg('groupchat', $msg, $JABBER_CHAN_NAME,$JABBER_ID); } elsif ($dest eq $TO_IRC) { $poe_kernel->post($irc_client, 'privmsg', $IRC_CHAN, $msg); } else { die "Unknown to_channel dest: '$dest'\n"; } } # Returns true if command known sub process_cmd { my ($kernel,$cmd,$dest)=@_; if ($cmd eq "help") { to_channel("${CMD_PREFIX}who - shows who is on the other channel",$dest); to_channel("${CMD_PREFIX}shutdown - shutdown bridge (will probably attempt to rejoin after a few seconds)",$dest); } elsif ($cmd eq "who") { if ($dest eq $TO_JABBER) { $poe_kernel->post($irc_client, 'names', $IRC_CHAN); } else { to_channel("* members: ".join(", ",sort { lc($a) cmp lc($b) } keys %jabber_chan_members),$TO_IRC); } } elsif ($cmd eq "shutdown") { exit(0); } else { return 0; } return 1; } POE::Kernel->run(); exit; # vim: softtabstop=4 shiftwidth=4 expandtab tabstop=4 jirc-1.0/MANIFEST0000644000076500007650000000011511072430060012072 0ustar keeskeesREADME jirc.conf scripts/jirc Makefile.PL looper MANIFEST META.yml ChangeLog jirc-1.0/looper0000755000076500007650000000030611225466546012213 0ustar keeskees#!/bin/bash # This is an example script to run to keep the jirc bridge running. # Run as: nohup ./looper & while :; do mv jirc.log jirc.log.`date +%Y%m%d-%H%M%S` jirc >jirc.log 2>&1 sleep 5 done jirc-1.0/ChangeLog0000644000076500007650000000214011271503626012525 0ustar keeskees* 1.0 (2009-10-26) - add quiet-status, thanks to Nick Thomas - drop PCJ::Error/Status to be forward-compatible, use scoped consts - migrate to 3.0 PCJ API * 0.9 (2009-07-10) - do not send presence until we're fully logged in - fix miscompile for config loading - implement jabber-server-ip based on patch from Nick Thomas - cleaned up warnings - clarified Jabber errors * 0.8 (2009-07-09) - fix broken utf8 code handling, thanks to Peter Moulder - implement 'jabber-plaintext' for plain auth, thanks to Nick Thomas - implement 'jabber-reconnect-delay', thanks to Nick Thomas - fix up command prefix in "tell" report - clean up whitespace * 0.7 - add username, ircname, and identify support for IRC - fix up protocol handling, move to PCJ 2.0 connection styles * 0.6 - updated to work with POE::Component::Jabber 2.02 * 0.5 - translate IRC-client markups to something reasonable in Jabber - disallow control characters in XML - handle room connection errors gracefully - don't hammer the jabber server on reconnect - basic POD docs, and option handling * 0.4 - ported to modern POE interfaces jirc-1.0/META.yml0000644000076500007650000000123711271503720012225 0ustar keeskees--- #YAML:1.0 name: jirc version: 1.0 abstract: Bridges an IRC channel to a Jabber conference room. license: ~ author: - Kees Cook generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: Config::Simple: 0 Net::Jabber: 0 POE: 0 POE::Component::IRC: 0 POE::Component::Jabber: 0 POE::Filter::XML: 0 XML::Stream::Parser: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 jirc-1.0/jirc.conf0000644000076500007650000000353211226673233012561 0ustar keeskees# Which mode is the server in? Three options are # - production (normal operation) # - test (appends '-test' to nicks, channels, etc) # - unconfigured (abort loading, since you haven't changed this config file) mode: unconfigured # IRC nickname irc-nick: jirc # IDENT username irc-username: jirc # IRC username irc-ircname: Jabber/IRC Bridge for #jirc (email@example.com) # IRC channel irc-chan: #jirc # IRC server irc-server: irc.example.com # For NickServ-based "identify" commands, uncomment the following: #irc-nickserv: NickServ #irc-identify: password-here # Jabber ID jabber-id: jirc@example.com/daemon # Jabber password jabber-password: password # Jabber conference room jabber-conference: jirc@conference.example.com # Jabber conference room alias (name to show for self in the conference room) jabber-alias: jirc # Email to contact for jabber admin jabber-admin: jirc-owner@example.com # Command prefix character prefix: ! # Should status/join/part be silenced? quiet-status: 0 ############################################################################ # Shouldn't usually need to change anything below this line... # IRC communication debug output? irc-debug: 0 # IRC port irc-port: 6667 # How many seconds to wait until reconnecting after a missed "TIME" response irc-reconnect: 60 # How often to request the "TIME" response, in seconds irc-time-delay: 30 # Split messages to IRC after how many characters per line? irc-line-max: 430 # Jabber communication debug output? jabber-debug: 0 # Jabber port jabber-port: 5222 # Jabber protocol (XMPP or Legacy) jabber-protocol: XMPP # Jabber should not use plaintext authentication (for Legacy) #jabber-plaintext: 1 # Jabber seconds to wait before reconnecting jabber-reconnect-delay: 0 # Jabber server IP, to override hostname in jabber-id #jabber-server-ip: 127.0.0.1 # Overall system-wide debug output debug: 0 jirc-1.0/Makefile.PL0000644000076500007650000000276011072430060012723 0ustar keeskeesuse strict; use warnings; use ExtUtils::MakeMaker; use Config; my %args = ( pkg_name => 'jirc-bridge', name => 'jirc', DESTDIR => undef, ); my @pass_args; while (my $arg = shift @ARGV) { my ($key, $value) = split /=/, $arg; if (exists $args{$key}) { $args{$key} = $value; } else { push @pass_args, $arg; } } @ARGV = @pass_args; my %opts=( 'INSTALLDIRS' => 'site', 'NAME' => $args{'name'}, 'AUTHOR' => 'Kees Cook ', 'VERSION_FROM' => 'scripts/jirc', # finds $VERSION 'ABSTRACT_FROM' => 'scripts/jirc', 'EXE_FILES' => [ qw( scripts/jirc ) ], 'PREREQ_PM' => { 'Config::Simple' => 0, 'POE' => 0, 'POE::Component::IRC' => 0, 'POE::Component::Jabber' => 0, 'POE::Filter::XML' => 0, 'XML::Stream::Parser' => 0, 'Net::Jabber' => 0, }, ); #if ($ExtUtils::MakeMaker::VERSION > 5.45) { # $opts{'PREREQ_FATAL'} = 1, #} # This puts us in the site_perl directory, not dependant on any version # of perl. if (defined($Config{'sitelib_stem'}) && $Config{'sitelib_stem'} ne "") { #print "stem is: $Config{'sitelib_stem'}\n"; $opts{'INSTALLSITELIB'} = ""; $opts{'INSTALLSITELIB'} = $args{'DESTDIR'} if (($] >= 5.008 && $] < 5.008005) || $ExtUtils::MakeMaker::VERSION =~ /5\.9[1-6]|6\.0[0-5]/); $opts{'INSTALLSITELIB'} .= $Config{'sitelib_stem'}; } WriteMakefile(%opts); # /* vi:set ai ts=4 sw=4 expandtab: */ jirc-1.0/README0000644000076500007650000000067011072430271011633 0ustar keeskeesThis is a Perl POE bot script that connects a Jabber conference room with an IRC channel, relaying conversations. Configuration items are read from jirc.conf in the local directory. Please send updates and patches! :) Dependencies (Debian package names): libconfig-simple-perl libfilter-template-perl libnet-jabber-perl libpoe-component-irc-perl libpoe-component-jabber-perl libxml-stream-perl Kees Cook