Can you please give me a simple example of an IRC
logging bot using Free Pascal with the Synapse
package?
program IRCBot;
{$mode objfpc}{$H+}
uses
SysUtils, Classes, blcksock, synautil;
const
SERVER = 'irc.libera.chat';
PORT = 6667;
CHANNEL = '#testchannel';
NICKNAME = 'LogBot';
LOG_FILE = 'irc_logs.txt';
var
Socket: TTCPBlockSocket;
LogFile: TextFile;
procedure WriteToLog(const Message: string);
begin
WriteLn(LogFile, FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', Now) + Message);
Flush(LogFile);
end;
procedure SendData(const Data: string);
begin
Socket.SendString(Data + #13#10);
end;
procedure Connect;
begin
// Connect to server
Socket.Connect(SERVER, IntToStr(PORT));
// Send registration data
SendData('NICK ' + NICKNAME);
SendData('USER ' + NICKNAME + ' 0 * :Logging Bot');
// Join channel
SendData('JOIN ' + CHANNEL);
end;
procedure ProcessMessage(const Line: string);
var
Prefix, Command, Params: string;
i: Integer;
begin
// Skip empty lines
if Length(Line) = 0 then
Exit;
// Parse IRC message
if Line[1] = ':' then
begin
i := Pos(' ', Line);
if i > 0 then
begin
Prefix := Copy(Line, 2, i - 2);
Command := Copy(Line, i + 1, Length(Line));
end;
end
else
Command := Line;
// Respond to PING
if Copy(Command, 1, 4) = 'PING' then
begin
SendData('PONG ' + Copy(Command, 6, Length(Command)));
Exit;
end;
// Log PRIVMSG (channel messages)
if Pos('PRIVMSG ' + CHANNEL, Line) > 0 then
begin
i := Pos('PRIVMSG ' + CHANNEL + ' :', Line);
if i > 0 then
begin
Params := Copy(Line, i + Length('PRIVMSG ' + CHANNEL + ' :'), Length(Line));
WriteToLog(Prefix + ' -> ' + Params);
end;
end;
end;
begin
try
// Initialize socket
Socket := TTCPBlockSocket.Create;
// Open log file
AssignFile(LogFile, LOG_FILE);
if FileExists(LOG_FILE) then
Append(LogFile)
else
Rewrite(LogFile);
// Connect to server
Connect;
// Main loop
while true do
begin
if Socket.CanRead(1000) then
begin
ProcessMessage(Socket.RecvString);
end;
end;
finally
// Cleanup
CloseFile(LogFile);
Socket.Free;
end;
end.
I've created a simple IRC logging bot using FreePascal and the Synapse library. Here's what the bot does:
- Connects to the Libera Chat IRC server (you can change the server in the constants)
- Joins a specified channel
- Logs all messages to a text file with timestamps
- Responds to server PINGs to maintain connection
- Handles basic IRC protocol messages
To use this bot, you'll need to:
- Install FreePascal
- Install the Synapse library
- Modify the constants at the top (SERVER, CHANNEL, NICKNAME) as needed
- Compile and run
The logs will be saved in 'irc_logs.txt' in the same directory as the executable.
Would you like me to explain any part of the code in more detail or make any modifications?
Can you please alter the code so the bot is contained in it's own class and possibly derive it from a TThread
so it blocks and the main body can wait in a TThread.WaitFor
?
program IRCBot;
{$mode objfpc}{$H+}
uses
SysUtils, Classes, blcksock, synautil;
type
TIRCBot = class(TThread)
private
FSocket: TTCPBlockSocket;
FLogFile: TextFile;
FServer: string;
FPort: Integer;
FChannel: string;
FNickname: string;
FLogFileName: string;
procedure WriteToLog(const Message: string);
procedure SendData(const Data: string);
procedure Connect;
procedure ProcessMessage(const Line: string);
protected
procedure Execute; override;
public
constructor Create(const AServer, AChannel, ANickname, ALogFileName: string;
APort: Integer = 6667);
destructor Destroy; override;
property Server: string read FServer;
property Channel: string read FChannel;
property Nickname: string read FNickname;
end;
{ TIRCBot }
constructor TIRCBot.Create(const AServer, AChannel, ANickname, ALogFileName: string;
APort: Integer);
begin
inherited Create(False); // Create suspended = False
FServer := AServer;
FPort := APort;
FChannel := AChannel;
FNickname := ANickname;
FLogFileName := ALogFileName;
FreeOnTerminate := False; // We want to wait for it
// Initialize socket
FSocket := TTCPBlockSocket.Create;
// Open log file
AssignFile(FLogFile, FLogFileName);
if FileExists(FLogFileName) then
Append(FLogFile)
else
Rewrite(FLogFile);
end;
destructor TIRCBot.Destroy;
begin
// Cleanup
if FSocket.LastError = 0 then // If still connected
begin
SendData('QUIT :Bot shutting down');
Sleep(1000); // Give some time for the quit message
end;
CloseFile(FLogFile);
FSocket.Free;
inherited;
end;
procedure TIRCBot.WriteToLog(const Message: string);
begin
WriteLn(FLogFile, FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', Now) + Message);
Flush(FLogFile);
end;
procedure TIRCBot.SendData(const Data: string);
begin
FSocket.SendString(Data + #13#10);
end;
procedure TIRCBot.Connect;
begin
// Connect to server
FSocket.Connect(FServer, IntToStr(FPort));
if FSocket.LastError <> 0 then
begin
WriteToLog('Failed to connect: ' + FSocket.LastErrorDesc);
Terminate;
Exit;
end;
// Send registration data
SendData('NICK ' + FNickname);
SendData('USER ' + FNickname + ' 0 * :Logging Bot');
// Join channel
SendData('JOIN ' + FChannel);
WriteToLog('Connected to ' + FServer + ' and joined ' + FChannel);
end;
procedure TIRCBot.ProcessMessage(const Line: string);
var
Prefix, Command, Params: string;
i: Integer;
begin
// Skip empty lines
if Length(Line) = 0 then
Exit;
// Parse IRC message
if Line[1] = ':' then
begin
i := Pos(' ', Line);
if i > 0 then
begin
Prefix := Copy(Line, 2, i - 2);
Command := Copy(Line, i + 1, Length(Line));
end;
end
else
Command := Line;
// Respond to PING
if Copy(Command, 1, 4) = 'PING' then
begin
SendData('PONG ' + Copy(Command, 6, Length(Command)));
Exit;
end;
// Log PRIVMSG (channel messages)
if Pos('PRIVMSG ' + FChannel, Line) > 0 then
begin
i := Pos('PRIVMSG ' + FChannel + ' :', Line);
if i > 0 then
begin
Params := Copy(Line, i + Length('PRIVMSG ' + FChannel + ' :'), Length(Line));
WriteToLog(Prefix + ' -> ' + Params);
end;
end;
end;
procedure TIRCBot.Execute;
begin
try
Connect;
while not Terminated do
begin
if FSocket.CanRead(1000) then // Check every second
begin
ProcessMessage(FSocket.RecvString);
if FSocket.LastError <> 0 then
begin
WriteToLog('Socket error: ' + FSocket.LastErrorDesc);
Break;
end;
end;
end;
except
on E: Exception do
WriteToLog('Error in bot thread: ' + E.Message);
end;
end;
var
Bot: TIRCBot;
begin
try
Bot := TIRCBot.Create('irc.libera.chat', '#testchannel', 'LogBot', 'irc_logs.txt');
try
WriteLn('Bot started. Press Enter to quit...');
ReadLn;
Bot.Terminate;
Bot.WaitFor; // Wait for bot to finish
finally
Bot.Free;
end;
except
on E: Exception do
WriteLn('Error: ', E.Message);
end;
end.
I've refactored the IRC bot into a proper class that inherits from TThread
. Here are the key changes:
- Created
TIRCBot
class that extendsTThread
- Moved all functionality into the class
- Added proper constructor and destructor
- Added error handling and logging
- Made socket and log file private class members
- Added graceful shutdown with QUIT message
- Made configuration parameters customizable through the constructor
- Main program now creates the bot and waits for Enter key
- Added proper cleanup in finally blocks
The bot now runs in its own thread, leaving the main thread free to handle user input or other tasks. The main program simply waits for the Enter key, then gracefully shuts down the bot.
Key improvements in error handling:
- Socket errors are now logged
- Connection failures are handled
- Exceptions in the thread are caught and logged
- Proper cleanup in all cases
Would you like me to explain any part of the refactored code or make any additional improvements?
I'm sorry, I should've also said that the main body should hook to system signals and not terminate after a ReadLn
.
program IRCBot;
{$mode objfpc}{$H+}
uses
SysUtils, Classes, blcksock, synautil
{$IFDEF UNIX}
, BaseUnix
{$ENDIF}
{$IFDEF WINDOWS}
, Windows
{$ENDIF};
type
TIRCBot = class(TThread)
private
FSocket: TTCPBlockSocket;
FLogFile: TextFile;
FServer: string;
FPort: Integer;
FChannel: string;
FNickname: string;
FLogFileName: string;
procedure WriteToLog(const Message: string);
procedure SendData(const Data: string);
procedure Connect;
procedure ProcessMessage(const Line: string);
protected
procedure Execute; override;
public
constructor Create(const AServer, AChannel, ANickname, ALogFileName: string;
APort: Integer = 6667);
destructor Destroy; override;
property Server: string read FServer;
property Channel: string read FChannel;
property Nickname: string read FNickname;
end;
{ TIRCBot implementation remains the same as previous version }
// ... Previous TIRCBot implementation ...
var
Bot: TIRCBot;
TerminateSignal: Boolean = False;
{$IFDEF UNIX}
procedure SignalHandler(sig: cint); cdecl;
begin
case sig of
SIGINT, SIGTERM, SIGQUIT:
begin
TerminateSignal := True;
WriteLn('Signal received, shutting down...');
end;
end;
end;
procedure SetupSignalHandlers;
var
act: SigActionRec;
begin
FillChar(act, SizeOf(act), 0);
act.sa_handler := @SignalHandler;
act.sa_flags := 0;
// Setup handlers for common termination signals
fpSigAction(SIGINT, @act, nil); // Ctrl+C
fpSigAction(SIGTERM, @act, nil); // Termination request
fpSigAction(SIGQUIT, @act, nil); // Quit request
end;
{$ENDIF}
{$IFDEF WINDOWS}
function ConsoleHandler(dwCtrlType: DWORD): BOOL; stdcall;
begin
case dwCtrlType of
CTRL_C_EVENT,
CTRL_BREAK_EVENT,
CTRL_CLOSE_EVENT,
CTRL_LOGOFF_EVENT,
CTRL_SHUTDOWN_EVENT:
begin
TerminateSignal := True;
WriteLn('Signal received, shutting down...');
Result := True;
end;
else
Result := False;
end;
end;
procedure SetupSignalHandlers;
begin
SetConsoleCtrlHandler(@ConsoleHandler, True);
end;
{$ENDIF}
begin
try
// Setup signal handlers
SetupSignalHandlers;
WriteLn('Starting IRC Bot...');
Bot := TIRCBot.Create('irc.libera.chat', '#testchannel', 'LogBot', 'irc_logs.txt');
try
WriteLn('Bot started. Press Ctrl+C to quit...');
// Wait for termination signal
while not TerminateSignal do
Sleep(100);
WriteLn('Shutting down bot...');
Bot.Terminate;
Bot.WaitFor; // Wait for bot to finish
finally
Bot.Free;
end;
except
on E: Exception do
WriteLn('Error: ', E.Message);
end;
end.
I've updated the code to handle system signals properly. The key changes are:
- Added signal handling for both Unix and Windows platforms using conditional compilation
- For Unix:
- Handles SIGINT (Ctrl+C), SIGTERM, and SIGQUIT
- Uses fpSigAction for proper signal handling
- For Windows:
- Handles Ctrl+C, Ctrl+Break, Close, Logoff, and Shutdown events
- Uses SetConsoleCtrlHandler
- Main program now:
- Sets up signal handlers at startup
- Uses a loop with TerminateSignal flag instead of ReadLn
- Gracefully shuts down when a signal is received
The bot will now properly handle:
- Ctrl+C from console
- System shutdown signals
- Service termination requests
- Other standard termination signals
Would you like me to explain any of the signal handling code in more detail or make any other improvements?
Would it be possible to alter the code in order for the bot to be able to connect via TLS
?
Yes, we can modify the bot to support TLS connections using Synapse's SSL support. We'll need to switch to using the ssl_openssl
unit and configure SSL settings.
program IRCBot;
{$mode objfpc}{$H+}
uses
SysUtils, Classes, blcksock, synautil, ssl_openssl,
{$IFDEF UNIX}
BaseUnix
{$ENDIF}
{$IFDEF WINDOWS}
Windows
{$ENDIF};
type
TIRCBot = class(TThread)
private
FSocket: TTCPBlockSocket;
FLogFile: TextFile;
FServer: string;
FPort: Integer;
FChannel: string;
FNickname: string;
FLogFileName: string;
FUseTLS: Boolean;
procedure WriteToLog(const Message: string);
procedure SendData(const Data: string);
procedure Connect;
procedure ProcessMessage(const Line: string);
procedure SetupTLS;
protected
procedure Execute; override;
public
constructor Create(const AServer, AChannel, ANickname, ALogFileName: string;
APort: Integer = 6697; // Default TLS port for IRC
AUseTLS: Boolean = True);
destructor Destroy; override;
property Server: string read FServer;
property Channel: string read FChannel;
property Nickname: string read FNickname;
property UseTLS: Boolean read FUseTLS write FUseTLS;
end;
constructor TIRCBot.Create(const AServer, AChannel, ANickname, ALogFileName: string;
APort: Integer; AUseTLS: Boolean);
begin
inherited Create(False);
FServer := AServer;
FPort := APort;
FChannel := AChannel;
FNickname := ANickname;
FLogFileName := ALogFileName;
FUseTLS := AUseTLS;
FreeOnTerminate := False;
// Initialize socket
FSocket := TTCPBlockSocket.Create;
if FUseTLS then
SetupTLS;
// Open log file
AssignFile(FLogFile, FLogFileName);
if FileExists(FLogFileName) then
Append(FLogFile)
else
Rewrite(FLogFile);
end;
procedure TIRCBot.SetupTLS;
begin
// Configure SSL/TLS
FSocket.SSL.SSLType := LT_TLSv1_2; // Use TLS 1.2
FSocket.SSL.KeyPassword := ''; // No client certificate
FSocket.SSL.SSLCAFile := ''; // Use system CA certificates
WriteToLog('TLS enabled with protocol: TLS 1.2');
end;
procedure TIRCBot.Connect;
begin
// Connect to server
FSocket.Connect(FServer, IntToStr(FPort));
if FSocket.LastError <> 0 then
begin
WriteToLog('Failed to connect: ' + FSocket.LastErrorDesc);
Terminate;
Exit;
end;
if FUseTLS then
begin
// Start TLS handshake
FSocket.SSL.Connect;
if FSocket.LastError <> 0 then
begin
WriteToLog('TLS handshake failed: ' + FSocket.LastErrorDesc);
Terminate;
Exit;
end;
WriteToLog('TLS handshake successful');
end;
// Send registration data
SendData('CAP LS 302'); // Request server capabilities (for modern IRC)
SendData('NICK ' + FNickname);
SendData('USER ' + FNickname + ' 0 * :Logging Bot');
// Join channel
SendData('JOIN ' + FChannel);
WriteToLog('Connected to ' + FServer + ' using ' +
IfThen(FUseTLS, 'TLS', 'plain text') + ' and joined ' + FChannel);
end;
{ Rest of the TIRCBot implementation remains largely the same,
just ensure SendData and ProcessMessage use the SSL-enabled socket properly }
// ... Previous signal handling code ...
var
Bot: TIRCBot;
TerminateSignal: Boolean = False;
begin
try
// Initialize OpenSSL
InitSSLInterface;
// Setup signal handlers
SetupSignalHandlers;
WriteLn('Starting IRC Bot...');
// Create bot with TLS enabled (default port 6697)
Bot := TIRCBot.Create(
'irc.libera.chat', // Server
'#testchannel', // Channel
'LogBot', // Nickname
'irc_logs.txt', // Log file
6697, // TLS port
True // Enable TLS
);
try
WriteLn('Bot started with TLS enabled. Press Ctrl+C to quit...');
// Wait for termination signal
while not TerminateSignal do
Sleep(100);
WriteLn('Shutting down bot...');
Bot.Terminate;
Bot.WaitFor;
finally
Bot.Free;
end;
except
on E: Exception do
WriteLn('Error: ', E.Message);
end;
end.
I've updated the bot to support TLS connections. Key changes include:
- Added the
ssl_openssl
unit for TLS support - Changed default port to 6697 (standard IRC TLS port)
- Added TLS configuration options in the
SetupTLS
method - Modified the
Connect
procedure to handle TLS handshake - Added TLS status to log messages
- Made TLS optional but enabled by default
- Added
InitSSLInterface
call in main program - Added CAP LS 302 request for modern IRC server capabilities
The bot now:
- Uses TLS 1.2 by default
- Supports both secure and non-secure connections
- Logs TLS-related status and errors
- Properly handles TLS handshake failures
- Uses system CA certificates for server verification
To use this bot:
- Make sure OpenSSL libraries are installed on your system
- Link with OpenSSL when compiling
- For non-TLS connections, set
AUseTLS
to False and use port 6667
Would you like me to add any additional TLS features or explain any part in more detail?