Beginnings of cmpctircd (initial commit)

See TODO for an idea of active development focus.
cmpct · Jul 30, 2016 · db3f55b · db3f55b
commit db3f55b
Show file tree

Hide file tree

Showing 12 changed files with 651 additions and 0 deletions.
diff --git a/IRCd/Channel.pm b/IRCd/Channel.pm
@@ -0,0 +1,118 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use diagnostics;
+
+package IRCd::Channel;
+
+sub new {
+    my $class = shift;
+    my $self  = {
+        'name'    => shift,
+        'clients' => [],
+        'modes'   => ['n', 's'],
+        # topic
+        # -> ...
+    };
+    bless $self, $class;
+    return $self;
+}
+
+sub setMode {
+    my $self  = shift;
+    my $modes = shift;
+    # Check how valid the modes are
+    # Another issue is keys.. and other params
+    push @{$self->{modes}}, $modes;
+}
+sub addClient {
+    my $self   = shift;
+    my $client = shift;
+    my $mask  = $client->getMask();
+    my $modes = "";
+
+    if($self->resides($client)) {
+        # Already in the channel
+        print "They're already in the channel!\r\n";
+        return;
+    }
+    # $client->{socket}->{sock}->write(":$client->{config}->{host} 443 $client->{nick} $self->{name} :is already on channel\r\n");
+
+    push @{$self->{clients}}, $client;
+    print "Added client to channel $self->{name}\r\n";
+
+    $self->sendToRoom($client, ":$mask JOIN :$self->{name}");
+    foreach(@{$self->{modes}}) {
+        print "Adding mode: $_\r\n";
+        $modes = $modes . $_;
+    }
+    $client->{socket}->{sock}->write(":$client->{config}->{host} MODE $self->{name} +$modes\r\n");
+    foreach($self->{clients}->@*) {
+        # RPL_NAMEREPLY
+        $client->{socket}->{sock}->write(":$client->{config}->{host} 353 $client->{nick} \@ $self->{name} :\@$_->{nick}\r\n");
+    }
+    # RPL_ENDOFNAMES
+    $client->{socket}->{sock}->write(":$client->{config}->{host} 366 $client->{nick} $self->{name} :End of /NAMES list.\r\n");
+    # RPL_TOPIC
+    $client->{socket}->{sock}->write(":$client->{config}->{host} 332 $client->{nick} $self->{name} :This is a topic.\r\n");
+    $client->{socket}->{sock}->write(":$client->{config}->{host} 324 $client->{nick} $self->{name} +$modes\r\n");
+    #$client->{socket}->{sock}->write(":$client->{config}->{host} 329 $client->{nick} $self->{name} " . time() . "\r\n");
+}
+sub quit {
+    my $self   = shift;
+    my $client = shift;
+    my $mask   = $client->getMask();
+    my $msg    = shift;
+    foreach(@{$this->clients}) {
+        # We should be in the room b/c of the caller but let's be safe.
+        if($_ eq $client) {
+            print "Removed (QUIT) a client from channel $self->{name}\r\n";
+            $self->sendToRoom($client, ":$mask QUIT :$msg");
+            @{$self->{clients}} = grep { $_ != $client } @{$self->{clients}};
+            return;
+        }
+    }
+
+}
+sub part {
+    my $self   = shift;
+    my $client = shift;
+    my $mask   = $client->getMask();
+    my $msg    = shift;
+    foreach(@{$this->clients}) {
+        # We should be in the room b/c of the caller but let's be safe.
+        if($_ eq $client) {
+            @{$self->{clients}} = grep { $_ != $client } @{$self->{clients}};
+            print "Removed (PART) a client from channel $self->{name}\r\n";
+            $self->sendToRoom($client, ":$mask PART $self->{name} :$msg");
+            return;
+        }
+    }
+    # If we get here, they weren't in the room.
+    # XXX: Is this right?
+    $client->{socket}->{sock}->write(":$client->{config}->{host} 442 $self->{name} :You're not on that channel\r\n");
+}
+sub resides {
+    my $self   = shift;
+    my $client = shift;
+    my $mask   = $client->getMask();
+    my $msg    = shift;
+
+    foreach($self->{clients}->@*) {
+        return 1 if($_ eq $client);
+    }
+    return 0;
+}
+sub sendToRoom {
+    my $self   = shift;
+    my $client = shift;
+    my $msg    = shift;
+    my $sendToSelf = shift // 1;
+
+    foreach($self->{clients}->@*) {
+        next if(($_ eq $client) and !$sendToSelf);
+        $_->{socket}->{sock}->write($msg . "\r\n");
+    }
+}
+
+1;
diff --git a/IRCd/Client.pm b/IRCd/Client.pm
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use diagnostics;
+use IRCd::Packets;
+
+package IRCd::Client;
+
+sub new {
+    my $class = shift;
+    my $self = {
+        'socket'   => shift,
+        'ircd'     => shift,
+        'config'   => shift,
+        # ...
+        'sentWelcome' => 0,
+    };
+    bless $self, $class;
+    return $self;
+}
+
+sub getMask {
+    my $self = shift;
+    return $self->{nick} . '!' . $self->{ident} . '@' . $self->{ip};
+}
+
+sub parse {
+    my $self = shift;
+    my $msg  = shift;
+    my $sock = shift;
+
+    my @splitPacket = split(" ", $msg);
+
+    # Check if function exists, and if so, call it
+    if (my $handlerRef = IRCd::Packets->can(lc($splitPacket[0]))) {
+        $handlerRef->($self, $msg);
+    } else {
+        print "UNHANDLED PACKET: " . $splitPacket[0] . "\r\n";
+    }
+}
+
+sub sendWelcome {
+    my $self = shift;
+    $self->{socket}->{sock}->write(":$self->{config}->{host} 001 $self->{nick} :Welcome to the $self->{config}->{network} IRC Network $self->{nick}!$self->{ident}\@$self->{ip}\r\n");
+    $self->{socket}->{sock}->write(":$self->{config}->{host} 002 $self->{nick} :Your host is $self->{config}->{host}, running version $self->{config}->{version}\r\n");
+    $self->{socket}->{sock}->write(":$self->{config}->{host} 003 $self->{nick} :This server was created on 1/1/1970\r\n");
+    # Write MOTD
+    my $motd;
+    open($motd, "<", "ircd.motd");
+    my @motd = <$motd>;
+    $self->{socket}->{sock}->write(":$self->{config}->{host} 375 $self->{nick} :- $self->{config}->{host} Message of the Day -\r\n");
+    foreach(@motd) {
+        $self->{socket}->{sock}->write(":$self->{config}->{host} 372 $self->{nick} :- " . $_ . "\r\n");
+    }
+    $self->{socket}->{sock}->write(":$self->{config}->{host} 376 $self->{nick} :End of /MOTD command.\r\n");
+    close($motd);
+    $self->{sentWelcome} = 1;
+}
+
+1;
diff --git a/IRCd/Config.pm b/IRCd/Config.pm
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use diagnostics;
+package IRCd::Config;
+
+sub new {
+    my $class = shift;
+    my $self = {
+        'filename' => shift,
+        'ip' => undef,
+        'port' => undef,
+        'version' => 0.1,
+
+        # ircd obj
+        'channels' => {},
+    };
+    bless $self, $class;
+    return $self;
+}
+
+sub parse {
+    my $self = shift;
+    do{
+        use XML::Simple;
+        my $parse  = XML::Simple->new();
+        my $xmlRef = $parse->XMLin("ircd.xml");
+
+        $self->{ip}      = $xmlRef->{'server'}->{'ip'};
+        $self->{port}    = $xmlRef->{'server'}->{'port'};
+        $self->{host}    = $xmlRef->{'ircd'}->{'host'};
+        $self->{network} = $xmlRef->{'ircd'}->{'network'};
+    }
+}
+
+sub getClientByNick {
+    my $self = shift;
+
+}
+
+1;
diff --git a/IRCd/Constants.pm b/IRCd/Constants.pm
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use diagnostics;
+
+package IRCd::Constants;
+
+our %errors = {
+    'RPL_WELCOME'  => 001,
+    'RPL_YOURHOST' => 002,
+    'RPL_CREATED'  => 003,
+    # ...
+    # Errors
+    'ERR_NEEDMOREPARAMS' => 461,
+}
+
+1;
diff --git a/IRCd/Epoll.pm b/IRCd/Epoll.pm
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use diagnostics;
+use IO::Epoll;
+
+package IRCd::Epoll;
+
+sub new {
+    my $class = shift;
+    my $self = {
+            epoll => IO::Epoll::epoll_create(10),
+            sockets => {},
+            listenerSock => shift,
+    };
+    bless $self, $class;
+    $self->addSock($self->{listenerSock});
+    return $self;
+}
+
+sub addSock {
+    my $self = shift;
+    foreach(@_) {
+        IO::Epoll::epoll_ctl($self->{epoll}, IO::Epoll::EPOLL_CTL_ADD(), fileno($_), IO::Epoll::EPOLLIN());
+    }
+}
+sub delSock {
+    my $self = shift;
+    foreach(@_) {
+        IO::Epoll::epoll_ctl($self->{epoll}, IO::Epoll::EPOLL_CTL_DEL(), fileno($_), 1);
+    }
+}
+
+sub removeSock {
+    my $self =  shift;
+    foreach(@_) {
+        IO::Epoll::epoll_ctl($self->{epoll}, IO::Epoll::EPOLL_CTL_DEL(), fileno($_), 1);
+    }
+}
+sub getReadable {
+    my $self = shift;
+    my $result = IO::Epoll::epoll_wait($self->{epoll}, 1024, shift);
+    return $result;
+}
+
+1;
diff --git a/IRCd/Modes/Channel/Op.pm b/IRCd/Modes/Channel/Op.pm
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use diagnostics;
+
+sub new {
+    my $class = shift;
+    my $self  = {
+        'name'     => 'op'
+        'provides' => 'o',
+        'desc'     => 'Provides the +o (op) mode for moderating a channel.',
+        affects    => [],
+        channel    => shift,
+    };
+    bless $self, $class;
+    return $self;
+}
+
+# XXX: Use this
+# XXX: Levels?
+
+sub grant {
+    my $self   = shift;
+    my $client = shift
+    push $self->{affects}->@*, $client;
+}
+sub deop {
+    my $self   = shift;
+    my $client  = shift;
+    @{$self->{affects}} = grep { $_ != $client } @{$self->{affects}};
+}
+
+
+1;