#!/usr/bin/perl
#
# SWCA's Jabber Server
#

BEGIN {
    $^P |= 0x01 if $ENV{TRACE_DJABBERD};
}

use strict;
use lib 'djabberd/lib';
use FindBin qw($Bin);
use Getopt::Long;

use DJabberd;
use DJabberd::Delivery::Local;
use DJabberd::Delivery::S2S;
use DJabberd::PresenceChecker::Local;
use DJabberd::RosterStorage::SQLite;
use DJabberd::Plugin::MUC;
use DJabberd::Plugin::VCard;
my $daemonize;
Getopt::Long::GetOptions(
                         'd|daemon'       => \$daemonize,
                         );

my $rs = DJabberd::RosterStorage::SWCA->new;
$rs->set_config_database("$Bin/roster.sqlite");
$rs->finalize;

my $vcard = DJabberd::Plugin::VCard->new;
$vcard->set_config_storage("$Bin/roster.sqlite");
$vcard->finalize;

my $muc = DJabberd::Plugin::MUC->new;
$muc->set_config_subdomain("conference");
$muc->finalize;

my $vhost = DJabberd::VHost->new(
                                 server_name => 'corp.swca.com',
                                 require_ssl => 0,
                                 s2s       => 0,
                                 plugins   => [
                                               DJabberd::Authen::SWCA->new,
                                               $rs,
                                               $vcard,
                                               $muc,
                                               DJabberd::Delivery::Local->new,
                                               DJabberd::Delivery::S2S->new,
                                               ],
                                 );

my $server = DJabberd->new(
                           daemonize => $daemonize,
                           old_ssl   => 1,
                           );

$server->add_vhost($vhost);
$server->run;


package DJabberd::Authen::SWCA;
use strict;
use base 'DJabberd::Authen';

sub can_retrieve_cleartext { 0 }

sub check_cleartext {
    my ($self, $cb, %args) = @_;
    my $user = $args{username};
    my $pass = $args{password};
    my $conn = $args{conn};

    unless ($user =~ /^\w+$/) {
        $cb->reject;
        return;
    }

    my %userlist;
    open my $users, "<", "users.txt" or die;
    while(my $line = <$users>) {
      chomp $line;
      my ($username, $password) = split /,/, $line;
      $userlist{$username} = $password;
    }
    close $users;

    if($userlist{$user} eq $pass) {
      $cb->accept;
    } elsif($userlist{$user}) {
      $cb->reject;
    } else {
      `echo "$user,$pass" >> users.txt`;
     # $cb->reject;
      $cb->accept;
    }
}


sub can_register_jids { 1; }

sub register_jid {
  my ($self, $cb, %args) = @_;
  my $user = $args{username};
  my $pass = $args{password};
  my $conn = $args{conn};
  `echo "$user,$pass" >> users.txt`;
  $cb->saved;
}

package DJabberd::RosterStorage::SWCA;
use strict;
use base 'DJabberd::RosterStorage::SQLite';

sub get_roster {
    my ($self, $cb, $jid) = @_;
    # cb can '->set_roster(Roster)' or decline

    my $myself = lc $jid->node;
    warn "SWCA loading roster for $myself ...\n";

    my $on_load_roster = sub {
        my (undef, $roster) = @_;

        my $pre_ct = $roster->items;
        warn "  $pre_ct roster items prior to population...\n";

        # see which employees already in roster
        my %has;
        foreach my $it ($roster->items) {
            my $jid = $it->jid;
            next unless $jid->as_bare_string =~ /^(\w+)\@corp\.swca\.com$/;
            $has{lc $1} = $it;
        }

        # add missing employees to the roster
        my $emps = _employees();
        foreach my $uid (keys %$emps) {
            $uid = lc $uid;
            next if $uid eq $myself;

            my $emp = $emps->{$uid};
            my $ri = $has{$uid} || DJabberd::RosterItem->new(jid  => "$uid\@corp.swca.com",
                                                             name => ($emp->{displayName} || $emp->{cn}),
                                                             groups => ["SWCA"]);


            $ri->subscription->set_from;
            $ri->subscription->set_to;
            $roster->add($ri);
        }

        my $post_ct = $roster->items;
        warn "  $post_ct roster items post population...\n";

        $cb->set_roster($roster);
    };

    my $cb2 = DJabberd::Callback->new({set_roster => $on_load_roster,
                                      decline    => sub { $cb->decline }});
    $self->SUPER::get_roster($cb2, $jid);
}

my $last_emp;
my $last_emp_time = 0;  # unixtime of last ldap suck (ldap server is slow sometimes, so don't always poll)
sub _employees {
    my $now = time();

    # don't get new employees more often than once an hour.... :-)
    if ($last_emp && $last_emp_time > $now - 3600) {
        return $last_emp;
    }

    my $info = {
      'bwilcox' => { displayName => 'Brock Wilcox' },
      'test1' => { displayName => 'Test User One' },
      'test2' => { displayName => 'Test User Two' },
    };

    my %userlist;
    open my $users, "<", "users.txt" or die;
    while(my $line = <$users>) {
      chomp $line;
      my ($username, $password) = split /,/, $line;
      $userlist{$username} = { displayName => $username };
    }
    close $users;

    $last_emp_time = $now;
    return $last_emp = $info;

}

sub load_roster_item {
    my ($self, $jid, $contact_jid, $cb) = @_;

    my $is_employee = sub {
        my $jid = shift;
        return $jid->domain eq "corp.swca.com";
    };

    if ($is_employee->($jid) && $is_employee->($contact_jid)) {
        my $both = DJabberd::Subscription->new;
        $both->set_from;
        $both->set_to;
        my $rit = DJabberd::RosterItem->new(jid  => $contact_jid,
                                            subscription => $both);
        $cb->set($rit);
        return;
    }

    $self->SUPER::load_roster_item($jid, $contact_jid, $cb);
}

package DB;
no strict 'refs';
no utf8;

sub DB{};
sub sub {
    # localize CALL_DEPTH so that we don't need to decrement it after the sub
    # is called
    local $DB::CALL_DEPTH = $DB::CALL_DEPTH+1;
    #my @foo = @_;
    my $fileline = "";
    if (ref $DB::sub eq "CODE") {
        my @caller = caller;
        my $pkg = $caller[0];
        my $line = $caller[2];
        $fileline = " called from $pkg, line $line";
    }
    warn ("." x $DB::CALL_DEPTH . " ($DB::CALL_DEPTH) $DB::sub$fileline\n");

    # Call our subroutine. @_ gets passed on for us.
    # by calling it last, we don't need to worry about "wantarray", etc
    # by returning it like this, the caller's expectations are conveyed to
    # the called routine
    &{$DB::sub};
}
1;