##################################################
sub run{
- Log::Log4perl->init('/etc/fonbotd/log4perl.conf');
- chdir '/var/lib/fonbot';
- $_->init for PLUGINS;
- POE::Kernel->run
+ Log::Log4perl->init('/etc/fonbotd/log4perl.conf');
+ chdir '/var/lib/fonbot';
+ $_->init for PLUGINS;
+ POE::Kernel->run;
}
sub finish{
- $_->fini for reverse PLUGINS
+ $_->fini for reverse PLUGINS
}
1;
##################################################
sub _start{
- return unless $bitlbee_enabled;
- my $self=$_[OBJECT];
-
- $self->{irc} = POE::Component::IRC->spawn(
- Flood => 1,
- Nick => $bitlbee_nick,
- Username => $bitlbee_nick,
- Ircname => 'FonBot',
- Server => $bitlbee_server,
- Port => $bitlbee_port,
- );
- $self->{irc}->yield(register => qw/msg public/);
- $self->{irc}->yield(connect => {});
- $self->{irc}->plugin_add(Connector => POE::Component::IRC::Plugin::Connector->new);
-
- $_[KERNEL]->alias_set('BITLBEE')
+ return unless $bitlbee_enabled;
+ my $self=$_[OBJECT];
+
+ $self->{irc} = POE::Component::IRC->spawn(
+ Flood => 1,
+ Nick => $bitlbee_nick,
+ Username => $bitlbee_nick,
+ Ircname => 'FonBot',
+ Server => $bitlbee_server,
+ Port => $bitlbee_port,
+ );
+ $self->{irc}->yield(register => qw/msg public/);
+ $self->{irc}->yield(connect => {});
+ $self->{irc}->plugin_add(Connector => POE::Component::IRC::Plugin::Connector->new);
+
+ $_[KERNEL]->alias_set('BITLBEE')
}
sub irc_public{
- my ($self, $msg)=@_[OBJECT, ARG2];
- $self->{irc}->yield(privmsg => '&bitlbee', "identify $bitlbee_password") if $msg =~ /^Welcome to the BitlBee gateway!$/;
- $self->{irc}->yield(privmsg => '&bitlbee', 'yes') if $msg =~ /New request:/;
+ my ($self, $msg)=@_[OBJECT, ARG2];
+ $self->{irc}->yield(privmsg => '&bitlbee', "identify $bitlbee_password") if $msg =~ /^Welcome to the BitlBee gateway!$/;
+ $self->{irc}->yield(privmsg => '&bitlbee', 'yes') if $msg =~ /New request:/;
}
1;
my $log=Log::Log4perl->get_logger(__PACKAGE__);
sub init{
- $log->info('setting user and group');
- $)=join ' ', scalar getgrnam $group, map {scalar getgrnam $_} @supplementary_groups;
- $(=scalar getgrnam $group;
- $<=$>=scalar getpwnam $user;
- chdir $dir;
-
- $log->info('initializing '.__PACKAGE__);
- tie %ok_user_addresses, DB_File => 'ok_user_addresses.db';
- tie %commands, DB_File => 'commands.db';
+ $log->info('setting user and group');
+ $)=join ' ', scalar getgrnam $group, map {scalar getgrnam $_} @supplementary_groups;
+ $(=scalar getgrnam $group;
+ $<=$>=scalar getpwnam $user;
+ chdir $dir;
+
+ $log->info('initializing '.__PACKAGE__);
+ tie %ok_user_addresses, DB_File => 'ok_user_addresses.db';
+ tie %commands, DB_File => 'commands.db';
}
sub fini{
- $log->info('finishing '.__PACKAGE__);
- untie %ok_user_addresses;
- untie %commands;
+ $log->info('finishing '.__PACKAGE__);
+ untie %ok_user_addresses;
+ untie %commands;
}
##################################################
sub sendmsg{
- my ($touser,$requestid,$replyto,$command,@args)=@_;
-
- my $data={command=>$command, replyto=>$replyto, args => \@args };
- $data->{requestid} = $requestid if defined $requestid;
-
- if (exists $commands{$touser}) {
- my $temp = thaw $commands{$touser};
- push $temp, $data;
- $commands{$touser} = freeze $temp
- } else {
- $commands{$touser} = freeze [$data]
- }
-
- if (exists $waiting_requests{$touser}) {
- $waiting_requests{$touser}->continue;
- delete $waiting_requests{$touser}
- }
+ my ($touser,$requestid,$replyto,$command,@args)=@_;
+
+ my $data={command=>$command, replyto=>$replyto, args => \@args };
+ $data->{requestid} = $requestid if defined $requestid;
+
+ if (exists $commands{$touser}) {
+ my $temp = thaw $commands{$touser};
+ push $temp, $data;
+ $commands{$touser} = freeze $temp
+ } else {
+ $commands{$touser} = freeze [$data]
+ }
+
+ if (exists $waiting_requests{$touser}) {
+ $waiting_requests{$touser}->continue;
+ delete $waiting_requests{$touser}
+ }
}
1;
my $log=Log::Log4perl->get_logger(__PACKAGE__);
sub init{
- $log->info('reading config file');
- unless (my $ret = do '/etc/fonbotd/config.pl') {
- die "Cannot parse config file: $@" if $@;
- die "Cannot run config file: $!" unless $ret;
- }
+ $log->info('reading config file');
+ unless (my $ret = do '/etc/fonbotd/config.pl') {
+ die "Cannot parse config file: $@" if $@;
+ die "Cannot run config file: $!" unless $ret;
+ }
}
sub fini{
- #no-op
+ #no-op
}
1;
=head1 SYNOPSIS
- use App::FonBot::Plugin::Config qw/$oftc_enabled $oftc_nick @oftc_channels $oftc_nickserv_password $bitlbee_enabled $bitlbee_nick $bitlbee_server $bitlbee_port $bitlbee_password $user $group @supplementary_groups $httpd_port/;
- App::FonBot::Plugin::Config->init;
-
- # Variables used in App::FonBot:Plugin::OFTC
- say "The OFTC plugin is ".($oftc_enabled ? 'enabled' : 'disabled');
- say "The OFTC NickServ password is $oftc_nickserv_password";
- say "The OFTC nickname is $oftc_nick";
- say "The OFTC channels are @oftc_channels";
-
- # Variables used in App::FonBot::Plugin::BitlBee
- say "The BitlBee plugin is ".($bitlbee_enabled ? 'enabled' : 'disabled');
- say "The BitlBee server runs on port $bitlbee_port of host $bitlbee_server"
- say "The BitlBee nickname is $bitlbee_nick";
- say "The BitlBee password is $bitlbee_password";
-
- # Variables used in App::FonBot::Plugin::Common
- say "The storage directory is $dir";
- say "The user is $user";
- say "The primary group is $group";
- say "The supplementary groups are @supplementary_groups";
-
- # Variables used in App::FonBot::Plugin::HTTPD
- say "The HTTPD listens on port $httpd_port"
+ use App::FonBot::Plugin::Config qw/$oftc_enabled $oftc_nick @oftc_channels $oftc_nickserv_password $bitlbee_enabled $bitlbee_nick $bitlbee_server $bitlbee_port $bitlbee_password $user $group @supplementary_groups $httpd_port/;
+ App::FonBot::Plugin::Config->init;
+
+ # Variables used in App::FonBot:Plugin::OFTC
+ say "The OFTC plugin is ".($oftc_enabled ? 'enabled' : 'disabled');
+ say "The OFTC NickServ password is $oftc_nickserv_password";
+ say "The OFTC nickname is $oftc_nick";
+ say "The OFTC channels are @oftc_channels";
+
+ # Variables used in App::FonBot::Plugin::BitlBee
+ say "The BitlBee plugin is ".($bitlbee_enabled ? 'enabled' : 'disabled');
+ say "The BitlBee server runs on port $bitlbee_port of host $bitlbee_server"
+ say "The BitlBee nickname is $bitlbee_nick";
+ say "The BitlBee password is $bitlbee_password";
+
+ # Variables used in App::FonBot::Plugin::Common
+ say "The storage directory is $dir";
+ say "The user is $user";
+ say "The primary group is $group";
+ say "The supplementary groups are @supplementary_groups";
+
+ # Variables used in App::FonBot::Plugin::HTTPD
+ say "The HTTPD listens on port $httpd_port"
=head1 DESCRIPTION
my %responses;
sub init{
- $log->info('initializing '.__PACKAGE__);
- %waiting_requests = ();
- %waiting_userrequests = ();
- $httpd = POE::Component::Server::HTTP->new(
- Port => 8888,
- PreHandler => { '/' => [\&pre_auth, \&pre_get, \&pre_userget], },
- ContentHandler =>{ '/send' => \&on_send, '/get' => \&on_get, '/ok' => \&on_ok, '/userget' => \&on_userget, '/usersend' => \&on_usersend },
- ErrorHandler => { '/' => sub { RC_OK }},
- Headers => { 'Cache-Control' => 'no-cache' },
+ $log->info('initializing '.__PACKAGE__);
+ %waiting_requests = ();
+ %waiting_userrequests = ();
+ $httpd = POE::Component::Server::HTTP->new(
+ Port => 8888,
+ PreHandler => { '/' => [\&pre_auth, \&pre_get, \&pre_userget], },
+ ContentHandler =>{ '/send' => \&on_send, '/get' => \&on_get, '/ok' => \&on_ok, '/userget' => \&on_userget, '/usersend' => \&on_usersend },
+ ErrorHandler => { '/' => sub { RC_OK }},
+ Headers => { 'Cache-Control' => 'no-cache' },
);
}
sub fini{
- $log->info('finishing '.__PACKAGE__);
- POE::Kernel->call($httpd, 'shutdown');
+ $log->info('finishing '.__PACKAGE__);
+ POE::Kernel->call($httpd, 'shutdown');
}
##################################################
sub httpdie (\$$;$){
- my ($response,$errstr,$errcode)=@_;
+ my ($response,$errstr,$errcode)=@_;
- $$response->code($errcode // HTTP_BAD_REQUEST);
- $$response->header(Content_Type => 'text/plain');
- $$response->message($errstr);
+ $$response->code($errcode // HTTP_BAD_REQUEST);
+ $$response->header(Content_Type => 'text/plain');
+ $$response->message($errstr);
- die 'Bad Request';
+ die 'Bad Request';
}
sub pre_auth{
- my ($request, $response)=@_;
-
- eval {
- my $authorization=$request->header('Authorization') // die 'No Authorization header';
- $authorization =~ /^Basic (.+)$/ or die 'Invalid Authorization header';
- my ($user, $password) = decode_base64($1) =~ /^(.+):(.*)$/ or die 'Invalid Authorization header';
- eval { pwcheck $user, $password; 1 } or die 'Invalid user/password combination';
- $request->header(Username => $user);
- $log->debug("HTTP request from $user to url ".$request->url);
- };
- if (my $error = $@) {
- $response->code(HTTP_UNAUTHORIZED);
- $response->message('Bad username or password');
- $response->header(Content_Type => 'text/plain');
- $response->header(WWW_Authenticate => 'Basic realm="fonbotd"');
- $response->content('Unauthorized');
- $log->debug("Request denied: $error");
- return RC_DENY
- }
-
- $response->content('');
- RC_OK
+ my ($request, $response)=@_;
+
+ eval {
+ my $authorization=$request->header('Authorization') // die 'No Authorization header';
+ $authorization =~ /^Basic (.+)$/ or die 'Invalid Authorization header';
+ my ($user, $password) = decode_base64($1) =~ /^(.+):(.*)$/ or die 'Invalid Authorization header';
+ eval { pwcheck $user, $password; 1 } or die 'Invalid user/password combination';
+ $request->header(Username => $user);
+ $log->debug("HTTP request from $user to url ".$request->url);
+ };
+ if (my $error = $@) {
+ $response->code(HTTP_UNAUTHORIZED);
+ $response->message('Bad username or password');
+ $response->header(Content_Type => 'text/plain');
+ $response->header(WWW_Authenticate => 'Basic realm="fonbotd"');
+ $response->content('Unauthorized');
+ $log->debug("Request denied: $error");
+ return RC_DENY
+ }
+
+ $response->content('');
+ RC_OK
}
sub pre_get{
- my ($request, $response)=@_;
- my $user=$request->header('Username');
- return RC_OK if $response->code;
- return RC_OK unless $user;
- return RC_OK unless $request->uri =~ m,/get,;
-
- unless (exists $commands{$user}) {
- $log->debug("No pending commands for $user, entering RC_WAIT");
- $waiting_requests{$user}->continue if exists $waiting_requests{$user};
- $waiting_requests{$user}=$response;
- return RC_WAIT
- }
-
- RC_OK
+ my ($request, $response)=@_;
+ my $user=$request->header('Username');
+ return RC_OK if $response->code;
+ return RC_OK unless $user;
+ return RC_OK unless $request->uri =~ m,/get,;
+
+ unless (exists $commands{$user}) {
+ $log->debug("No pending commands for $user, entering RC_WAIT");
+ $waiting_requests{$user}->continue if exists $waiting_requests{$user};
+ $waiting_requests{$user}=$response;
+ return RC_WAIT
+ }
+
+ RC_OK
}
sub pre_userget{
- my ($request, $response)=@_;
- my $user=$request->header('Username');
- return RC_OK if $response->code;
- return RC_OK unless $user;
- return RC_OK unless $request->uri =~ m,/userget,;
-
- unless (exists $responses{$user}) {
- $log->debug("No pending responses for $user, entering RC_WAIT");
- $waiting_userrequests{$user}->continue if exists $waiting_userrequests{$user};
- $waiting_userrequests{$user}=$response;
- return RC_WAIT
- }
-
- RC_OK
+ my ($request, $response)=@_;
+ my $user=$request->header('Username');
+ return RC_OK if $response->code;
+ return RC_OK unless $user;
+ return RC_OK unless $request->uri =~ m,/userget,;
+
+ unless (exists $responses{$user}) {
+ $log->debug("No pending responses for $user, entering RC_WAIT");
+ $waiting_userrequests{$user}->continue if exists $waiting_userrequests{$user};
+ $waiting_userrequests{$user}=$response;
+ return RC_WAIT
+ }
+
+ RC_OK
}
sub on_ok{
- my ($request, $response)=@_;
- return RC_OK if $response->code;
+ my ($request, $response)=@_;
+ return RC_OK if $response->code;
- $response->code(HTTP_OK);
- RC_OK
+ $response->code(HTTP_OK);
+ RC_OK
}
sub on_get{
- my ($request, $response)=@_;
- return RC_OK if $response->code;
-
- eval {
- my $user=$request->header('Username');
- $log->debug("on_get from user $user");
-
- if (exists $commands{$user}) {
- my $json=encode_json thaw $commands{$user};
- $log->debug("Sending JSON: $json to $user");
- $response->content($json);
- $response->code(HTTP_OK);
- $response->message('Commands sent');
- } else {
- $log->debug("Sending back 204 No Content");
- $response->code(HTTP_NO_CONTENT);
- $response->message('No pending commands');
- }
-
- delete $commands{$user}
- };
-
- $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
-
- RC_OK
+ my ($request, $response)=@_;
+ return RC_OK if $response->code;
+
+ eval {
+ my $user=$request->header('Username');
+ $log->debug("on_get from user $user");
+
+ if (exists $commands{$user}) {
+ my $json=encode_json thaw $commands{$user};
+ $log->debug("Sending JSON: $json to $user");
+ $response->content($json);
+ $response->code(HTTP_OK);
+ $response->message('Commands sent');
+ } else {
+ $log->debug("Sending back 204 No Content");
+ $response->code(HTTP_NO_CONTENT);
+ $response->message('No pending commands');
+ }
+
+ delete $commands{$user}
+ };
+
+ $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
+
+ RC_OK
}
sub on_userget{
- my ($request, $response)=@_;
- return RC_OK if $response->code;
-
- eval {
- my $user=$request->header('Username');
- $log->debug("on_userget from user $user");
-
- if (exists $responses{$user}) {
- my $json=encode_json $responses{$user};
- $log->debug("Sending JSON: $json to $user");
- $response->content($json);
- $response->code(HTTP_OK);
- $response->message('Responses sent');
- } else {
- $log->debug("Sending back 204 No Content");
- $response->code(HTTP_NO_CONTENT);
- $response->message('No pending responses');
- }
-
- delete $responses{$user}
- };
-
- $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
-
- RC_OK
+ my ($request, $response)=@_;
+ return RC_OK if $response->code;
+
+ eval {
+ my $user=$request->header('Username');
+ $log->debug("on_userget from user $user");
+
+ if (exists $responses{$user}) {
+ my $json=encode_json $responses{$user};
+ $log->debug("Sending JSON: $json to $user");
+ $response->content($json);
+ $response->code(HTTP_OK);
+ $response->message('Responses sent');
+ } else {
+ $log->debug("Sending back 204 No Content");
+ $response->code(HTTP_NO_CONTENT);
+ $response->message('No pending responses');
+ }
+
+ delete $responses{$user}
+ };
+
+ $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
+
+ RC_OK
}
sub on_send{
- my ($request, $response)=@_;
- return RC_OK if $response->code;
-
- eval {
- httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
- my $user=$request->header('Username');
-
- my $destination=$request->header('X-Destination') // httpdie $response, 'Missing destination address';
- my ($driver, $address)=shellwords $destination;
-
- my $content=$request->content // httpdie $response, 'Content is undef';
-
- if ($driver eq 'HTTP') {
- $responses{$user}//=[];
- push $responses{$user}, $content;
- if (exists $waiting_userrequests{$user}) {
- $waiting_userrequests{$user}->continue;
- delete $waiting_userrequests{$user}
- }
- } else {
- unless ($ok_user_addresses{"$user $driver $address"}) {
- $response->code(HTTP_FORBIDDEN);
- $response->message("$user is not allowed to send messages to $address");
- return
- }
-
- POE::Kernel->post($driver, 'send_message', $address, $content) or $log->error("Driver not found: $driver");
- }
-
- $response->code(HTTP_NO_CONTENT);
- $response->message('Message sent');
- };
-
- $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
- $log->debug('Responding to send from $user with '.$response->code.' '.$response->message);
- RC_OK
+ my ($request, $response)=@_;
+ return RC_OK if $response->code;
+
+ eval {
+ httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
+ my $user=$request->header('Username');
+
+ my $destination=$request->header('X-Destination') // httpdie $response, 'Missing destination address';
+ my ($driver, $address)=shellwords $destination;
+
+ my $content=$request->content // httpdie $response, 'Content is undef';
+
+ if ($driver eq 'HTTP') {
+ $responses{$user}//=[];
+ push $responses{$user}, $content;
+ if (exists $waiting_userrequests{$user}) {
+ $waiting_userrequests{$user}->continue;
+ delete $waiting_userrequests{$user}
+ }
+ } else {
+ unless ($ok_user_addresses{"$user $driver $address"}) {
+ $response->code(HTTP_FORBIDDEN);
+ $response->message("$user is not allowed to send messages to $address");
+ return
+ }
+
+ POE::Kernel->post($driver, 'send_message', $address, $content) or $log->error("Driver not found: $driver");
+ }
+
+ $response->code(HTTP_NO_CONTENT);
+ $response->message('Message sent');
+ };
+
+ $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
+ $log->debug('Responding to send from $user with '.$response->code.' '.$response->message);
+ RC_OK
}
sub on_usersend{
- my ($request, $response)=@_;
- $log->debug("asdasd asd");
- return RC_OK if $response->code;
+ my ($request, $response)=@_;
+ $log->debug("asdasd asd");
+ return RC_OK if $response->code;
- eval{
- httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
- my $user=$request->header('Username');
+ eval{
+ httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
+ my $user=$request->header('Username');
- my $content=$request->content // httpdie $response, 'Content is undef';
+ my $content=$request->content // httpdie $response, 'Content is undef';
- sendmsg $user, $request->header('X-Requestid'), HTTP => shellwords $_ for split '\n', $content;
+ sendmsg $user, $request->header('X-Requestid'), HTTP => shellwords $_ for split '\n', $content;
- $response->code(HTTP_NO_CONTENT);
- $response->message('Command sent');
- };
+ $response->code(HTTP_NO_CONTENT);
+ $response->message('Command sent');
+ };
- $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
- $log->debug('Responding to usersend from $user with '.$response->code.' '.$response->message);
- RC_OK
+ $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
+ $log->debug('Responding to usersend from $user with '.$response->code.' '.$response->message);
+ RC_OK
}
-1
-
+1;
__END__
=encoding utf-8
my %selves;
sub init{
- my ($ns)=@_;
+ my ($ns)=@_;
- my $self=$ns->new;
- $self->{log}->info("initializing $ns");
- tie my %nick_to_username, DB_File => "nick_to_username-$ns.db";
- $self->{nick_to_username}=\%nick_to_username;
- $selves{$ns}=$self
+ my $self=$ns->new;
+ $self->{log}->info("initializing $ns");
+ tie my %nick_to_username, DB_File => "nick_to_username-$ns.db";
+ $self->{nick_to_username}=\%nick_to_username;
+ $selves{$ns}=$self
}
sub fini{
- my ($ns)=@_;
+ my ($ns)=@_;
- $selves{$ns}->{log}->info("finishing $ns");
- $selves{$ns}->{irc}->yield(shutdown => "finishing $ns") if defined $selves{$ns}->{irc};
- untie $selves{$ns}->{nick_to_username};
- POE::Kernel->post($selves{$ns}->{session} => 'shutdown');
- delete $selves{$ns}
+ $selves{$ns}->{log}->info("finishing $ns");
+ $selves{$ns}->{irc}->yield(shutdown => "finishing $ns") if defined $selves{$ns}->{irc};
+ untie $selves{$ns}->{nick_to_username};
+ POE::Kernel->post($selves{$ns}->{session} => 'shutdown');
+ delete $selves{$ns}
}
##################################################
sub new{
- my ($ns)=@_;
+ my ($ns)=@_;
- my $self = {
- prefix => {},
- log => Log::Log4perl->get_logger($ns),
- };
+ my $self = {
+ prefix => {},
+ log => Log::Log4perl->get_logger($ns),
+ };
- bless $self, $ns;
+ bless $self, $ns;
- $self->{session} = POE::Session->create(
- object_states => [ $self => [ '_start', 'send_message', 'irc_001', 'irc_msg', 'irc_public', 'shutdown' ] ],
- );
+ $self->{session} = POE::Session->create(
+ object_states => [ $self => [ '_start', 'send_message', 'irc_001', 'irc_msg', 'irc_public', 'shutdown' ] ],
+ );
- $self
+ $self
}
sub irc_msg{
- my ($from, $msg, $self)=@_[ARG0,ARG2,OBJECT];
- my $nick=parse_user $from;
+ my ($from, $msg, $self)=@_[ARG0,ARG2,OBJECT];
+ my $nick=parse_user $from;
- my $username=$self->{nick_to_username}{$from};
- my $address=$_[KERNEL]->alias_list;
- $address.=" $nick";
+ my $username=$self->{nick_to_username}{$from};
+ my $address=$_[KERNEL]->alias_list;
+ $address.=" $nick";
- chomp $msg;
- my @args=shellwords $msg;
- my $cmd=shift @args;
+ chomp $msg;
+ my @args=shellwords $msg;
+ my $cmd=shift @args;
- given($cmd){
- when(/^myid$/i){
- $self->{irc}->yield(privmsg => $nick, $from);
- }
+ given($cmd){
+ when(/^myid$/i){
+ $self->{irc}->yield(privmsg => $nick, $from);
+ }
- when(/^login$/i) {
- my ($user, $pass) = @args;
+ when(/^login$/i) {
+ my ($user, $pass) = @args;
- eval { pwcheck $user, $pass };
+ eval { pwcheck $user, $pass };
- if ($@) {
- $self->{log}->debug("Login for $user failed");
- $self->{irc}->yield(privmsg => $nick, 'Bad username/password combination');
- } else {
- $self->{log}->debug("Login for $user succeded");
- $self->{nick_to_username}{$from} = $user;
- $self->{irc}->yield(privmsg => $nick, "Logged in as $user");
- }
- }
+ if ($@) {
+ $self->{log}->debug("Login for $user failed");
+ $self->{irc}->yield(privmsg => $nick, 'Bad username/password combination');
+ } else {
+ $self->{log}->debug("Login for $user succeded");
+ $self->{nick_to_username}{$from} = $user;
+ $self->{irc}->yield(privmsg => $nick, "Logged in as $user");
+ }
+ }
- when(/^logout$/i){
- delete $self->{nick_to_username}{$from};
- }
+ when(/^logout$/i){
+ delete $self->{nick_to_username}{$from};
+ }
- when(/^prefix$/i){
- if (defined $username) {
- $self->{prefix}{$username} = [@args];
- } else {
- $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
- }
- }
-
- when(/^noprefix$/i){
- if (defined $username) {
- delete $self->{prefix}{$username}
- } else {
- $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
- }
- }
-
- default {
- if (defined $username) {
- $ok_user_addresses{"$username $address"}=1;
- $self->{log}->debug("Command $cmd @args from $username");
- if (exists $self->{prefix}{$username}) {
- sendmsg $username, undef, $address, @{$self->{prefix}{$username}}, $cmd, @args;
- } else {
- sendmsg $username, undef, $address, $cmd, @args;
+ when(/^prefix$/i){
+ if (defined $username) {
+ $self->{prefix}{$username} = [@args];
+ } else {
+ $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
+ }
}
- } else {
- $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
- }
- }
- }
+ when(/^noprefix$/i){
+ if (defined $username) {
+ delete $self->{prefix}{$username}
+ } else {
+ $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
+ }
+ }
+
+ default {
+ if (defined $username) {
+ $ok_user_addresses{"$username $address"}=1;
+ $self->{log}->debug("Command $cmd @args from $username");
+ if (exists $self->{prefix}{$username}) {
+ sendmsg $username, undef, $address, @{$self->{prefix}{$username}}, $cmd, @args;
+ } else {
+ sendmsg $username, undef, $address, $cmd, @args;
+ }
+ } else {
+ $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
+ }
+ }
+
+ }
}
sub irc_public{
- # Do nothing
+ # Do nothing
}
sub irc_001{
- # Do nothing
+ # Do nothing
}
sub send_message{
- my ($self, $address, $content)=@_[OBJECT, ARG0, ARG1];
- $self->{irc}->yield(privmsg => $address, $_) for map {unpack '(A400)*'} split "\n", $content
+ my ($self, $address, $content)=@_[OBJECT, ARG0, ARG1];
+ $self->{irc}->yield(privmsg => $address, $_) for map {unpack '(A400)*'} split "\n", $content
}
sub shutdown{
- $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list;
+ $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list;
}
sub _start { ... }
##################################################
sub _start{
- return unless $oftc_enabled;
- my $self=$_[OBJECT];
-
- $self->{irc} = POE::Component::IRC->spawn(
- Nick => $oftc_nick,
- Username => $oftc_nick,
- Ircname => 'FonBot OFTC Transport',
- Server => 'irc.oftc.net',
- Port => 6697,
- UseSSL => 1,
- );
- $self->{irc}->yield(register => qw/msg/);
- $self->{irc}->yield(connect => {});
-
- $self->{irc}->plugin_add(Connector => POE::Component::IRC::Plugin::Connector->new);
- $self->{irc}->plugin_add(AutoJoin => POE::Component::IRC::Plugin::AutoJoin->new(
- Channels => \@oftc_channels
- ));
-
- $self->{irc}->plugin_add(NickServID => POE::Component::IRC::Plugin::NickServID->new(
- Password => $oftc_nickserv_password
- ));
-
- $_[KERNEL]->alias_set('OFTC');
+ return unless $oftc_enabled;
+ my $self=$_[OBJECT];
+
+ $self->{irc} = POE::Component::IRC->spawn(
+ Nick => $oftc_nick,
+ Username => $oftc_nick,
+ Ircname => 'FonBot OFTC Transport',
+ Server => 'irc.oftc.net',
+ Port => 6697,
+ UseSSL => 1,
+ );
+ $self->{irc}->yield(register => qw/msg/);
+ $self->{irc}->yield(connect => {});
+
+ $self->{irc}->plugin_add(Connector => POE::Component::IRC::Plugin::Connector->new);
+ $self->{irc}->plugin_add(AutoJoin => POE::Component::IRC::Plugin::AutoJoin->new(
+ Channels => \@oftc_channels
+ ));
+
+ $self->{irc}->plugin_add(NickServID => POE::Component::IRC::Plugin::NickServID->new(
+ Password => $oftc_nickserv_password
+ ));
+
+ $_[KERNEL]->alias_set('OFTC');
}
1;
projects / app-fonbot-daemon.git / commitdiff