#! /usr/bin/perl
#
# For now, this is a CGI using Perl.
#

use warnings;
use strict;

## User configurable settings:

# What's the name of this server?
our $servername = "Mumble - Jeuxlinux.fr";

# Who should outgoing authentication emails be from?
our $emailfrom = "mumble\@jeuxlinux.fr";

# And what server should be used?
our $emailserver = "localhost";

# Which server to add to? Unless you have multiple virtual servers,
# this is always 1
our $serverid = 1;

## End of user configurable data
##
## Really. You shouldn't touch anything below this point.

# If we're being run as a CGI in suexec, $HOME doesn't exist. Fake it.
my $home = (getpwuid($<))[7];

# This needs to be done before "use Net::DBus"
if (open(F, "$home/murmur/.dbus.sh")) {
  while(<F>) {
    chomp();
    if ($_ =~ /^(.+?)\='(.+)';$/) {
      $ENV{$1}=$2;
    }
  }
  close(F);
}

use CGI;
use CGI::Carp 'fatalsToBrowser';
use CGI::Session;
use Net::SMTP;
use Net::DNS;
use Net::DBus;
use Image::Magick;
use Compress::Zlib;
use Config::Simple;

sub randomCode($) {
  my ($length) = @_;
  my $ret;
  my $chars="0123456789abcdefghjiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
 
  for(my $i=0;$i<$length;$i++) {
    $ret .= substr($chars, rand(int(length($chars))), 1);
  }
  return $ret;
}

my $showit = 1;

CGI::Session->find( sub { } );

my $q = new CGI();
my $s = new CGI::Session();

$s->expire('+1d');

print $s->header();
print $q->start_html(-title=>"Inscription");

my $bus;
my $service;

# First try the system bus
eval {
  $bus=Net::DBus->system();
  $service = $bus->get_service("net.sourceforge.mumble.murmur");
  
  my $cfg = new Config::Simple(filename => '/etc/mumble-server.ini', syntax => 'simple');
  $servername = $cfg->param("registerName") || $servername;
  $emailfrom = $cfg->param("emailfrom") || $emailfrom;
};

# If that failed, the session bus
if (! $service) {
  eval {
    $bus = Net::DBus->session();
    $service = $bus->get_service("net.sourceforge.mumble.murmur");
  }
}

die "Murmur service not found" if (! $service);

if (! defined($emailfrom) || ($emailfrom eq "")) {
  croak(qq{Missing configuration. 
  Please edit either /etc/mumble-server.ini for systemwide installations,
  or murmur.pl for a personal one.
  });
}


# Fetch handle to remote object
my $object = $service->get_object("/$serverid");
my $res;

my $auth = $q->param('auth');
my $name = $q->param('name');
my $pw = $q->param('pw');
my $email = $q->param('email');
my $image = $q->upload('image');

if (defined($s->param('auth')) && ($auth eq $s->param('auth'))) {
  $res = $object->getRegisteredPlayers($s->param('name'));
  if ($#{$res} == 0) {
    my $aref = $$res[0];
    if ($email ne $$aref[2]) {
      $$aref[3] = $s->param('pw');
      $object->updateRegistration($aref);
      print "<h1>Mot de passe mis à jour</h1><p>Votre mot de passe a &eacute;t&eacute; r&eacute;initialis&eacute;.</p>";
      $showit = 0;
    } else {
      print "<h1>Echec !</h1><p>L'adresse mail et identifiant ne correspondent pas.</p>";
    }
  } else {
    $res = $object->registerPlayer($s->param('name'));
    if (($res != 0) && ($res != "0")) { 
      my @array = ($res, $s->param('name'), $s->param('email'), $s->param('pw'));
      $object->updateRegistration(\@array);
      print "<h1>Inscription effectu&eacute;e</h1><p>Merci de vous &ecirc;tres enregistr&eacute;.</p>";
      $showit = 0;
    } else {
      print "<h1>Echec !</h1><p>L'identifiant a &eacute;t&eacute; refus&eacute; par le serveur.</p>";
    }
  }
  $s->clear();
} elsif (defined($name) && defined($pw) && defined($image)) {
   my $id = $object->getPlayerIds( [ $name ] );
   $res = $object->verifyPassword($$id[0], $pw);
   if (! $res) {
     print "<h1>Inscription valid&eacute;e</h1><p>Maintenant vous pouvez vous connecter au serveur.</p>";
   } else {
     my $blob;
     sysread($image,$blob,1000000);
     my $image=Image::Magick->new();
     my $r=$image->BlobToImage($blob);
     if (! $r) {
       $image->Extent(x => 0, y => 0, width => 600, height => 60);
       my $out=$image->ImageToBlob(magick => 'rgba', depth => 8);
       if (length($out) == (600*60*4)) {
         # We need BGRA, AKA ARGB inverse
         my @a=unpack("C*", $out);
         for(my $i=0;$i<600*60;$i++) {
           my $red=$a[$i*4];
           my $blue=$a[$i*4+2];
           $a[$i*4]=$blue;
           $a[$i*4+2]=$red;
         }
         @a=unpack("C*", pack("N", $#a + 1) . compress(pack("C*",@a)));
         $res = $object->setTexture($$id[0], \@a);
       } else {
         $r=1;
       }
     }
     if ($r) {
        print "<h1>Image failure</h1><p>Failed to convert that to a proper image.</p>";
     } else {
        print "<h1>Succeeded</h1><p>Reconnect to use the new image.</p>";
        $showit = 0;
     }
   }
} elsif (defined($name) && defined($pw) && defined($email)) {
  my @errors;

  if (length($name) < 4) {
    push @errors, "L'identifiant est trop court.";
  }
  if (length($pw) < 6) {
    push @errors, "Le mot de passe est trop court.";
  }
  if ($name !~ /^[0-9a-zA-Z\(\)\[\]\-\_]+$/) {
    push @errors, "L'identifiant contient des carat&egrave;res interdits.";
  }
  
  if ($email !~ /^[0-9a-zA-Z\.\-\_]+\@(.+)$/) {
    push @errors, "L'adresse mail ne semble pas valide.";
  } else {
    my @mx = mx($1); 
    if ($#mx == -1) {
      push @errors, "L'adresse mail ne semble pas valide.";
    }
  }

  $res=$object->getRegisteredPlayers($name);
  if ( $#{$res} == 0 ) {
    my $aref = $$res[0];
    if ($email ne $$aref[2]) {
      push @errors, "Cet identifiant est d&eacute;j&egrave; utilis&eacute;.";
    }
  }
  
  if ($#errors == -1) {
    my $code = randomCode(10);

    $s->param('name', $name);
    $s->param('pw', $pw);
    $s->param('email', $email);
    $s->param('auth', $code);
    
    my $smtp = new Net::SMTP($emailserver);
    if (! $smtp) {
      croak(qq{Failed to connect to SMTP server "$emailserver". This is most likely a configuration problem.\n});
    }
    $smtp->mail($emailfrom);
    $smtp->to($email);
    $smtp->data();
    $smtp->datasend("From: $emailfrom\n");
    $smtp->datasend("To: $email\n");
    $smtp->datasend("Subject: Inscription au serveur Murmur de jeuxlinux.fr\n");
    $smtp->datasend("\n");
    $smtp->datasend("Un utilisateur avec l'adresse $ENV{'REMOTE_ADDR'} a enregistré le pseudo $name\n");
    $smtp->datasend("sur \"${servername}\".\n\n");
    $smtp->datasend("Si vous êtes cet utilisateur, cliquez sur le lien suivant pour valider l'inscription:\n");
    $q->delete_all();
    $q->param('auth', $code);
    $smtp->datasend($q->url(-query=>1));
    $smtp->datasend("\n\n");
    $smtp->datasend("Si ce message ne vous concerne pas, merci de ne pas en tenir compte.");
    $smtp->dataend();
    
    print '<h1>Inscription compl&eacute;t&eacute;e</h1><p>Merci de vous &ecirc;tres enregistr&eacute;. Un email vous a &eacute;t&eacute; envoy&eacute; ';
    print 'avec un code d\'activation.</p>';
    $showit = 0;
  } else {
    print '<ul>';
    foreach my $error (@errors) {
      print "<li>$error</li>";
    }
    print '</ul>';
  }
} 

if ($showit) {
  print '<h1>Formulaire d\'inscription</h1>';
  print '<p>Choisissez un identifiant et un mot de passe et indiquez votre adresse e-mail actuelle. ';
  print 'Un mail vous sera envoy&eacute; avec un code d\'authentification.</p>';
  print '<p>';
  print 'Si vous avez oubli&eacute; votre mot de passe, il suffit de vous r&eacute;enregistrer avec le m&ecirc;me identifiant et ';
  print 'votre adresse e-mail. Un nouveau message de confirmation sera envoy&eacute;.</p><br>';

  print $q->start_form(-method=>'POST');
  print "Identifiant: \n";
  print $q->textfield(-name=>'name', -size=>'20');
  print "<br>Email: \n";
  print $q->textfield(-name=>'email', -size=>'20');
  print "<br>Mot de passe: \n";
  print $q->password_field(-name=>'pw', -size=>'20');
  print '<br>';
  print $q->submit(-value=>'Enregistrer');
  print $q->end_form();
}

print "<br /><br /><br />Les utilisateurs enregistr&eacute;s peuvent cr&eacute;er leur propre chan dans la partie \"Vos Salons\" du serveur.\n";
print $q->end_html();