[ViewVC] Annotation of: cvs/cvsroot/Net-IRC3/samples/jsonsrv

#!/opt/perl/bin/perl
use strict;
use URI;
use AnyEvent::Impl::Perl;
use IO::Handle;
use JSON::Syck;
use JSONConnection;
use Net::IRC3::Client::Connection;
use POSIX qw/strftime/;
$Net::IRC3::Client::Connection::DEBUG = 1;

our $CFG;
our %ALIASES;
our %CONNS;

our %CHAT_BUFFER;

our %LOGS;

our $JS;

sub add_chat_buffer {
   my ($data) = @_;
   $CHAT_BUFFER{$data->{src}} ||= [];
   my $buf = $CHAT_BUFFER{$data->{src}};
   unshift @$buf, $data;
   if (@$buf > 50) { splice @$buf, 50 }
}

sub get_chat_buffer {
   my ($dest) = @_;
   return @{$CHAT_BUFFER{$dest} || []};
}

sub log_line {
   my ($server, $src, $line) = @_;
   my $logdir = $CFG->{log_dir} || "$ENV{HOME}/.jsonirc_logs/";
   my $ts = POSIX::strftime "%F %T %Z", localtime (time);

   eval {
      unless (-e $logdir) {
         mkdir $logdir or die "Couldn't make directory '$logdir': $!";
      }
      my $logfile = "$logdir/${server}" . ($src ne "" ? "_$src" : "");
      unless ($LOGS{$logfile}) {
         open my $logfh, ">>", "$logfile"
            or die "Couldn't open '$logfile': $!";
         $LOGS{$logfile} = $logfh;
         $logfh->autoflush (1);
         $LOGS{$logfile}->print ("---- $ts ---- starting log ----\n");
      }
      $LOGS{$logfile}->print ("$ts: $line\n");
   };
   if ($@) {
      error_reply (undef, undef, logging_error => "Couldn't log for $server $src: $@");
   }
}

sub load_cfg {
   $CFG ||= {};
   return unless -e "$ENV{HOME}/.jsonircrc";
   open CFGH, "<", "$ENV{HOME}/.jsonircrc" or die "Couldn't open ~/.jsonircrc: $!";
   $::CFG = JSON::Syck::Load (do { local $/; <CFGH> });
}

sub save_cfg {
   open CFGH, ">", "$ENV{HOME}/.jsonircrc" or die "Couldn't open for writing ~/.jsonircrc: $!";
   print CFGH (JSON::Syck::Dump ($::CFG));
   close CFGH;
}

sub to_dest_id {
   my ($irccon, $targ) = @_;
   $targ ||= '';
   $irccon = $ALIASES{$irccon} || $irccon;
   my $uri = new URI;
   $uri->scheme ("jsirc"); $uri->authority ($irccon); $uri->path ($targ);
   "$uri"
}

sub unalias {
   my ($id) = @_;
   for (keys %ALIASES) {
      if ($id eq $ALIASES{$_}) {
         return $_;
      }
   }
}

sub lookup_connection {
   my ($id) = @_;
   my $alias = unalias ($id);
   return $CONNS{$alias || $id}
}

sub from_dest_id {
   my ($dest_id) = @_;
   my $uri = URI->new ($dest_id);
   my $path = ($uri->path_segments ())[1];
   return (lookup_connection ($uri->authority), unalias ($uri->authority) || $uri->authority, $path);
}

sub connect_irc {
   my ($host, $port, $alias) = @_;
   my $irccon = "$host:$port";
   my $pc = $CONNS{$irccon} = Net::IRC3::Client::Connection->new;
   $ALIASES{$irccon} = $alias if defined $alias;

   $pc->reg_cb (
      channel_add => sub {
         my ($pc, $chan, @nicks) = @_;
         $chan = lc $chan;
         my $dest = to_dest_id ($irccon, $chan);
         my @ids  = map { to_dest_id ($irccon, $_) } @nicks;
         $JS->broadcast ({
            src  => $dest,
            type => 'subid',
            command => 'add',
            ids => \@ids,
            timestamp => time (),
         });
         log_line ($irccon, $chan, "$chan add: @nicks");
         1;
      },
      channel_remove => sub {
         my ($pc, $chan, @nicks) = @_;
         $chan = lc $chan;
         my $dest = to_dest_id ($irccon, $chan);
         my @ids  = map { to_dest_id ($irccon, $_) } @nicks;
         $JS->broadcast ({
            src  => $dest,
            type => 'subid',
            command => 'remove',
            ids => \@ids,
            timestamp => time (),
         });
         log_line ($irccon, $chan, "$chan remove: @nicks");
         1;
      },
      channel_change => sub {
         my ($pc, $chan, $old_nick, $new_nick) = @_;
         $chan = lc $chan;
         my $dest = to_dest_id ($irccon, $chan);
         $JS->broadcast ({
            src  => $dest,
            type => 'subid',
            command => 'change',
            old_id => to_dest_id ($irccon, $old_nick),
            new_id => to_dest_id ($irccon, $new_nick),
            timestamp => time (),
         });
         log_line ($irccon, $chan, "$chan nick change: $old_nick => $new_nick");
         1;
      },
      publicmsg => sub {
         my ($pc, $chan, $msg) = @_;
         $chan = lc $chan;
         my ($nick)   = Net::IRC3::Util::split_prefix ($msg->{prefix});
         my $dest     = to_dest_id ($irccon, $chan);
         my $nickdest = to_dest_id ($irccon, $nick);

         $JS->broadcast (my $omsg = {
            src => $dest,
            type => (uc ($msg->{command}) eq 'NOTICE' ? "notice" : "message"),
            msg_scope => "public",
            message => $msg->{trailing},
            timestamp => time (),
            to   => { nick => $pc->nick, id => to_dest_id ($irccon, $pc->nick) },
            from => { nick => $nick,     id => $nickdest },
         });
         add_chat_buffer ($omsg);
         log_line ($irccon, $chan, (uc ($msg->{command}) eq 'NOTICE' ? "{$nick}" : "<$nick>") . " $msg->{trailing}");
         1;
      },
      privatemsg => sub {
         my ($pc, $dsgnick, $msg) = @_;
         my ($nick) = Net::IRC3::Util::split_prefix ($msg->{prefix});
         my $dest   = to_dest_id ($irccon, $nick);

         $JS->broadcast (my $omsg = {
            src => $dest,
            type => "message",
            type => (uc ($msg->{command}) eq 'NOTICE' ? "notice" : "message"),
            msg_scope => "private",
            message => $msg->{trailing},
            timestamp => time (),
            to   => { nick => $pc->nick, id => to_dest_id ($irccon, $pc->nick) },
            from => { nick => $nick,     id => $dest },
         });
         add_chat_buffer ($omsg);
         log_line ($irccon, $nick, (uc ($msg->{command}) eq 'NOTICE' ? "{$nick}" : "<$nick>") . " $msg->{trailing}");

         1;
      },
      error => sub {
         my ($pc, $code, $message, @params) = @_;
         my $name = Net::IRC3::Util::rfc_code_to_name ($code);
         error_reply (undef, undef, irc_error => "$name: $message", to_dest_id ($irccon));
         log_line ($irccon, "", "$name: $message");
         1;
      },
      connect => sub {
         info_reply (undef, connected =>
            "Connected to $host:$port "
               . (defined $alias ? "(aka $alias)" : ""),
            to_dest_id ($irccon)
         );
         log_line ($irccon, "", "connected");
         1;
      },
      disconnect => sub {
         error_reply (undef, undef, disconnected =>
            "Lost connection to $host:$port "
               . (defined $alias ? "(aka $alias)" : ""),
            to_dest_id ($irccon)
         );
         log_line ($irccon, "", "disconnected");
         delete $CONNS{"$host:$port"};
         delete $ALIASES{"$host:$port"};
         1;
      }
   );

   eval {
      $pc->connect ($host, $port);
   };
   if ($@) {
      error_reply (undef, undef, connection_error =>
         "Couldn't connect to $host:$port "
         . (defined $alias ? "(aka $alias)" : "")
         . ": $@",
         to_dest_id ($irccon)
      );
      log_line ($irccon, "", "couldn't connect to $host:$port: $@");
      delete $CONNS{"$host:$port"};
      delete $ALIASES{"$host:$port"};
      return;
   }
   my ($nick, $user, $real) = @{
      $CFG->{userinfo}->{$alias || "$host:$port"}
      || $CFG->{default_userinfo}
      || []
   };
   $nick or die "No nickname in configuration given";
   $user ||= $nick;
   $real ||= $nick;
   $pc->register ($nick, $user, $real);

   for (@{$CFG->{channels}->{$alias || "$host:$port"}}) {
      $pc->send_srv (JOIN => undef => $_);
   }
}

sub update_connections {
   for (map { /^(\S+):(\d+)/ ? [$1, $2, $_] : [] } keys %CONNS) {
      my ($h, $p) = @$_;
      unless (
         grep {
            ($_->{host} eq $h) && (($_->{port} || 6667) == $p) && ($_->{connect})
         } @{$CFG->{servers}})
      {
         $CONNS{$_->[2]}->disconnect;
      }
   }

   for my $con (@{$CFG->{servers}}) {
      my ($host, $port) = ($con->{host}, $con->{port} || 6667);

      if ($con->{connect} and not $CONNS{"$host:$port"}) {
         eval {
            connect_irc ($host, $port, $con->{alias});
         };
         if ($@) {
            error_reply (undef, undef,
               connect_irc => "Couldn't connect to IRC server '$host:$port': $@",
               to_dest_id ("$host:$port"));
            log_line ("$host:$port", "", "couldn't connect to $host:$port: $@");
         }
      }
   }
}

sub info_reply {
   my ($lid, $type, $string, $infoid) = @_;

   my @source = defined $infoid ? (info_id => $infoid) : ();

   if (defined $lid) {
      $JS->send_data ($lid, { type => 'info', info_type => $type, message => $string, @source });
   } else {
      $JS->broadcast ({ type => 'info', info_type => $type, message => $string, @source });
   }
}

sub error_reply {
   my ($lid, $srcpkt, $type, $string, $errid) = @_;

   my @source = defined $errid ? (error_id => $errid) : ();

   my @id = (defined $srcpkt and defined $srcpkt->{id}) ? (id => $srcpkt->{id}) : ();

   if (defined $lid) {
      $JS->send_data ($lid, {
         timestamp => time,
         type => 'error',
         error_type => $type,
         message => $string,
         @source,
         @id
      });
   } else {
      $JS->broadcast ({
         timestamp => time,
         type => 'error',
         error_type => $type,
         message => $string,
         @source,
         @id
      });
   }
}

sub reply {
   my ($lid, $srcpkt, $type, @reply) = @_;

   my @id = (defined $srcpkt and defined $srcpkt->{id}) ? (id => $srcpkt->{id}) : ();

   if (defined $lid) {
      $JS->send_data ($lid, {
         timestamp => time,
         type => 'reply',
         reply_type => $type,
         @reply,
         @id
      });
   } else {
      $JS->broadcast ({
         timestamp => time,
         type => 'reply',
         reply_type => $type,
         @reply,
         @id
      });
   }
}

load_cfg;

my $c = AnyEvent->condvar;

$JS =
   JSONConnection->new (
      packet_cb => sub {
         my ($JS, $lid, $data) = @_;

         if ($data->{type} eq 'message') {
            my ($con, $irccon, $dest) = from_dest_id ($data->{dest});
            unless (defined $con) {
               error_reply ($lid, $data, no_connection => "No connection to ID.", $data->{dest});
               return
            }
            $con->send_srv (PRIVMSG => $data->{message} => $dest);

            $JS->broadcast (my $omsg = {
               src => $data->{dest},
               type => "message",
               msg_scope => $data->{msg_scope},
               message =>  $data->{message},
               is_echo => 1,
               timestamp => time,
               to   => { nick => $dest,      id => $data->{dest} },
               from => { nick => $con->nick, id => to_dest_id ($irccon, $con->nick) },
            });

            add_chat_buffer ($omsg);
            log_line ($irccon, $dest, "<".$con->nick."> $data->{message}");
            reply ($lid, $data, 'sent_message');

         } elsif ($data->{type} eq 'command') {
            if ($data->{command} eq 'reload') {
               my $old_cfg = $::CFG;
               eval {
                  load_cfg;
                  update_connections;
               };
               if ($@) {
                  $::CFG = $old_cfg;
                  error_reply ($lid, $data, reload_error => "error on reloading: $@");
               } else {
                  reply ($lid, $data, 'reloaded');
               }

            } elsif ($data->{command} eq 'list_connections') {
            } elsif ($data->{command} eq 'list_ids') {
            }
         } elsif ($data->{type} eq 'raw') {
            my $raw = $data->{message};
            my ($con, $irccon, $dest) = from_dest_id ($data->{dest});
            unless (defined $con) {
               error_reply ($lid, $data, no_connection => "No connection to ID.", $data->{dest});
               return
            }
            $con->send_raw ($raw);
            reply ($lid, $data, 'sent_raw_message');

         } else {
            error_reply ($lid, $data, bad_packet => "Did not understand this packet");
         }
         1
      },
      connect_cb => sub {
         my ($JS, $lid) = @_;
         $JS->send_data ($lid, { type => "hello" });
         for my $irccon (keys %CONNS) {
            for my $chan (keys %{$CONNS{$irccon}->channel_list}) {
               my $dest = to_dest_id ($irccon, lc $chan);
               $JS->send_data ($lid, {
                  src  => $dest,
                  type => 'subid',
                  command => 'list',
                  ids => [
                     map {
                        to_dest_id ($irccon, $_)
                     } keys %{$CONNS{$irccon}->channel_list ()->{$chan}}
                  ],
                  timestamp => time (),
               });
               $JS->send_data ($lid, $_) for reverse get_chat_buffer ($dest);
            }
         }
      });

update_connections;

$JS->start_listener;

$c->wait;
Revision:	1.11
Committed:	Sat Feb 17 13:01:38 2007 UTC (19 years, 7 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.10:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	removed json examples, fixed a few minor bugs and added connect/connect_error events with improved network code.
#	User	Rev	Content
1	elmex	1.7	#!/opt/perl/bin/perl
2	elmex	1.1	use strict;
3	elmex	1.5	use URI;
4	elmex	1.1	use AnyEvent::Impl::Perl;
5	elmex	1.7	use IO::Handle;
6	elmex	1.1	use JSON::Syck;
7			use JSONConnection;
8			use Net::IRC3::Client::Connection;
9	elmex	1.7	use POSIX qw/strftime/;
10	elmex	1.1	$Net::IRC3::Client::Connection::DEBUG = 1;
11
12			our $CFG;
13	elmex	1.5	our %ALIASES;
14	elmex	1.1	our %CONNS;
15
16	elmex	1.10	our %CHAT_BUFFER;
17
18	elmex	1.7	our %LOGS;
19
20	elmex	1.5	our $JS;
21
22	elmex	1.10	sub add_chat_buffer {
23			my ($data) = @_;
24			$CHAT_BUFFER{$data->{src}} \|\|= [];
25			my $buf = $CHAT_BUFFER{$data->{src}};
26			unshift @$buf, $data;
27			if (@$buf > 50) { splice @$buf, 50 }
28			}
29
30			sub get_chat_buffer {
31			my ($dest) = @_;
32			return @{$CHAT_BUFFER{$dest} \|\| []};
33			}
34
35	elmex	1.7	sub log_line {
36			my ($server, $src, $line) = @_;
37			my $logdir = $CFG->{log_dir} \|\| "$ENV{HOME}/.jsonirc_logs/";
38			my $ts = POSIX::strftime "%F %T %Z", localtime (time);
39
40			eval {
41			unless (-e $logdir) {
42			mkdir $logdir or die "Couldn't make directory '$logdir': $!";
43			}
44			my $logfile = "$logdir/${server}" . ($src ne "" ? "_$src" : "");
45			unless ($LOGS{$logfile}) {
46			open my $logfh, ">>", "$logfile"
47			or die "Couldn't open '$logfile': $!";
48			$LOGS{$logfile} = $logfh;
49			$logfh->autoflush (1);
50			$LOGS{$logfile}->print ("---- $ts ---- starting log ----\n");
51			}
52			$LOGS{$logfile}->print ("$ts: $line\n");
53			};
54			if ($@) {
55			error_reply (undef, undef, logging_error => "Couldn't log for $server $src: $@");
56			}
57			}
58
59	elmex	1.1	sub load_cfg {
60			$CFG \|\|= {};
61			return unless -e "$ENV{HOME}/.jsonircrc";
62			open CFGH, "<", "$ENV{HOME}/.jsonircrc" or die "Couldn't open ~/.jsonircrc: $!";
63			$::CFG = JSON::Syck::Load (do { local $/; <CFGH> });
64			}
65
66			sub save_cfg {
67			open CFGH, ">", "$ENV{HOME}/.jsonircrc" or die "Couldn't open for writing ~/.jsonircrc: $!";
68			print CFGH (JSON::Syck::Dump ($::CFG));
69			close CFGH;
70			}
71
72	elmex	1.3	sub to_dest_id {
73	elmex	1.5	my ($irccon, $targ) = @_;
74	elmex	1.7	$targ \|\|= '';
75	elmex	1.5	$irccon = $ALIASES{$irccon} \|\| $irccon;
76			my $uri = new URI;
77	elmex	1.9	$uri->scheme ("jsirc"); $uri->authority ($irccon); $uri->path ($targ);
78	elmex	1.5	"$uri"
79	elmex	1.3	}
80	elmex	1.5
81			sub unalias {
82			my ($id) = @_;
83			for (keys %ALIASES) {
84			if ($id eq $ALIASES{$_}) {
85			return $_;
86			}
87	elmex	1.3	}
88			}
89
90	elmex	1.5	sub lookup_connection {
91			my ($id) = @_;
92			my $alias = unalias ($id);
93			return $CONNS{$alias \|\| $id}
94			}
95	elmex	1.3
96	elmex	1.5	sub from_dest_id {
97			my ($dest_id) = @_;
98			my $uri = URI->new ($dest_id);
99			my $path = ($uri->path_segments ())[1];
100			return (lookup_connection ($uri->authority), unalias ($uri->authority) \|\| $uri->authority, $path);
101			}
102	elmex	1.1
103	elmex	1.5	sub connect_irc {
104			my ($host, $port, $alias) = @_;
105			my $irccon = "$host:$port";
106			my $pc = $CONNS{$irccon} = Net::IRC3::Client::Connection->new;
107			$ALIASES{$irccon} = $alias if defined $alias;
108	elmex	1.1
109			$pc->reg_cb (
110	elmex	1.6	channel_add => sub {
111			my ($pc, $chan, @nicks) = @_;
112	elmex	1.7	$chan = lc $chan;
113	elmex	1.6	my $dest = to_dest_id ($irccon, $chan);
114			my @ids = map { to_dest_id ($irccon, $_) } @nicks;
115			$JS->broadcast ({
116			src => $dest,
117	elmex	1.7	type => 'subid',
118			command => 'add',
119	elmex	1.6	ids => \@ids,
120			timestamp => time (),
121			});
122	elmex	1.7	log_line ($irccon, $chan, "$chan add: @nicks");
123	elmex	1.6	1;
124			},
125			channel_remove => sub {
126			my ($pc, $chan, @nicks) = @_;
127	elmex	1.7	$chan = lc $chan;
128	elmex	1.6	my $dest = to_dest_id ($irccon, $chan);
129			my @ids = map { to_dest_id ($irccon, $_) } @nicks;
130			$JS->broadcast ({
131			src => $dest,
132	elmex	1.7	type => 'subid',
133			command => 'remove',
134	elmex	1.6	ids => \@ids,
135			timestamp => time (),
136			});
137	elmex	1.7	log_line ($irccon, $chan, "$chan remove: @nicks");
138			1;
139			},
140			channel_change => sub {
141			my ($pc, $chan, $old_nick, $new_nick) = @_;
142			$chan = lc $chan;
143			my $dest = to_dest_id ($irccon, $chan);
144			$JS->broadcast ({
145			src => $dest,
146			type => 'subid',
147			command => 'change',
148			old_id => to_dest_id ($irccon, $old_nick),
149			new_id => to_dest_id ($irccon, $new_nick),
150			timestamp => time (),
151			});
152			log_line ($irccon, $chan, "$chan nick change: $old_nick => $new_nick");
153	elmex	1.6	1;
154			},
155	elmex	1.1	publicmsg => sub {
156			my ($pc, $chan, $msg) = @_;
157	elmex	1.7	$chan = lc $chan;
158	elmex	1.5	my ($nick) = Net::IRC3::Util::split_prefix ($msg->{prefix});
159			my $dest = to_dest_id ($irccon, $chan);
160			my $nickdest = to_dest_id ($irccon, $nick);
161
162	elmex	1.10	$JS->broadcast (my $omsg = {
163	elmex	1.3	src => $dest,
164	elmex	1.8	type => (uc ($msg->{command}) eq 'NOTICE' ? "notice" : "message"),
165			msg_scope => "public",
166	elmex	1.1	message => $msg->{trailing},
167	elmex	1.2	timestamp => time (),
168	elmex	1.5	to => { nick => $pc->nick, id => to_dest_id ($irccon, $pc->nick) },
169	elmex	1.4	from => { nick => $nick, id => $nickdest },
170	elmex	1.1	});
171	elmex	1.10	add_chat_buffer ($omsg);
172	elmex	1.7	log_line ($irccon, $chan, (uc ($msg->{command}) eq 'NOTICE' ? "{$nick}" : "<$nick>") . " $msg->{trailing}");
173	elmex	1.1	1;
174			},
175			privatemsg => sub {
176			my ($pc, $dsgnick, $msg) = @_;
177			my ($nick) = Net::IRC3::Util::split_prefix ($msg->{prefix});
178	elmex	1.5	my $dest = to_dest_id ($irccon, $nick);
179
180	elmex	1.10	$JS->broadcast (my $omsg = {
181	elmex	1.3	src => $dest,
182			type => "message",
183	elmex	1.8	type => (uc ($msg->{command}) eq 'NOTICE' ? "notice" : "message"),
184			msg_scope => "private",
185	elmex	1.1	message => $msg->{trailing},
186	elmex	1.2	timestamp => time (),
187	elmex	1.5	to => { nick => $pc->nick, id => to_dest_id ($irccon, $pc->nick) },
188	elmex	1.4	from => { nick => $nick, id => $dest },
189	elmex	1.1	});
190	elmex	1.10	add_chat_buffer ($omsg);
191	elmex	1.7	log_line ($irccon, $nick, (uc ($msg->{command}) eq 'NOTICE' ? "{$nick}" : "<$nick>") . " $msg->{trailing}");
192
193			1;
194			},
195			error => sub {
196			my ($pc, $code, $message, @params) = @_;
197			my $name = Net::IRC3::Util::rfc_code_to_name ($code);
198			error_reply (undef, undef, irc_error => "$name: $message", to_dest_id ($irccon));
199			log_line ($irccon, "", "$name: $message");
200	elmex	1.1	1;
201			},
202	elmex	1.5	connect => sub {
203	elmex	1.7	info_reply (undef, connected =>
204	elmex	1.5	"Connected to $host:$port "
205	elmex	1.7	. (defined $alias ? "(aka $alias)" : ""),
206			to_dest_id ($irccon)
207	elmex	1.5	);
208	elmex	1.7	log_line ($irccon, "", "connected");
209			1;
210	elmex	1.5	},
211			disconnect => sub {
212	elmex	1.7	error_reply (undef, undef, disconnected =>
213			"Lost connection to $host:$port "
214			. (defined $alias ? "(aka $alias)" : ""),
215			to_dest_id ($irccon)
216	elmex	1.5	);
217	elmex	1.7	log_line ($irccon, "", "disconnected");
218	elmex	1.5	delete $CONNS{"$host:$port"};
219			delete $ALIASES{"$host:$port"};
220	elmex	1.7	1;
221	elmex	1.5	}
222	elmex	1.1	);
223
224	elmex	1.5	eval {
225			$pc->connect ($host, $port);
226			};
227			if ($@) {
228	elmex	1.7	error_reply (undef, undef, connection_error =>
229	elmex	1.5	"Couldn't connect to $host:$port "
230			. (defined $alias ? "(aka $alias)" : "")
231	elmex	1.7	. ": $@",
232			to_dest_id ($irccon)
233	elmex	1.5	);
234	elmex	1.7	log_line ($irccon, "", "couldn't connect to $host:$port: $@");
235	elmex	1.5	delete $CONNS{"$host:$port"};
236			delete $ALIASES{"$host:$port"};
237			return;
238			}
239	elmex	1.7	my ($nick, $user, $real) = @{
240			$CFG->{userinfo}->{$alias \|\| "$host:$port"}
241			\|\| $CFG->{default_userinfo}
242			\|\| []
243			};
244			$nick or die "No nickname in configuration given";
245			$user \|\|= $nick;
246			$real \|\|= $nick;
247			$pc->register ($nick, $user, $real);
248	elmex	1.1
249	elmex	1.5	for (@{$CFG->{channels}->{$alias \|\| "$host:$port"}}) {
250			$pc->send_srv (JOIN => undef => $_);
251	elmex	1.1	}
252			}
253
254	elmex	1.5	sub update_connections {
255			for (map { /^(\S+):(\d+)/ ? [$1, $2, $_] : [] } keys %CONNS) {
256			my ($h, $p) = @$_;
257			unless (
258			grep {
259			($_->{host} eq $h) && (($_->{port} \|\| 6667) == $p) && ($_->{connect})
260			} @{$CFG->{servers}})
261			{
262			$CONNS{$_->[2]}->disconnect;
263			}
264			}
265
266			for my $con (@{$CFG->{servers}}) {
267			my ($host, $port) = ($con->{host}, $con->{port} \|\| 6667);
268
269			if ($con->{connect} and not $CONNS{"$host:$port"}) {
270	elmex	1.7	eval {
271			connect_irc ($host, $port, $con->{alias});
272			};
273			if ($@) {
274			error_reply (undef, undef,
275			connect_irc => "Couldn't connect to IRC server '$host:$port': $@",
276			to_dest_id ("$host:$port"));
277			log_line ("$host:$port", "", "couldn't connect to $host:$port: $@");
278			}
279	elmex	1.5	}
280			}
281			}
282
283			sub info_reply {
284	elmex	1.7	my ($lid, $type, $string, $infoid) = @_;
285
286			my @source = defined $infoid ? (info_id => $infoid) : ();
287
288	elmex	1.5	if (defined $lid) {
289	elmex	1.7	$JS->send_data ($lid, { type => 'info', info_type => $type, message => $string, @source });
290	elmex	1.5	} else {
291	elmex	1.7	$JS->broadcast ({ type => 'info', info_type => $type, message => $string, @source });
292	elmex	1.5	}
293			}
294
295			sub error_reply {
296	elmex	1.7	my ($lid, $srcpkt, $type, $string, $errid) = @_;
297
298			my @source = defined $errid ? (error_id => $errid) : ();
299
300			my @id = (defined $srcpkt and defined $srcpkt->{id}) ? (id => $srcpkt->{id}) : ();
301
302	elmex	1.5	if (defined $lid) {
303	elmex	1.7	$JS->send_data ($lid, {
304			timestamp => time,
305			type => 'error',
306			error_type => $type,
307			message => $string,
308			@source,
309			@id
310			});
311	elmex	1.5	} else {
312	elmex	1.7	$JS->broadcast ({
313			timestamp => time,
314			type => 'error',
315			error_type => $type,
316			message => $string,
317			@source,
318			@id
319			});
320			}
321			}
322
323			sub reply {
324			my ($lid, $srcpkt, $type, @reply) = @_;
325
326			my @id = (defined $srcpkt and defined $srcpkt->{id}) ? (id => $srcpkt->{id}) : ();
327
328			if (defined $lid) {
329			$JS->send_data ($lid, {
330			timestamp => time,
331			type => 'reply',
332			reply_type => $type,
333			@reply,
334			@id
335			});
336			} else {
337			$JS->broadcast ({
338			timestamp => time,
339			type => 'reply',
340			reply_type => $type,
341			@reply,
342			@id
343			});
344	elmex	1.5	}
345			}
346
347			load_cfg;
348
349			my $c = AnyEvent->condvar;
350
351			$JS =
352			JSONConnection->new (
353			packet_cb => sub {
354			my ($JS, $lid, $data) = @_;
355
356			if ($data->{type} eq 'message') {
357			my ($con, $irccon, $dest) = from_dest_id ($data->{dest});
358			unless (defined $con) {
359	elmex	1.7	error_reply ($lid, $data, no_connection => "No connection to ID.", $data->{dest});
360	elmex	1.5	return
361			}
362			$con->send_srv (PRIVMSG => $data->{message} => $dest);
363
364	elmex	1.10	$JS->broadcast (my $omsg = {
365	elmex	1.7	src => $data->{dest},
366			type => "message",
367	elmex	1.8	msg_scope => $data->{msg_scope},
368	elmex	1.7	message => $data->{message},
369			is_echo => 1,
370			timestamp => time,
371			to => { nick => $dest, id => $data->{dest} },
372			from => { nick => $con->nick, id => to_dest_id ($irccon, $con->nick) },
373			});
374
375	elmex	1.10	add_chat_buffer ($omsg);
376	elmex	1.7	log_line ($irccon, $dest, "<".$con->nick."> $data->{message}");
377			reply ($lid, $data, 'sent_message');
378
379	elmex	1.5	} elsif ($data->{type} eq 'command') {
380			if ($data->{command} eq 'reload') {
381	elmex	1.9	my $old_cfg = $::CFG;
382			eval {
383			load_cfg;
384			update_connections;
385			};
386			if ($@) {
387			$::CFG = $old_cfg;
388			error_reply ($lid, $data, reload_error => "error on reloading: $@");
389			} else {
390			reply ($lid, $data, 'reloaded');
391			}
392	elmex	1.7
393	elmex	1.5	} elsif ($data->{command} eq 'list_connections') {
394			} elsif ($data->{command} eq 'list_ids') {
395			}
396	elmex	1.7	} elsif ($data->{type} eq 'raw') {
397			my $raw = $data->{message};
398			my ($con, $irccon, $dest) = from_dest_id ($data->{dest});
399			unless (defined $con) {
400			error_reply ($lid, $data, no_connection => "No connection to ID.", $data->{dest});
401			return
402			}
403			$con->send_raw ($raw);
404			reply ($lid, $data, 'sent_raw_message');
405
406	elmex	1.5	} else {
407	elmex	1.7	error_reply ($lid, $data, bad_packet => "Did not understand this packet");
408	elmex	1.5	}
409			1
410			},
411			connect_cb => sub {
412			my ($JS, $lid) = @_;
413			$JS->send_data ($lid, { type => "hello" });
414	elmex	1.7	for my $irccon (keys %CONNS) {
415			for my $chan (keys %{$CONNS{$irccon}->channel_list}) {
416			my $dest = to_dest_id ($irccon, lc $chan);
417			$JS->send_data ($lid, {
418			src => $dest,
419			type => 'subid',
420			command => 'list',
421			ids => [
422			map {
423			to_dest_id ($irccon, $_)
424			} keys %{$CONNS{$irccon}->channel_list ()->{$chan}}
425			],
426			timestamp => time (),
427			});
428	elmex	1.10	$JS->send_data ($lid, $_) for reverse get_chat_buffer ($dest);
429	elmex	1.7	}
430			}
431	elmex	1.5	});
432
433			update_connections;
434
435			$JS->start_listener;
436	elmex	1.1
437			$c->wait;