2023-09-05 19:46:15 +02:00
# irclogger_web
2023-09-05 10:04:47 +02:00
# Copyright (C) 2023 mrkubax10 <mrkubax10@onet.pl>
# This program is free software: you can redistribute it and/or modify
2023-09-11 18:55:32 +02:00
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
2023-09-05 10:04:47 +02:00
# 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
2023-09-11 18:55:32 +02:00
# GNU Affero General Public License for more details.
2023-09-05 10:04:47 +02:00
2023-09-11 18:55:32 +02:00
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
2023-09-05 10:04:47 +02:00
2023-09-12 10:19:46 +02:00
package logger ;
2023-09-05 10:04:47 +02:00
use IO::Socket ;
use List::Util ;
use Time::Piece ;
use File::Path ;
use threads ;
use lib "." ;
use configuration ;
use feature qw( switch ) ;
use strict ;
use warnings ;
sub connectToServer {
my $ aServer = $ _ [ 0 ] ;
my $ aPort = $ _ [ 1 ] ;
my $ aServerName = $ _ [ 2 ] ;
my $ socket = new IO::Socket:: INET ( PeerAddr = > $ aServer , PeerPort = > $ aPort , Proto = > "tcp" ) ;
$ socket - > send ( sprintf ( "PASS %s\r\n" , $ configuration:: botPassword ) ) ;
$ socket - > send ( sprintf ( "NICK %s\r\n" , $ configuration:: botNick ) ) ;
$ socket - > send ( sprintf ( "USER %s %s %s :%s\r\n" , $ configuration:: botUsername , $ configuration:: botHostname , $ aServerName , $ configuration:: botName ) ) ;
return $ socket ;
}
sub stripPrefix {
my $ aLine = $ _ [ 0 ] ;
my $ inPrefix = 0 ;
my $ prefix = "" ;
my $ line = "" ;
foreach my $ i ( 0 .. length ( $ aLine ) - 1 ) {
my $ char = substr ( $ aLine , $ i , 1 ) ;
if ( $ char eq ":" && ( $ i == 0 || $ inPrefix ) ) {
$ inPrefix = ! $ inPrefix ;
next ;
}
if ( $ inPrefix ) {
$ prefix . = $ char ;
next ;
}
if ( $ char ne "\r" && $ char ne "\n" ) {
$ line . = $ char ;
}
}
return ( $ prefix , $ line ) ;
}
sub parseIRCCommand {
my $ aCommand = $ _ [ 0 ] ;
my @ output ;
my $ inPrefix = 0 ;
my $ inLongArg = 0 ;
my $ currentString = "" ;
my $ prefix = "" ;
foreach my $ i ( 0 .. length ( $ aCommand ) - 1 ) {
my $ char = substr ( $ aCommand , $ i , 1 ) ;
if ( $ char eq "\r" || $ char eq "\n" ) {
next ;
}
if ( $ char eq ":" && $ i == 0 ) {
$ inPrefix = 1 ;
next ;
}
if ( $ char eq " " && $ inPrefix ) {
$ inPrefix = 0 ;
next ;
}
if ( $ inPrefix ) {
$ prefix . = $ char ;
next ;
}
if ( $ char eq ":" && ! $ inLongArg ) {
$ inLongArg = 1 ;
next ;
}
if ( $ inLongArg ) {
$ currentString . = $ char ;
next ;
}
if ( $ char eq " " && length ( $ currentString ) > 0 ) {
push ( @ output , $ currentString ) ;
$ currentString = "" ;
next ;
}
$ currentString . = $ char ;
}
if ( length ( $ currentString ) > 0 ) {
push ( @ output , $ currentString ) ;
}
if ( length ( $ prefix ) > 0 ) {
push ( @ output , $ prefix ) ;
}
return @ output ;
}
sub getUsernameFromHost {
my $ aHost = $ _ [ 0 ] ;
my $ output = "" ;
foreach my $ i ( 0 .. length ( $ aHost ) - 1 ) {
my $ char = substr ( $ aHost , $ i , 1 ) ;
if ( $ char eq "!" ) {
last ;
}
$ output . = $ char ;
}
return $ output ;
}
sub prepareLogFile {
my $ aLogFiles = $ _ [ 0 ] ;
my $ aServerName = $ _ [ 1 ] ;
my $ aChannelName = $ _ [ 2 ] ;
if ( ! exists ( $ aLogFiles - > { $ aChannelName } ) ) {
my $ outputFileFolder = $ configuration:: logFolder . "/" . $ aServerName . "/" . $ aChannelName ;
if ( ! ( - e $ outputFileFolder ) ) {
File::Path:: make_path ( $ outputFileFolder ) ;
}
my $ outputFilePath = $ outputFileFolder . "/" . localtime - > dmy ( "-" ) . ".txt" ;
open ( my $ file , ">>" , $ outputFilePath ) ;
if ( $ file ) {
printf ( ":: Logger -> Outputting channel '%s' at '%s' to '%s'\n" , $ aChannelName , $ aServerName , $ outputFilePath ) ;
$ aLogFiles - > { $ aChannelName } = $ file ;
}
else {
print ( ":: Logger -> Failed to open '$outputFilePath' for writing\n" ) ;
return 0 ;
}
}
return 1 ;
}
sub handlePing {
my $ aStream = $ _ [ 0 ] ;
my $ aCommand = $ _ [ 1 ] ;
my $ aCommandLength = scalar ( @$ aCommand ) ;
if ( $ aCommandLength != 2 ) {
printf ( "Encountered invalid PING command (2 arguments expected, %d provided)\n" , $ aCommandLength ) ;
return ;
}
printf ( ":: Response -> PONG :%s\n" , $ aCommand - > [ 1 ] ) ;
$ aStream - > send ( sprintf ( "PONG :%s\r\n" , $ aCommand - > [ 1 ] ) ) ;
}
sub handlePrivMsg {
my $ aStream = $ _ [ 0 ] ;
my $ aCommand = $ _ [ 1 ] ;
my $ aServerName = $ _ [ 2 ] ;
my $ aJoinedChannels = $ _ [ 3 ] ;
my $ aLogFiles = $ _ [ 4 ] ;
my $ aCommandLength = scalar ( @$ aCommand ) ;
if ( $ aCommandLength != 4 ) {
printf ( "Encountered invalid PRIVMSG command (4 arguments expected, %d provided)\n" , $ aCommandLength ) ;
return ;
}
if ( ! prepareLogFile ( $ aLogFiles , $ aServerName , $ aCommand - > [ 1 ] ) ) {
return ;
}
$ aLogFiles - > { $ aCommand - > [ 1 ] } - > print ( sprintf ( "(%s) %s: %s\n" , localtime - > strftime ( "%H:%M:%S" ) , getUsernameFromHost ( $ aCommand - > [ 3 ] ) , $ aCommand - > [ 2 ] ) ) ;
$ aLogFiles - > { $ aCommand - > [ 1 ] } - > flush ( ) ;
}
sub handleJoin {
my $ aCommand = $ _ [ 0 ] ;
my $ aServerName = $ _ [ 1 ] ;
my $ aLogFiles = $ _ [ 2 ] ;
my $ aCommandLength = scalar ( @$ aCommand ) ;
if ( $ aCommandLength != 3 ) {
printf ( "Encountered invalid JOIN command (3 arguments expected, %d provided)\n" , $ aCommandLength ) ;
return ;
}
if ( ! prepareLogFile ( $ aLogFiles , $ aServerName , $ aCommand - > [ 1 ] ) ) {
return ;
}
$ aLogFiles - > { $ aCommand - > [ 1 ] } - > print ( sprintf ( "(%s) %s has joined %s\n" , localtime - > strftime ( "%H:%M:%S" ) , getUsernameFromHost ( $ aCommand - > [ 2 ] ) , $ aCommand - > [ 1 ] ) ) ;
$ aLogFiles - > { $ aCommand - > [ 1 ] } - > flush ( ) ;
}
sub handleQuit {
my $ aCommand = $ _ [ 0 ] ;
my $ aServerName = $ _ [ 1 ] ;
my $ aJoinedChannels = $ _ [ 2 ] ;
my $ aLogFiles = $ _ [ 3 ] ;
my $ aCommandLength = scalar ( @$ aCommand ) ;
if ( $ aCommandLength != 3 && $ aCommandLength != 2 ) {
print ( "Encountered invalid QUIT command (3 or 2 arguments expected, $aCommandLength provided)\n" ) ;
return ;
}
my $ reason = "" ;
if ( $ aCommandLength == 3 ) {
$ reason = $ aCommand - > [ 1 ] ;
}
foreach my $ channel ( @$ aJoinedChannels ) {
if ( ! prepareLogFile ( $ aLogFiles , $ aServerName , $ channel ) ) {
next ;
}
$ aLogFiles - > { $ channel } - > print ( sprintf ( "(%s) %s has quit (%s)\n" , localtime - > strftime ( "%H:%M:%S" ) , getUsernameFromHost ( $ aCommand - > [ 2 ] ) , $ reason ) ) ;
$ aLogFiles - > { $ channel } - > flush ( ) ;
}
}
sub handlePart {
my $ aCommand = $ _ [ 0 ] ;
my $ aServerName = $ _ [ 1 ] ;
my $ aLogFiles = $ _ [ 2 ] ;
my $ aCommandLength = scalar ( @$ aCommand ) ;
if ( $ aCommandLength != 3 ) {
print ( "Encountered invalid PART command (3 arguments expected, $aCommandLength provided)\n" ) ;
return ;
}
if ( ! prepareLogFile ( $ aLogFiles , $ aServerName , $ aCommand - > [ 1 ] ) ) {
return ;
}
$ aLogFiles - > { $ aCommand - > [ 1 ] } - > print ( sprintf ( "(%s) %s has left %s\n" , localtime - > strftime ( "%H:%M:%S" ) , getUsernameFromHost ( $ aCommand - > [ 2 ] ) , $ aCommand - > [ 1 ] ) ) ;
$ aLogFiles - > { $ aCommand - > [ 1 ] } - > flush ( ) ;
}
sub joinChannel {
my $ aStream = $ _ [ 0 ] ;
my $ aChannel = $ _ [ 1 ] ;
$ aStream - > send ( sprintf ( "JOIN %s\r\n" , $ aChannel ) ) ;
}
sub joinChannels {
my $ aStream = $ _ [ 0 ] ;
my $ aChannels = $ _ [ 1 ] ;
foreach my $ channel ( @$ aChannels ) {
joinChannel ( $ aStream , $ channel ) ;
}
}
sub connectionWorker {
my $ aHost = $ _ [ 0 ] ;
my $ aPort = $ _ [ 1 ] ;
my $ aServerName = $ _ [ 2 ] ;
my $ aChannels = $ _ [ 3 ] ;
2023-09-12 10:19:46 +02:00
my $ aConnection = $ _ [ 4 ] ;
2023-09-05 10:04:47 +02:00
my % logFiles ;
my $ stream = connectToServer ( $ aHost , $ aPort , $ aServerName ) ;
2023-09-12 10:19:46 +02:00
while ( ! eof ( $ stream ) && $ aConnection - > [ 1 ] ) {
2023-09-05 10:04:47 +02:00
my $ line = readline ( $ stream ) ;
my @ command = parseIRCCommand ( $ line ) ;
printf ( ":: Server -> %s" , $ line ) ;
given ( $ command [ 0 ] ) {
when ( "PING" ) { handlePing ( $ stream , \ @ command ) ; }
when ( "PRIVMSG" ) { handlePrivMsg ( $ stream , \ @ command , $ aServerName , $ aChannels , \ % logFiles ) ; }
when ( "JOIN" ) { handleJoin ( \ @ command , $ aServerName , \ % logFiles ) ; }
when ( "QUIT" ) { handleQuit ( \ @ command , $ aServerName , $ aChannels , \ % logFiles ) ; }
when ( "PART" ) { handlePart ( \ @ command , $ aServerName , \ % logFiles ) ; }
when ( "376" ) { joinChannels ( $ stream , $ aChannels ) ; } # end of MOTD
}
}
close ( $ stream ) ;
}
2023-09-12 10:19:46 +02:00
our @ connections ;
sub createLogger {
my $ aName = $ _ [ 0 ] ;
my $ aHost = $ _ [ 1 ] ;
my $ aPort = $ _ [ 2 ] ;
my $ aChannels = $ _ [ 3 ] ;
my @ connection = ( $ aName , 1 ) ;
push ( @ connection , threads - > create ( "connectionWorker" , $ aHost , $ aPort , $ aName , $ aChannels , \ @ connection ) ) ;
push ( @ connections , @ connection ) ;
}
2023-09-05 10:04:47 +02:00
my $ db = DBI - > connect ( "DBI:SQLite:dbname=$configuration::database" , "" , "" , { RaiseError = > 1 } ) ;
my $ query = $ db - > prepare ( qq( select * from servers; ) ) ;
$ query - > execute ( ) ;
while ( my @ row = $ query - > fetchrow_array ( ) ) {
my $ id = $ row [ 0 ] ;
my $ name = $ row [ 1 ] ;
my $ host = $ row [ 2 ] ;
my $ port = $ row [ 3 ] ;
$ query = $ db - > prepare ( qq( select name from channels where server_id=$id; ) ) ;
$ query - > execute ( ) ;
my @ channels ;
while ( my @ channelsRow = $ query - > fetchrow_array ( ) ) {
my $ name = $ channelsRow [ 0 ] ;
push ( @ channels , $ name ) ;
}
2023-09-12 10:19:46 +02:00
createLogger ( $ name , $ host , $ port , \ @ channels ) ;
2023-09-05 10:04:47 +02:00
}
2023-09-12 10:19:46 +02:00
$ db - > disconnect ( ) ;
1 ;