SCAR Code:
{
IRC implementation by yakman which wasnt finished
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
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
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
}
{
I was going to make an IRC client from this, so i started writing the protocol
parsing part, and its almost finished now, the only thing i havent done is where
it puts each channel and name into some array,
when that was finished, i meant to write a form/gui for it
but i got bored of it, now im releasing to SRL
}
program IRCBot;
const
Server = 'irc.freenode.net';
Port = 6667;
BotNick = 'slurry_';
BotChannel = '#srl';
ChanKey = '';
//MakeWindowTransparent()
type
User = record
powers, name: string;
end;
type
Channel = record
name: string;
users: array of User;
end;
var //socket connection
sock_fd: Integer;
closed: boolean;
buffer: string;
buf_pos, buf_len: Integer;
var
irc_nick, irc_username, irc_realname: string;
network_name: string; //you can use this in a GUI, like in the title of a window for example
prefix_modes, prefix_status: string; //ordered from most powerful to least
chan_mode_param, //channel mode always has a parameter
chan_mode_param_set, //only has a parameter when being set +
chan_mode_no_param: string; //never has a parameter
chan_prefix: string;
channel_list: array of Channel;
//names: array of string;
var //needed for ctime()
days_of_week: array of string;
months_of_year: array of string;
function TimeToString(datetime: TDateTime): string;
var
year, month, day: word;
hour, min, sec, msec: word;
begin
DecodeDate(datetime, year, month, day);
DecodeTime(datetime, hour, min, sec, msec);
Result:= days_of_week[DayOfWeek(datetime) - 1] + ' ' + IntToStr(day)
+ ' ' + months_of_year[month - 1] + ' ' + IntToStr(year) + ' ' +
IntToStr(hour) + ':' + IntToStr(min) + ':' + IntToStr(sec);
end;
//equivalent of ctime() in <time.h> of the c standard library
function CTime(unixtime: LongInt): string;
begin //epic bug, doesnt change to local time, so its one hour more or less
Result:= TimeToString(UnixToDateTime(unixtime));
end;
function GetChannelByName(name: string): Integer;
var
i: Integer;
begin
for i:=0 to High(channel_list) do
if(channel_list[i].name = name)then
begin
Result:= i;
Exit;
end;
Result:= -1;
end;
function GetUserByName(chan_index: integer; nick: string): Integer;
var
i: Integer;
begin
for i:=0 to High(channel_list[chan_index].users) do
begin
if(channel_list[chan_index].users[i].name = nick)then
begin
Result:= i;
Exit;
end;
end;
Result:= -1;
end;
function NextToken(var strtok: string; c: char): string;
var
f, strlen: Integer;
begin
strlen:= Length(strtok);
for f:= 1 to strlen do
if(strtok[f] = c)then
begin
Result:= Copy(strtok, 1, f-1);
strtok:= Copy(strtok, f + 1, strlen);
Exit;
end;
Result:= #0;
end;
function IsNumber(s: string):boolean;
begin
try
StrToInt(s);
Result:= True;
except
Result:= False;
end
end;
procedure SendData(data: string);
begin
SendConnectionData(sock_fd, data + #13 + #10);
Writeln('=> ' + data);
end;
procedure ChangeNick(newNick: string);
begin
SendData('NICK ' + newNick);
irc_nick:= newNick;
end;
procedure JoinChannel(Channel, Key: string); //key is empty string if theres no key
begin
if(Key <> '')then
Key:= ' ' + Key;
SendData('JOIN ' + Channel + Key);
end;
procedure Privmsg(Target, Text: string);
begin
SendData('PRIVMSG ' + Target + ' :' + Text);
end;
procedure Notice(Target, Text: string);
begin
SendData('NOTICE ' + Target + ' :' + Text);
end;
procedure HandleServerSupport(data: string);
var
datatok, token, key: string; //http://www.irc.org/tech_docs/005.html
begin //http://www.irc.org/tech_docs/draft-brocklesby-irc-isupport-03.txt
datatok:= data;
repeat
token:= NextToken(datatok, ' ');
if(token = #0)then break; //end of tokens
key:= NextToken(token, '='); //if this succeeds, it will be 'key=token' like 'CHANTYPES=#'
if(key = #0)then continue; //the parameter is present, but has no value, in this case, we'll just drop it
//some parameters are just not stored, things like CHANLIMIT, the server will enforce that for you
if(key = 'PREFIX')then
begin
//PREFIX=(ov)@+
Delete(token, 1, 1); //remove the first (
prefix_modes:= Copy(token, 1, Pos(')', token) - 1);
prefix_status:= Copy(token, Pos(')', token) + 1, Length(token));
end else
if(key = 'CHANMODES')then
begin
//CHANMODES=bdeIq,k,lfJD,cgijLmnPQrRstz
chan_mode_param:= NextToken(token, ',') + NextToken(token, ',');
chan_mode_param_set:= NextToken(token, ',');
chan_mode_no_param:= token;
end else
if(key = 'CHANTYPES')then
begin
chan_prefix:= token;
end else
if(key = 'NETWORK')then
begin
network_name:= token;
end;
until(False);
end;
procedure HandleNumericCommand(nickuserhost, cmd, param, linetok: string);
var
channel, who, name, power, timeset: string;
i, c, p: Integer;
unixtime: Int64;
begin //http://www.alien.net.au/irc/irc2numerics.html
if(cmd = '005')then //RPL_ISUPPORT
begin
HandleServerSupport(linetok);
end else
if(cmd = '331')then //no topic set
begin
//channel:= NextToken(linetok, ' ');
end else
if(cmd = '332')then //topic
begin
channel:= NextToken(linetok, ' ');
if(linetok[1] = ':')then
Delete(linetok, 1, 1);
end else
if(cmd = '333')then //topic who time
begin
channel:= NextToken(linetok, ' ');
who:= NextToken(linetok, ' ');
try
unixtime:= StrToInt64(linetok);
except
end
timeset:= CTime(unixtime);
end else
if(cmd = '353')then //names list
begin
NextToken(linetok, ' '); //junk
channel:= NextToken(linetok, ' ');
c:= GetChannelByName(channel);
if(c = -1)then
writeln('error c=-1 channel="' + channel + '"');
if(linetok[1] = ':')then
Delete(linetok, 1, 1);
repeat
name:= NextToken(linetok, ' ');
if(name = #0)then break;
power:= '';
for i:=1 to Length(prefix_status) do
begin
p:= LastPos(prefix_status[i], name);
if(p > 0)then
begin
power:= Copy(name, 1, p);
Delete(name, 1, p);
end
end;
i:= GetArrayLength(channel_list[c].users);
SetArrayLength(channel_list[c].users, i + 1);
channel_list[c].users[i].name:= name;
channel_list[c].users[i].powers:= power;
until(False);
end
end;
procedure HandleCTCP(nick, user, host, cmd, param, linetok: string);
var
request: string;
begin
Delete(linetok, 1, 1);
request:= NextToken(linetok, #1);
if(request = 'ACTION')then
begin
(* /me did this *)
end
else
if(request = 'VERSION')then
Notice(nick, #1 + 'VERSION SRL-Client SCAR yakman AND CHE GUEVARA!' + #1)
else
if(request = 'PING')then
Notice(nick, #1 + 'PING ' + linetok + #1)
else
if(request = 'TIME')then
Notice(nick, #1 + 'TIME ' + TimeToString(now) + #1)
else
if(request = 'USERINFO')then
Notice(nick, #1 + 'USERINFO my-user-info' + #1)
end;
procedure ModeChanged(nick, user, host, chan: string; sign, mode: char; arg: string; prefixed_mode: boolean);
var
m, c, u: Integer;
tt: integer;
begin
if(prefixed_mode)then
begin
m:= Pos(mode, prefix_modes);
writeln('pmodes=' + prefix_modes + '; m=' + inttostr(m));
c:= GetChannelByName(chan);
u:= GetUserByName(c, arg); //arg is the nick that was opped
if(sign = '+')then
begin
tt:= pos(mode, channel_list[c].users[u].powers);
writeln('mode=' + mode + ' powers=' + channel_list[c].users[u].powers + ' pos=' + inttostr(tt));
if(tt <> 0)then
Exit; //already has it
channel_list[c].users[u].powers:= prefix_status[m] + channel_list[c].users[u].powers;
end
else
Delete(channel_list[c].users[u].powers, Pos(mode, channel_list[c].users[u].powers), 1)
end
end;
procedure HandleModeChange(nick, user, host, cmd, param, linetok: string);
var
modes, nextarg: string;
sign: char;
i, m: Integer;
begin
modes:= NextToken(linetok, ' ');
for i:=1 to Length(modes) do
begin
if(modes[i] = '+')or(modes[i] = '-')then
begin
sign:= modes[i];
continue;
end;
for m:=1 to Length(chan_mode_param) do
if(modes[i] = chan_mode_param[m])then
begin
nextarg:= NextToken(linetok, ' ');
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, false);
break;
end;
for m:=1 to Length(chan_mode_param_set) do
if(modes[i] = chan_mode_param_set[m])then
begin
if(sign = '+')then
nextarg:= NextToken(linetok, ' ');
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, false);
break;
end;
for m:=1 to Length(chan_mode_no_param) do
if(modes[i] = chan_mode_no_param[m])then
begin
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, false);
break;
end;
for m:=1 to Length(prefix_modes) do
if(modes[i] = prefix_modes[m])then
begin
nextarg:= NextToken(linetok, ' ');
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, true);
break;
end;
end
end;
procedure ParseIRCLine(line: string);
var
linetok: string;
nickuserhost, nuhtok: string;
nick, user, host: string;
cmd, param: string;
c, l: Integer;
begin
if(StartsWith('PING', line))then
begin
line[2] := 'O';
SendData(line);
Exit;
end;
linetok:= line;
nickuserhost:= NextToken(linetok, ' ');
if(nickuserhost[1] = ':')then
Delete(nickuserhost, 1, 1);
nuhtok:= nickuserhost;
nick:= NextToken(nuhtok, '!');
user:= NextToken(nuhtok, '@');
host:= nuhtok;
cmd:= NextToken(linetok, ' ');
param:= NextToken(linetok, ' ');
if(IsNumber(cmd))then
begin
HandleNumericCommand(nickuserhost, cmd, param, linetok);
end else
if(cmd = 'PRIVMSG')then
begin
if(linetok[1] = ':')then
Delete(linetok, 1, 1);
if(linetok[1] = #1)then
begin
HandleCTCP(nick, user, host, cmd, param, linetok);
Exit;
end else
if(linetok = '!quit')then
begin
FreeConnection(sock_fd);
closed:= true;
end else
if(linetok = '!dumpsrluser')then
begin
for c:=0 to High(channel_list[0].users) do
linetok:= linetok + ' ' + channel_list[0].users[c].powers + channel_list[0].users[c].name;
SendData('PRIVMSG ' + Nick + ' :' + linetok);
end
end else
if(cmd = 'KICK')then
begin
nuhtok:= NextToken(linetok, ' '); //kicked nick
end else
if(cmd = 'JOIN')then
begin
//linetok is the joined channel
if(linetok[1] = ':')then
Delete(linetok, 1, 1);
if(nick = irc_nick)then //we joined a chan
begin
c:= GetArrayLength(channel_list);
SetArrayLength(channel_list, c + 1);
channel_list[c].name:= linetok;
Exit;
end;
//someone else joined our chan
c:= GetChannelByName(linetok);
l:= GetArrayLength(channel_list[c].users);
SetArrayLength(channel_list[c].users, l + 1);
channel_list[c].users[l].name:= nick;
channel_list[c].users[l].powers:= '';
end else
if(cmd = 'MODE')then
begin
HandleModeChange(nick, user, host, cmd, param, linetok);
end
end;
procedure FillBuffer;
var
incoming: string;
begin
ReadConnectionData(sock_fd, incoming);
buffer:= Copy(buffer, buf_pos, buf_len) + incoming;
buf_pos:= 1;
buf_len:= Length(buffer);
end;
function ReadNextLine: string;
var
f, oldPos: Integer;
begin
repeat
oldPos:= buf_pos;
for f:= buf_pos to buf_len-1 do
if(buffer[f] = #13)or(buffer[f] = #10)then
begin
buf_pos:= f + 1;
if(buffer[buf_pos] = #13)or(buffer[buf_pos] = #10)then
buf_pos:= buf_pos + 1;
Result:= Copy(buffer, oldPos, f - oldPos);
Exit;
end;
//newline not found in buffer
FillBuffer;
until(buf_len > 1024);
//socket buffer got far too large
end;
function StartupIRC(host: string; port: Integer; nick, user, real: string): boolean;
begin
Result:= True;
sock_fd:= OpenConnection(host, port, 10000);
if(sock_fd < 0)then
begin
Result:= False;
Exit;
end;
//set defaults
network_name:= '';
prefix_modes:= 'ov';
prefix_status:= '@+';
chan_mode_param:= '';
chan_mode_param_set:= '';
chan_mode_no_param:= '';
irc_nick:= nick;
irc_username:= user;
irc_realname:= real;
SendData('USER ' + irc_username + ' * * :' + irc_realname);
ChangeNick(irc_nick);
FillBuffer;
end;
procedure Init;
begin
days_of_week:= ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'];
months_of_year:= ['Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
'Aug', 'Sep', 'Oct', 'Nov', 'Dec'];
end;
procedure Main;
var
line: string;
begin
Init;
StartupIRC(Server, Port, BotNick, 'username', 'real name');
JoinChannel(BotChannel, ChanKey);
repeat
line:= ReadNextLine;
writeln('<= ' + line + ';');
ParseIRCLine(line);
until(closed);
end;
begin
Main;
end.