#    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/>.
 
 
#!/usr/bin/perl
use IO::Socket;
use Net::hostent;
use Digest::MD5  qw(md5_hex);
 
##########################################################################################
# These are configuration variables for your BBS system. Modify these to fit your needs. #
##########################################################################################
 
$port = 23; # Pick something not in use (Ports under 1024 may require super-user privileges on some systems.)
$connect_msg = "Welcome to the insomnia 24/7 BBS,"; # This is shown to the user when (s)he connects.
$version = "0.9.1 BETA."; # Version number.
$login_msg = "Must login first!"; # Message shown when user tries to do something that requires logging in.
$regfail = "Registration aborted."; # Message show for failure during user registration.
$logfail = "Login failed."; # Message shown on failed login.
$dropfail = "You do not have the privileges needed to drop this username."; # Messages shown on failed attempt at dropping user.
$blankpass = "Password may not be blank!";
$telmsg = 1; # Show message about backspace usage on connect. (1 = on, 0 = off)
$helpmsg = 1; # Show help command message on connect. (1 = on, 0 = off)
$showusers = 1; # Show number of registered users on connect. (1 = on, 0 = off)
 
 
###############################################################################################################
# Do not modify anything under here unless you know what you're doing. You might end up with a broken system! #
###############################################################################################################
 
print "Starting BBS system\n";
$user = "NOUSER";
@months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
$server = IO::Socket::INET->new(
                                Proto     => 'tcp',
                                LocalPort => $port,
                                Listen    => SOMAXCONN,
                                Reuse     => 1
                                );
 
die "ERROR: Can't start BBS!" unless $server;
print "Accepting connections on port $port.\n";
 
while ($client = $server->accept()) {
    my $pid = fork();
    $SIG{CHLD} = 'IGNORE';
    die "ERROR: Cannot fork!" unless defined $pid;
    do { close $client; next; }
    if $pid; # Parent thread.
 
    # Fall through in child process.
    $client->autoflush(1);
    print $client "\r\n$connect_msg v$version\r\n";
    if ($telmsg == 1 ) {
        print $client "Some telnet clients are not too good with backspaces,\r\navoid them during registration and login.\r\n";
    }
    if ($helpmsg == 1) {
        print $client "Type help for command list.\r\n";
    }
    if ($showusers == 1) {
        my $usercount = 0;
        open (USERCOUNT, 'bbs.user');
        while (<USERCOUNT>) { $usercount++;}
        close (USERCOUNT);
        print $client "There are currently $usercount registered users.\r\n";
    }
 
    print $client "\r\n";
    print $client "Command: ";
 
    while ( <$client>) {
        next unless /\S/;       # Ignore blank lines.
        if    (/quit|exit/i)   { exit;kill; }
        elsif (/read/i)         { &read; }
        elsif (/post/i)         { &post; }
        elsif (/drop(.+)/i)         { 
            my @args = split(' ', $1);
            &drop($args[0]);
        }
        elsif (/login(.+)/i)    { 
            my @args = split(' ', $1);
            &login($args[0],$args[1]);
        }
        elsif (/passwd(.+)/i)    { 
            my @args = split(' ', $1);
            &passwd($args[0]);
        }
        elsif (/register(.+)/i) {
            my @args = split(' ', $1);
            &register($args[0],$args[1]);
        } else {    # If no known command was given, print help.
            print $client "\r\n  Command       Usage                         Function\r\n";
            print $client "  -------------------------------------------------------------------\r\n";
            print $client "  register      register username password    Register new user.\r\n";
            print $client "  login         login username password       Login as existing user.\r\n";
            print $client "  passwd        passwd new_password           Change your password.\r\n";
            print $client "  drop          drop username                 Delete user.\r\n";
            print $client "  read          read                          Read current posts.\r\n";
            print $client "  post          post                          Make new post.\r\n";
            print $client "  quit          quit OR exit                  Exit program.\r\n\n";
        }
    } continue {
        print $client "Command: ";
    }
close $client;
}
 
 
##############
# Read posts #
##############
 
sub read() {
    print $client "reading...\r\n";
    open (MYFILE, 'bbs.data');
    while (<MYFILE>) {
        chomp;
        print $client "$_\r\n";
    }
    close (MYFILE);
}
 
 
###################
# Create new post #
###################
 
sub post() {
    if ($user =~ "NOUSER") {
        print $client "$login_msg\r\n";
    } else {
        print $client "Posting. End your post by typing \"END\" on a single line.\r\n";
        &getTime;
        @post = "----- $user -----\r\n----- $theTime -----\r\n";
        $count = 1;
        while($client) {
            $input = <$client>;
            if ($input =~ m/^END/) {
                $post[$count] = "----- END OF POST -----\r\n\r\n";
                open (MYFILE, '>>bbs.data');
                foreach(@post){
                    print MYFILE "$_";
                }
                close(MYFILE);
                last;
            } else {
                $post[$count] = $input;
                $count++;
            }
        }
    }
}
 
 
##########################
# Drop user [deprecated] #
##########################
 
sub drop_old() {
    if ($user =~ "NOUSER") {
         print $client "$login_msg\r\n";
    } else {
        if ($user =~ $_[0]) {
            my @userfile;
            my $counter = 0;
            open (MYFILE, 'bbs.user');
            while(<MYFILE>) {
                $userfile[$counter] = $_;
                $counter++;
            }
            close (MYFILE);
            $counter = 0;
            foreach (@userfile) {
                if ($userfile[$counter] =~ m/^$user /i) { $foundon = $counter; }
                $counter++;
            }
            my $times = $counter - $foundon;
            while ($times > 0) {
                $userfile[$foundon] = $userfile[$foundon + 1];
                $foundon++;
                $times--; 
            }
            $count = 0;
            open (NEWUSER, '>bbs.user');
            while ( $counter-1 > 0 ) {
                print NEWUSER "$userfile[$count]";
                $counter--;
                $count++;
            }
            close(NEWUSER);
            $user = "NOUSER";
            print $client "$_[0] was dropped.\r\n";
        } else {
            print $client "$dropfail\r\n";
        }
    }
}
 
 
#############
# Drop user #
#############
 
sub drop() {
    if ($user =~ "NOUSER") {
         print $client "$login_msg\r\n";
    } else {
        if ($user =~ $_[0]) {
            my @userfile;
            my $counter = 0;
            open (MYFILE, 'bbs.user');
            while(<MYFILE>) {
                $userfile[$counter] = $_;
                $counter++;
            }
            close (MYFILE);
            $counter = 0;
            foreach ( @userfile ) {
                if ($userfile[$counter] =~ m/^$user /i) { $foundon = $counter; }
                $counter++;
            }
            open (NEWUSER, '>bbs.user');
            $count = 0;
            foreach ( @userfile ) {
                if ($count != $foundon) {
                    print NEWUSER "$_";
                }
                $count++;
            }
            close(NEWUSER);
            $user = "NOUSER";
            print $client "$_[0] was dropped.\r\n";
        } else {
            print $client "$dropfail\r\n";
        }
    }
}
 
 
###################
# Change password #
###################
 
sub passwd() {
    if ($user =~ "NOUSER") {
         print $client "$login_msg\r\n";
    } else {
        if (!$_[0]) {
            print $client "$blankpass\r\n";
        } else {
            my @userfile;
            my $newpass = md5_hex $_[0];
            my $counter = 0;
            open (MYFILE, 'bbs.user');
            while(<MYFILE>) {
                $userfile[$counter] = $_;
                $counter++;
            }
            close (MYFILE);
            $counter = 0;
            foreach (@userfile) {
                if ($userfile[$counter] =~ m/^$user /i) { $foundon = $counter; }
                $counter++;
            }
            $userfile[$foundon] = "$user $newpass\n";
            open (NEWUSER, '>bbs.user');
            foreach (@userfile) {
                print NEWUSER "$_";
            }
            close(NEWUSER);
            print $client "Password changed for $user.\r\n";
        }
    }
}
 
 
################################
# Login procedure [deprecated] #
################################
 
sub login_old() {
    print $client "Enter username: ";
    while($client) {
        $user = <$client>;
        $user =~ s/\r\n//;
        if ($user eq "") {
            print $client "No username received!\r\n";
            $user = "NOUSER";
            last;
        }
        else {
            print $client "User set to: $user\r\n";
            last;
        }
    }
}
 
 
#####################
# Grab current time #
#####################
 
sub getTime() {
    ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek) = localtime();
    $year = 1900 + $yearOffset;
    $theTime = "$hour:$minute:$second, $weekDays[$dayOfWeek] $months[$month] $dayOfMonth, $year";
}
 
 
#####################
# Register new user #
#####################
 
sub register() {
    my $inUse = 0;
    if (!$_[1]) { $inUse = 2; }
    if (!$_[0]) {
        $inUse = 3;
    } else {
        open (MYFILE, 'bbs.user');
        while (<MYFILE>) {
            chomp;
            if ($_ =~ m/^$_[0]/i) {
                $inUse = 1;
            }
        }
        close (MYFILE);
    }
 
    if ($inUse == 1) {
        print $client "Name already in use. $regfail\r\n";
    } elsif ($inUse == 2) {
        print $client "No password received. $regfail\r\n";
    } elsif ($inUse == 3) {
        print $client "No username received. $regfail\r\n";
    } else {
        close (MYFILE);
        my $pass = md5_hex $_[1];
        open (MYFILE, '>>bbs.user');
        print MYFILE "$_[0] $pass\n";
        close(MYFILE);
        print $client "Username $_[0] registered.\r\n";
        $user = $_[0];
        print $client "Logged in with new user.\r\n";
    }
}
 
 
###################
# Login procedure #
###################
 
sub login() {
    my $loginFail = 2;
    open (MYFILE, 'bbs.user');
        while (<MYFILE>) {
            chomp;
            if ($_ =~ m/^$_[0] (.+)/) {
                $loginFail = 0;
                $storedPass = $1;
            }
        }
    close (MYFILE);
 
    if (!$_[1]) {
        $loginFail = 1;
    } else {
        my $inputPass = md5_hex $_[1];
        if ($inputPass !~ $storedPass) {$loginFail = 3;}
    }
 
    if ($loginFail == 1) {
        print $client "No password received. $logfail\r\n";
    } elsif ($loginFail == 2) {
        print $client "User not found. $logfail\r\n";
    } elsif ($loginFail == 3) {
        print $client "Wrong password. $logfail\r\n";
    } else {
        $user = $_[0];
        print $client "Logged in as $user.\r\n";
    }
}