#!/usr/bin/env perl # Auto IRC Bot. An advanced, lightweight and powerful IRC bot. # Copyright (C) 2010-2011 Xelhua Development Team (doc/CREDITS) # This program is free software; rights to this code are stated in doc/LICENSE. package Auto; require 5.10.0; use strict; use warnings; use POSIX; use locale; use Mouse; use IO::Socket; use Async; use FindBin qw($Bin); our $Bin = $Bin; BEGIN { unshift(@INC, "$Bin/../src"); } use API::Std qw(conf_get err); use API::Log qw(println alog dbug); #use DB::Flatfile; use Parser::Config; use Parser::Lang; use Parser::IRC; #use Sys; # Set version information. use constant { NAME => 'Auto IRC Bot', VER => 3, SVER => 0, REV => 0, RSTAGE => 'd' }; # Check for build files. unless (-e "$Bin/../build/os" and -e "$Bin/../build/perl" and -e "$Bin/../build/time" and -e "$Bin/../build/ver") { println "Missing build file(s). Please build Auto before running it." and exit; } # Check build OS. open BFOS, "<$Bin/../build/os" or println "Cannot start: Broken build." and exit; my @BFOS = ; close BFOS; if ($BFOS[0] ne $^O."\n") { println "Cannot start: Broken build." and exit; } undef @BFOS; # Check build Perl version. open BFPERL, "<$Bin/../build/perl" or println "Cannot start: Broken build." and exit; my @BFPERL = ; close BFPERL; if ($BFPERL[0] ne $]."\n") { println "Cannot start: Broken build." and exit; } undef @BFPERL; # Check build Auto version. open BFVER, "<$Bin/../build/ver" or println "Cannot start: Broken build." and exit; my @BFVER = ; close BFVER; if ($BFVER[0] ne VER.".".SVER.".".REV.RSTAGE."\n") { println "Cannot start: Broken build." and exit; } undef @BFVER; # Print startup message. println "* ".NAME." (version ".VER.".".SVER.".".REV.RSTAGE.") is starting up..."; our ($PID); # Check for debug mode. our $DEBUG = 0; if (defined $ARGV[0]) { if ($ARGV[0] eq '-d') { $DEBUG = 1; } } # Parse configuration file. println "* Parsing configuration file auto.conf..."; our $CONF = Parser::Config->new("auto.conf") or err(1, "Failed to parse configuration file!", 1); our %SETTINGS = $CONF->parse or err(1, "Failed to parse configuration file!", 1); println " Success"; # Check for required configuration values. my @REQCVALS = qw(locale expire_logs server); foreach my $REQCVAL (@REQCVALS) { if (!conf_get($REQCVAL)) { my $err = 2; if ($REQCVAL eq "expire_logs") { $err = 1; } err($err, "Missing required configuration value: $REQCVAL", 1); } } undef @REQCVALS; # Parse translations. println "* Parsing translation files..."; our $LOCALE = (conf_get("locale"))[0][0]; my @lang = split('_', $LOCALE); Parser::Lang::parse($lang[0]) or err(2, "Failed to parse translation files!", 1); undef @lang; println " Success"; # Expire old logs. API::Log::expire_logs(); # Successful startup. our $STARTTIME = time; println "* Auto successfully started at ".POSIX::strftime("%Y-%m-%d %I:%M:%S %p", localtime)."."; alog "Auto successfully started."; # Fork into the background if not in debug mode. unless ($DEBUG) { println "*** Becoming a daemon..."; open STDIN, '/dev/null' or err(2, "Can't read /dev/null: $!", 1); open STDOUT, '>>/dev/null' or err(2, "Can't write to /dev/null: $!", 1); open STDERR, '>>/dev/null' or err(2, "Can't write to /dev/null: $!", 1); $PID = fork(); unless ($PID == 0) { alog "* Successfully forked into the background. Process ID: ".$PID; unless (-e "$Bin/auto.pid") { `touch $Bin/auto.pid`; } open FPID, ">$Bin/auto.pid" or exit; print FPID "$PID\n" or exit; close FPID or exit; exit; } POSIX::setsid() or err(2, "Can't start a new session: $!", 1); } else { $PID = $$; } ## Create sockets. alog "* Connecting to servers..."; dbug "* Connecting to servers..."; # Get servers from config. my %cservers = conf_get("server"); # Set the hashes and processes hashes. my (%SOCKET, %SOCKPROC); my $it = 0; # Iterate through each configured server. foreach my $cskey (keys %cservers) { # Create the socket. $SOCKET{$cskey} = IO::Socket::INET->new( Proto => "tcp", LocalAddr => $cservers{$cskey}{'bind'}[0], PeerAddr => $cservers{$cskey}{'host'}[0], PeerPort => $cservers{$cskey}{'port'}[0] ) or err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) and next; # Or error. # Send PASS if we have one. if (defined $cservers{$cskey}{'pass'}[0]) { socksnd($cskey, "PASS :".$cservers{$cskey}{'pass'}[0]) or err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) and next; } # Send USER and NICK. socksnd($cskey, "USER ".$cservers{$cskey}{'ident'}[0]." * * :".$cservers{$cskey}{'realname'}[0]) or err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) and next; socksnd($cskey, "NICK ".$cservers{$cskey}{'nick'}[0]) or err(2, "Failed to connect to server: ".$cskey." [".$cservers{$cskey}{'host'}[0].":".$cservers{$cskey}{'port'}[0]."]", 0) and next; # Create the process. $SOCKPROC{$cskey} = Async->new(sub { # Infinite loop. while (1) { # Read data from socket. my $data = readline($SOCKET{$cskey}); # Lost connection: kill process. unless (defined $data) { die; } # Get rid of the newlines. chomp $data; # Debug. dbug "$cskey -> You: $data"; # Parse data. Parser::IRC::_parse($cskey, $data); } }) or err(2, "Failed to create process for ".$cskey, 0) and next; # Success! alog "** Successfully connected to server: ".$cskey; dbug "** Successfully connected to server: ".$cskey; $it = 1; } # Success! if ($it) { alog "** Success: Connected to server(s)."; dbug "** Success: Connected to server(s)."; } else { err(2, "No server connections.", 1); } undef $it; # Keep Auto alive. while (1) { sleep 1; } ############### # Subroutines # ############### # Send data to socket. sub socksnd { my ($svr, $data) = @_; if (defined $SOCKET{$svr}) { send($SOCKET{$svr}, $data."\n", 0); dbug "You -> $svr: $data"; return 1; } else { return 0; } }