Obsolete
/
dnsmanagerv1
Archived
3
0
Fork 0

première version de la lib, application web à finir

* la lib (app actuellement, à renommer) partiellement testée
    permet une utilisation facilitée des différents modules
* l'application dancer permet pour le moment de connecter un
    utilisateur, lister les domaines, ajouter et supprimer un domaine
* les fichiers t/zone* sont des fichiers de tests, et non des exemples
* tpl.zone est un fichier modèle pour une nouvelle zone
master
Philippe Pittoli 2014-01-20 01:08:03 +01:00
parent 2bef4fd845
commit ac41629891
39 changed files with 1830 additions and 16 deletions

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*.swp
sessions

124
app/app.pm Normal file
View File

@ -0,0 +1,124 @@
#!/usr/bin/env perl
use v5.14;
use DBI;
use lib '../';
use app::zone::interface;
use app::zone::edit;
use app::zone::rndc_interface;
use app::bdd::management;
use app::bdd::admin;
use app::bdd::lambda;
package app;
use Moose;
has dbh => ( is => 'rw', builder => '_void');
has dnsi => ( is => 'rw', builder => '_void');
has um => ( is => 'rw', builder => '_void');
has [ qw/zdir dbname dbhost dbport dbuser dbpass sgbd dnsapp/ ] => qw/is ro required 1/;
sub _void { my $x = ''; \$x; }
### users
sub init {
my ($self) = @_;
my $success;
my $dsn = 'DBI:' . $self->sgbd
. ':database=' . $self->dbname
. ';host=' . $self->dbhost
. ';port=' . $self->dbport;
${$self->dbh} = DBI->connect($dsn
, $self->dbuser
, $self->dbpass)
|| die "Could not connect to database: $DBI::errstr";
($success, ${$self->dnsi}) = app::zone::interface ->new()
->get_interface($self->dnsapp, $self->zdir);
die("zone interface") unless $success;
${$self->um} = app::bdd::management->new(dbh => ${$self->dbh});
}
sub auth {
my ($self, $login, $passwd) = @_;
return ${$self->um}->auth($login, $passwd);
}
sub register_user {
my ($self, $login, $passwd) = @_;
return ${$self->um}->register_user($login, $passwd);
}
# TODO
sub set_admin {
my ($self, $login) = @_;
return ${$self->um}->set_admin($login);
}
sub update_passwd {
my ($self, $login, $new) = @_;
my $user = ${$self->um}->get_user($login);
return $user->passwd($new);
}
sub delete_user {
my ($self, $login) = @_;
return ${$self->um}->delete_user($login);
}
### domains
# return yes or no
sub add_domain {
my ($self, $login, $domain) = @_;
my $user = ${$self->um}->get_user($login);
$user->add_domain($domain);
my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir);
$ze->addzone();
}
sub delete_domain {
my ($self, $login, $domain) = @_;
my $user = ${$self->um}->get_user($login);
$user->delete_domain($domain);
my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir);
$ze->del();
}
sub update_domain {
my ($self, $login, $zone, $domain) = @_;
my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir);
$ze->update($zone);
}
sub get_domain {
my ($self, $login, $domain) = @_;
my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir);
$ze->get();
}
sub get_domains {
my ($self, $login) = @_;
my $user = ${$self->um}->get_user($login);
return $user->domains;
}
sub activate_domain {
my ($self, $domain) = @_;
}
sub new_tmp {
my ($self, $login, $domain) = @_;
my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir);
$ze->new_tmp();
}
1;

15
app/bdd/admin.pm Normal file
View File

@ -0,0 +1,15 @@
package app::bdd::admin;
use Moose;
extends 'app::bdd::lambda';
# ($success) activate_zone($domain)
sub activate_zone {
my ($self, $domain) = @_;
}
# ($success) delete_zone($file_path)
sub delete_zone {
my ($self, $domain) = @_;
}
1;

63
app/bdd/lambda.pm Normal file
View File

@ -0,0 +1,63 @@
use autodie;
use v5.14;
use DBI;
use Data::Dump "dump";
use lib '../../';
package app::bdd::lambda;
use Moose;
has qw/domains is rw/;
has [ qw/login dbh/ ] => qw/is ro required 1/;
has passwd => (is => 'rw', trigger => \&_update_passwd );
#has qw/dbh is ro required 1/; # database handler
# $success delete_domain
sub delete_domain {
# check if we are the owner then delete
my ($self, $domain) = @_;
my $sth;
return 0 if (grep { $domain eq $_ } @{ $self->domains }) == 0;
$sth = $self->dbh->prepare('delete from domain where domain=?');
unless ( $sth->execute($domain) ) {
$sth->finish();
return 0;
}
$sth->finish();
@{ $self->domains } = grep { $_ ne $domain } @{ $self->domains };
return 1;
}
sub add_domain {
my ($self, $domain) = @_;
my ($sth);
# TODO vérifier que personne n'a ce domaine, pas seulement l'utilisateur
return 0 if (grep { $domain eq $_ } @{ $self->domains }) > 0;
$sth = $self->dbh->prepare('insert into domain VALUES(?,?,?)');
unless ( $sth->execute($domain, $self->login, 0) ) {
$sth->finish();
return 0;
}
$sth->finish();
push @{ $self->domains }, $domain;
return 1;
}
sub _update_passwd {
my ($self, $new) = @_;
my $sth;
$sth = $self->dbh->prepare('update user set passwd=? where login=?');
unless ( $sth->execute($new, $self->login) ) {
$sth->finish();
return 0;
}
$sth->finish();
return 1;
}
1;

161
app/bdd/management.pm Normal file
View File

@ -0,0 +1,161 @@
use Modern::Perl;
use autodie;
use v5.14;
use DBI;
use lib '../';
use app::bdd::lambda;
use app::bdd::admin;
use app::zone::interface;
package app::bdd::management;
use Moose;
has [qw/dbh/] => qw/is rw required 1/;
# ($success, $user, $admin) auth_user($login, $passwd)
sub auth {
my ($self, $login, $passwd) = @_;
my ($sth, $user, @domains);
$sth = $self->dbh->prepare('SELECT * FROM user WHERE login=? and passwd=?');
unless ( $sth->execute($login, $passwd)) {
$sth->finish();
return 0;
}
if (my $ref = $sth->fetchrow_arrayref) {
$sth = $self->dbh->prepare('SELECT domain FROM domain WHERE login=?');
unless ( $sth->execute($login)) {
$sth->finish();
return 0;
}
# get domains
#push @domains, @$_[0] while($sth->fetchrow_arrayref);
while(my $ref2 = $sth->fetchrow_arrayref) {
push @domains, @$ref2[0];
}
# si admin
if(@$ref[2]) {
# TODO : the admin module
$user = app::bdd::admin->new(login => @$ref[0]
, passwd => @$ref[1]
, dbh => $self->dbh
, domains => [@domains]);
$sth->finish();
return 1, $user, 1;
}
else {
$user = app::bdd::lambda->new(login => @$ref[0]
, passwd => @$ref[1]
, dbh => $self->dbh
, domains => [@domains]);
$sth->finish();
return 1, $user, 0;
}
}
$sth->finish();
return 0;
}
# ($success) register_user
sub register_user {
my ($self, $login, $pass) = @_;
my $sth = $self->dbh->prepare('select * from user where login=?');
unless ( $sth->execute($login) ) {
$sth->finish();
return 0;
}
if (my $ref = $sth->fetchrow_arrayref) {
#say join (', ', @$ref);
$sth->finish();
return 0;
}
$sth = $self->dbh->prepare('insert into user VALUES(?,?,?)');
unless ($sth->execute($login, $pass, 0)) {
$sth->finish();
return 0;
}
$sth->finish();
return 1;
}
# ($success) delete_user
sub delete_user {
my ($self, $login) = @_;
my $sth;
$sth = $self->dbh->prepare('delete from user where login=?');
unless ( $sth->execute($login) ) {
$sth->finish();
return 0;
}
$sth->finish();
$sth = $self->dbh->prepare('delete from domain where login=?');
unless ( $sth->execute($login) ) {
$sth->finish();
return 0;
}
$sth->finish();
return 1;
}
sub get_user {
my ($self, $login) = @_;
my ($sth, $user, @domains);
$sth = $self->dbh->prepare('SELECT * FROM user WHERE login=?');
unless ( $sth->execute($login)) {
$sth->finish();
return 0;
}
if (my $ref = $sth->fetchrow_arrayref) {
$sth = $self->dbh->prepare('SELECT domain FROM domain WHERE login=?');
unless ( $sth->execute($login)) {
$sth->finish();
return 0;
}
# get domains
#push @domains, @$_[0] while($sth->fetchrow_arrayref);
while(my $ref2 = $sth->fetchrow_arrayref) {
push @domains, @$ref2[0];
}
# si admin
if(@$ref[2]) {
$user = app::bdd::admin->new(login => @$ref[0]
, passwd => @$ref[1]
, dbh => $self->dbh
, domains => [@domains]);
}
else {
$user = app::bdd::lambda->new(login => @$ref[0]
, passwd => @$ref[1]
, dbh => $self->dbh
, domains => [@domains]);
}
$sth->finish();
return 1, $user;
}
$sth->finish();
}
1;

165
app/zone/bind_interface.pm Normal file
View File

@ -0,0 +1,165 @@
use Modern::Perl;
use strict;
use warnings;
use Data::Dump "dump";
use v5.14;
use re '/x'; # very important
use lib '../../';
package app::zone::bind_interface;
use Moose;
#use Sudo;
# to know where the zone files are stored / to execute a sudo command
# has [ qw/zone_path sudo_pass/ ] => qw/is ro required 1/;
has [ qw/zone_path/ ] => qw/is ro required 1/;
sub activate_zone {
my ($self, $domain, $admin_file) = @_;
open(my $file, ">>", $admin_file)
or die("error : impossible to open admin file");
}
=pod
zone "karchnu.fr" {
type master;
file "/srv/named/karchnu.fr";
forwarders { 8.8.8.8; };
allow-update { key DDNS\_UPDATER ; };
allow-transfer { any; };
allow-query { any; };
};
zone "0.0.1.0.0.0.0.0.0.0.0.0.0.0.f.c.ip6.arpa" {
type master;
file "/srv/named/karchnu.fr.rv";
allow-update { key DDNS\_UPDATER ; };
allow-transfer { any; };
allow-query { any; };
};
=cut
# TODO
sub update {
my ($self) = @_;
#open(my $process, "service bind9 reload|");
#say while(<$process>);
#close($process);
#my $su = Sudo->new(
# {
# sudo => '/usr/bin/sudo',
# username => 'root',
# password => $self->sudo_pass,
# program => '/usr/bin/service',
# program_args => 'bind9 reload',
# }
#);
# my $result = $su->sudo_run();
# if (exists($result->{error})) {
# return 0;
# }
#
# printf "STDOUT: %s\n",$result->{stdout};
# printf "STDERR: %s\n",$result->{stderr};
# printf "return: %s\n",$result->{rc};
# return 1;
}
sub parse {
my ($self, $file) = @_;
my $fh;
open($fh, "<", $self->zone_path . $file) or return;
my %zone = $self->parse_zone_file($fh) ;
close($fh);
return %zone;
}
sub comment {
my $self = shift;
m{ ^ \s* ; \s* ( .+ ) }
and return { comment => $1 };
}
sub SOA {
my $self = shift;
m{ ^\s* (?<addr> \S+)
\s+ (?<domain> \S+)
\s+ SOA
\s+(?<primary> \S+)
\s+(?<admin> \S+)
\s+ \(
\s*(?<serial> \d+)
\s+(?<refresh> \d+)
\s+(?<retry> \d+)
\s+(?<expire> \d+)
\s+(?<serial> \d+)
\s*
\)
} and return {%+}
}
sub TTL {
my $self = shift;
m{ ^ \s* \$TTL \s+ (\d+) \s* $ }
and return { TTL => $1 }
}
# rocoto IN A 192.168.0.180
# karchnu.fr. IN MX 5 rocoto
# exemple:
# karchnu.fr. IN MX 5 rocoto
sub entry {
my $self = shift;
m{ ^
\s* (?<host> \S+)
\s+ (?<domain> \S+)
(?:
\s+ (?<type> MX)
\s+ (?<check> \S+)
\s+ (?<addr> \S+)
|
\s+ (?<type> A | AAAA | CNAME)
\s+ (?<addr> \S+)
|
\s+ TXT
\s+ "(?<text> \\. | [^"]+)"
)
} and return {%+};
}
sub empty_line {
my $self = shift;
/^ \s* $/x
}
# element must be used without args
# () is very important
sub alias {
my $self = shift;
m{^
\s* \@
\s+ (?<domain> IN )
\s+ (?<type> A | AAAA | NS | MX | SOA )
\s+ (?<alias> .* )
} and return {%+}
}
sub element () {
my $self = shift;
return if empty_line || comment;
SOA || TTL
|| alias
|| entry
|| die "unparsable $_";
}
sub parse_zone_file {
my ($self, $fh) = @_;
map element, <$fh>;
}
1;

107
app/zone/edit.pm Normal file
View File

@ -0,0 +1,107 @@
use Modern::Perl;
use Data::Dump "dump";
use DNS::ZoneParse;
use File::Copy;
use v5.14;
use lib '../../';
use app::zone::rndc_interface;
package app::zone::edit;
use Moose;
has [ qw/zname zdir/ ] => qw/is ro required 1/;
sub get {
my ($self) = @_;
my $file = $self->zdir.'/'.$self->zname;
my $zonefile = DNS::ZoneParse->new($file, $self->zname);
return $zonefile;
}
=pod
copie du template pour créer une nouvelle zone
update du serial
ajout de la zone via rndc
retourne la zone + le nom de la zone
=cut
sub addzone {
my ($self) = @_;
my $tpl = $self->zdir."/tpl.zone";
my $file = $self->zdir.'/'.$self->zname;
$self->_cp($tpl, $file);
my $zonefile = DNS::ZoneParse->new($file, $self->zname);
$zonefile->new_serial(); # update the serial number
# write the new zone file to disk
my $newzone;
open($newzone, '>', $file) or die "error";
print $newzone $zonefile->output();
close $newzone;
my $rndc = app::zone::rndc_interface->new();
$rndc->addzone($self->zdir, $self->zname);
return $zonefile;
}
=pod
màj du serial
push reload de la conf
=cut
sub update {
my ($self, $zonefile) = @_;
# update the serial number
$zonefile->new_serial();
my $file = $self->zdir.'/'.$self->zname;
# write the new zone file to disk
my $newzone;
open($newzone, '>', $file) or die "error";
print $newzone $zonefile->output();
close $newzone;
my $rndc = app::zone::rndc_interface->new();
$rndc->reload($self->zname);
}
# sera utile plus tard, pour l'interface
sub new_tmp {
my ($self) = @_;
my $tpl = $self->zdir."/tpl.zone";
my $file = '/tmp/'.$self->zname;
$self->_cp($tpl, $file);
my $zonefile = DNS::ZoneParse->new($file, $self->zname);
$zonefile->new_serial(); # update the serial number
unlink($file);
return $zonefile;
}
sub _cp {
my ($self, $src, $dest) = @_;
File::Copy::copy($src, $dest) or die "Copy failed: $! ($src -> $dest)";
my $orig = $self->zname;
my $cmd = qq[sed -i "s/CHANGEMEORIGIN/$orig/" $dest 2>/dev/null 1>/dev/null];
system($cmd);
}
sub del {
my ($self) = @_;
my $rndc = app::zone::rndc_interface->new();
$rndc->delzone($self->zdir, $self->zname);
$rndc->reconfig();
}
1;

14
app/zone/interface.pm Normal file
View File

@ -0,0 +1,14 @@
use lib '../../';
use app::zone::bind_interface;
use app::zone::rndc_interface;
package app::zone::interface;
use Moose;
sub get_interface {
my ($self, $type, $zp) = @_;
return 1, app::zone::bind_interface->new(zone_path => $zp) if $type eq 'bind';
return 1, app::zone::rndc_interface->new(zdir => $zp) if $type eq 'rndc';
return 0;
}
1;

View File

@ -0,0 +1,40 @@
use v5.14;
package app::zone::rndc_interface;
use Moose;
# on suppose que tout est déjà mis à jour dans le fichier
sub reload {
my ($self, $zname) = @_;
system("rndc reload $zname 2>/dev/null 1>/dev/null");
}
sub addzone {
my ($self, $zdir, $zname, $opt) = @_;
my $command = "rndc addzone $zname ";
if(defined $opt) {
$command .= "'$opt'";
}
else {
$command .= "'{ type master; file \"$zdir/$zname\"; };'"
}
$command .= " 2>/dev/null 1>/dev/null";
system($command);
}
sub reconfig {
my ($self, $zname) = @_;
system("rndc reconfig 2>/dev/null 1>/dev/null");
}
sub delzone {
my ($self, $zdir, $zname) = @_;
system("rndc delzone $zname 2>/dev/null 1>/dev/null");
unlink("$zdir/$zname");
}
1;

View File

@ -1,20 +1,31 @@
# FR
## trame du projet
## FR trame du projet / TODO / brainstorming / brouillon
> "Faire le projet en POO, pour le rendre un peu modulable (au cas où on change certaines parties en cours de route). Il y aura 2 types d'utilisateurs, l'admin + un utilisateur de base. L'admin peut créer une zone, pas l'utilisateur. L'utilisateur peut juste la modifier."
### page d'inscription
> "L'inscription : l'utilisateur va envoyer une demande pour réserver un ndd en .netlib.re et il faut que ça vérifie que le ndd n'existe pas déjà puis que ça envoie un mail aux admins. De préférence, une page web testera si le ndd est libre, indiquera une erreur à l'utilisateur s'il ne l'est pas et on rajoute un captcha pour éviter des bots."
> "Côté admin : il faut que l'ajout d'une zone soit aussi automatique, pas qu'on ait à aller l'ajouter nous-même (mais ça c'est pour plus tard à la limite). J'ai trouvé quelques modules Perl qui font une partie du travail + je peux faire le site avec Dancer, du coup tout sera fait avec le même langage."
* login
* captcha -- todo
### utilisateurs
* un login
* des domaines
* un mdp chiffré -- todo
* peuvent modifier leurs zones -- todo
* leur compte doit être activé par un admin -- todo
* réservation d'un ou plusieurs ndd en X.DOMAIN.TLD -- todo
* vérifier qu'ils ne sont pas déjà réservés ou attribués -- todo
### admins
* Valident les comptes des utilisateurs. -- todo
* en activant une zone d'un utilisateur. -- todo
* Doit être automatisé. -- todo
* Créent et suppriment d'autres administrateurs. -- todo
* Possèdent une page pour voir les comptes non activés. -- todo
## outils
* [Dancer](http://perldancer.org/)
* [Net::DNS](https://metacpan.org/module/NLNETLABS/Net-DNS-0.72/lib/Net/DNS.pm)
* [Net::DNS::ZoneParse](https://metacpan.org/module/BTIETZ/Net-DNS-ZoneParse-0.103/lib/Net/DNS/ZoneParse.pm)
* [Bootstrap](http://twitter.github.io/bootstrap/)
* [DBD::mysql](https://metacpan.org/module/DBD::mysql)
## TODO
+ "Vérifier si les modules cités dans 'outils' correspondent à ce que l'on cherche."
+ "Aller sur #perlfr pour demander conseil."
+ "Faire des tests d'exemple sur ces modules."
+ "Rajouter les modules qu'il nous manque (ex: pour le chiffrement du mot de passe avant l'ajout d'un utilisateur/admin)."
* [Dancer](http://perldancer.org/)
* [DNS::ZoneParse](http://search.cpan.org/~mschilli/DNS-ZoneParse-1.10/lib/DNS/ZoneParse.pm)
* [Bootstrap](http://twitter.github.io/bootstrap/) -- todo
* [DBD::mysql](https://metacpan.org/module/DBD::mysql)
* [Net::HTTPS::Any](https://metacpan.org/module/IVAN/Net-HTTPS-Any-0.10/lib/Net/HTTPS/Any.pm) -- todo
* [Moose](https://metacpan.org/module/ETHER/Moose-2.0802/lib/Moose.pm)
* voir pour le chiffrement

18
t/tpl.zone Normal file
View File

@ -0,0 +1,18 @@
;
; Database file tpl.zone for tpl.zone. zone.
; Zone version: 2014011815
;
$ORIGIN CHANGEMEORIGIN.
$TTL 3600
@ 3600 IN SOA ns0.netlib.re. postmaster.netlib.re. (
2014011815 ; serial number
3600 ; refresh
600 ; retry
86400 ; expire
600 ; minimum TTL
)
;
; Zone NS Records

28
t/zone_add.pl Executable file
View File

@ -0,0 +1,28 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use lib '../';
use app::zone::rndc_interface;
use app::zone::edit;
my $nom = $ARGV[0];
my $zdir = "/srv/named/";
my $ed = app::zone::edit->new(zdir => $zdir, zname => $nom);
my $zonefile = $ed->addzone();
my $a_records = $zonefile->a();
push (@$a_records, { name => 'www'
, class => 'IN'
, host => '192.168.0.190'
, ttl => ''
, ORIGIN => $zonefile->origin });
$ed->update($zonefile);

17
t/zone_del.pl Executable file
View File

@ -0,0 +1,17 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use lib '../';
use app::zone::rndc_interface;
use app::zone::edit;
my $ed = app::zone::edit->new( zname => $ARGV[0], zdir => "/srv/named/");
say "suppression de ". $ARGV[0];
$ed->del();

32
t/zone_rndc.pl Executable file
View File

@ -0,0 +1,32 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use lib '../';
use app::zone::rndc_interface;
use app::zone::edit;
my $nom = $ARGV[0];
my $zdir = "/srv/named/";
my $ed = app::zone::edit->new(zdir => $zdir, zname => $nom);
my $zonefile = $ed->get();
my $a_records = $zonefile->a();
push (@$a_records, { name => 'web'
, class => 'IN'
, host => '192.168.0.190'
, ttl => '3600'
, ORIGIN => $zonefile->origin });
$ed->update($zonefile);
$zonefile = $ed->get();
print $zonefile->output();

20
t/zone_tmp.pl Executable file
View File

@ -0,0 +1,20 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use lib '../';
use app::zone::rndc_interface;
use app::zone::edit;
my $nom = $ARGV[0];
my $zdir = "/srv/named/";
my $ed = app::zone::edit->new(zdir => $zdir, zname => $nom);
my $zonefile = $ed->new_tmp();
print $zonefile->output();

19
www/MANIFEST Normal file
View File

@ -0,0 +1,19 @@
MANIFEST
bin/app.pl
config.yml
environments/development.yml
environments/production.yml
views/index.tt
views/layouts/main.tt
MANIFEST.SKIP
lib/DNSManager.pm
public/css/style.css
public/css/error.css
public/404.html
public/dispatch.fcgi
public/javascripts/jquery.js
public/dispatch.cgi
public/500.html
t/002_index_route.t
t/001_base.t
Makefile.PL

13
www/MANIFEST.SKIP Normal file
View File

@ -0,0 +1,13 @@
^\.git\/
maint
^tags$
.last_cover_stats
Makefile$
^blib
^pm_to_blib
^.*.bak
^.*.old
^t.*sessions
^cover_db
^.*\.log
^.*\.swp$

21
www/Makefile.PL Normal file
View File

@ -0,0 +1,21 @@
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'DNSManager',
AUTHOR => q{YOUR NAME <youremail@example.com>},
VERSION_FROM => 'lib/DNSManager.pm',
ABSTRACT => 'YOUR APPLICATION ABSTRACT',
($ExtUtils::MakeMaker::VERSION >= 6.3002
? ('LICENSE'=> 'perl')
: ()),
PL_FILES => {},
PREREQ_PM => {
'Test::More' => 0,
'YAML' => 0,
'Dancer' => 1.311,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'DNSManager-*' },
);

4
www/bin/app.pl Executable file
View File

@ -0,0 +1,4 @@
#!/usr/bin/env perl
use Dancer;
use DNSManager;
dance;

11
www/conf/config.ini Normal file
View File

@ -0,0 +1,11 @@
dbname = dnsmanager
host = localhost
# other options : see DBI module
sgbd = mysql
# default port for mysql
port = 3306
user = bla
passwd = HardPass4bla
# possible options for dnsserver : bind rndc
dnsapp = rndc
zones_path = "/srv/named/"

30
www/config.yml Normal file
View File

@ -0,0 +1,30 @@
# This is the main configuration file of your Dancer app
# env-related settings should go to environments/$env.yml
# all the settings in this file will be loaded at Dancer's startup.
# Your application's name
appname: "DNSManager"
# The default layout to use for your application (located in
# views/layouts/main.tt)
layout: "main"
# when the charset is set to UTF-8 Dancer will handle for you
# all the magic of encoding and decoding. You should not care
# about unicode within your app when this setting is set (recommended).
charset: "UTF-8"
# template engine
# simple: default and very basic template engine
# template_toolkit: TT
# template: "simple"
template: "template_toolkit"
engines:
template_toolkit:
encoding: 'utf8'
start_tag: '<%'
end_tag: '%>'
session: "Storable"

View File

@ -0,0 +1,27 @@
# configuration file for development environment
# the logger engine to use
# console: log messages to STDOUT (your console where you started the
# application server)
# file: log message to a file in log/
logger: "console"
# the log level for this environment
# core is the lowest, it shows Dancer's core log messages as well as yours
# (debug, info, warning and error)
log: "core"
# should Dancer consider warnings as critical errors?
warnings: 1
# should Dancer show a stacktrace when an error is caught?
show_errors: 1
# auto_reload is a development and experimental feature
# you should enable it by yourself if you want it
# Module::Refresh is needed
#
# Be aware it's unstable and may cause a memory leak.
# DO NOT EVER USE THIS FEATURE IN PRODUCTION
# OR TINY KITTENS SHALL DIE WITH LOTS OF SUFFERING
auto_reload: 0

View File

@ -0,0 +1,17 @@
# configuration file for production environment
# only log warning and error messsages
log: "warning"
# log message to a file in logs/
logger: "file"
# don't consider warnings critical
warnings: 0
# hide errors
show_errors: 0
# cache route resolution for maximum performance
route_cache: 1

278
www/lib/DNSManager.pm Normal file
View File

@ -0,0 +1,278 @@
package DNSManager;
use Dancer ':syntax';
use strict;
use warnings;
use v5.14;
use Modern::Perl;
use Data::Dump qw( dump );
use Data::Structure::Util qw ( unbless );
use File::Basename;
use Config::Simple;
use Storable qw( freeze thaw );
$Storable::Deparse = true;
$Storable::Eval=true;
# Include other libs relative to current path
use Find::Lib '../../';
use app::app;
my $success;
our $cfg = new Config::Simple(dirname(__FILE__).'/../conf/config.ini');
our $VERSION = '0.1';
get '/' => sub {
if( session('login') )
{
# my ($auth_ok, $user, $admin) =
# $usermanagement->auth( session('login'), session('password') );
my $app = app->new( zdir => $cfg->param('zones_path'),
dbname => $cfg->param('dbname'),
dbhost => $cfg->param('host'),
dbport => $cfg->param('port'),
dbuser => $cfg->param('user'),
dbpass => $cfg->param('passwd'),
sgbd => $cfg->param('sgbd'),
dnsapp => $cfg->param('dnsapp') );
$app->init();
$app->get_domains( session('login') );
template 'index' =>
{ 'logged' => true,
'login' => session('login'),
'admin' => session('admin'),
'domains' => $app->get_domains(session('login'))
};
}
else
{
template 'index';
}
};
post '/login' => sub {
# Check if user is already logged
unless ( session('login') )
{
# Check user login and password
if ( param('login') && param('password') )
{
my $app = app->new( zdir => $cfg->param('zones_path'),
dbname => $cfg->param('dbname'),
dbhost => $cfg->param('host'),
dbport => $cfg->param('port'),
dbuser => $cfg->param('user'),
dbpass => $cfg->param('passwd'),
sgbd => $cfg->param('sgbd'),
dnsapp => $cfg->param('dnsapp') );
$app->init();
my ($auth_ok, $user, $isadmin) = $app->auth(param('login'),
param('password') );
if( $auth_ok )
{
session login => param('login');
# TODO : change password storage…
session password => param('password');
session user => freeze( $user );
session admin => $isadmin;
}
else
{
# User login and/or password are incorrect
}
}
}
redirect '/';
};
get '/mapage' => sub {
unless( session('login') )
{
redirect '/';
}
else
{
# my ($auth_ok, $user, $admin) =
# $usermanagement->auth( session('login'), session('password') );
my $app = app->new( zdir => $cfg->param('zones_path'),
dbname => $cfg->param('dbname'),
dbhost => $cfg->param('host'),
dbport => $cfg->param('port'),
dbuser => $cfg->param('user'),
dbpass => $cfg->param('passwd'),
sgbd => $cfg->param('sgbd'),
dnsapp => $cfg->param('dnsapp') );
$app->init();
my %domains = ();
my %zone_properties = ();
my @d = @{$app->get_domains( session('login') )};
# loop on domains
#foreach( @{ $app->get_domains( session('login') )} )
#{
# my @zones = ();
# # TODO
# foreach my $zone ( $app->get_domain($_)->output() )
# {
# # avoid some var
# # keep only hash type
# if( ref($zone) eq 'HASH' )
# {
# if( $zone->{'addr'} )
# {
# unless( $zone->{'addr'} eq '@' )
# {
# # normal zone, push it
# push( @zones, $zone );
# }
# else
# {
# # domain properties
# $zone_properties{$_} = $zone;
# }
# }
# }
# }
# $domains{$_} = [ @zones ];
#}
#my @keys = keys(%domains);
#print "key : $_ value : $domains{$_}\n" foreach(@keys);
# foreach my $k ( keys %domains) {
# foreach my $v ( keys @{ $domains{$k} } ) {
# #print "dump : ".dump( $v )."\n";
# if( UNIVERSAL::isa($domains{$k}[$v], "HASH" ) )
# {
# print "hash...\n";
# print "start ------\n";
# print "$_ => $domains{$k}[$v]{$_}\n" foreach( keys $domains{$k}[$v] );
# print "end ------\n\n";
# }
# print "value : " . dump( $domains{$k}[$v] ) . "\n";
# }
# }
#print 'manual dump : ' . dump( $domains{'karchnu.fr'} )."\n";
#print 'prop dump : ' . dump( %zone_properties ) . "\n";
template 'mapage' =>
{ 'login' => session('login'),
'domains' => $app->get_domains(session('login')),
'zones_domains' => \%domains,
'zone_properties' => \%zone_properties,
'admin' => session('admin') };
}
};
get '/details' => sub {
# check if user is logged & if domain parameter is set
unless( session('login') && param('domain'))
{
redirect '/';
}
else
{
# my ($auth_ok, $user, $admin) =
# $usermanagement->auth( session('login'), session('password') );
my $app = app->new( zdir => $cfg->param('zones_path'),
dbname => $cfg->param('dbname'),
dbhost => $cfg->param('host'),
dbport => $cfg->param('port'),
dbuser => $cfg->param('user'),
dbpass => $cfg->param('passwd'),
sgbd => $cfg->param('sgbd'),
dnsapp => $cfg->param('dnsapp') );
$app->init();
my ($auth_ok, $user, $isadmin) = $app->auth( param('login') );
my @zones = ();
my $zone_properties;
#say 'dump : ' . dump $user->get_zone( param('domain') );
for( $user->get_zone( param('domain') ) ) {
if( ref($_) eq 'HASH' and exists $_->{addr} ) {
push( @zones, $_ ) when $_->{addr} ne '@';
$zone_properties = $_ when $_->{addr} eq '@';
}
}
template 'details' =>
{ 'login' => session('login'),
'domain' => param('domain'),
'zones' => \@zones,
'zone_properties' => $zone_properties };
}
};
any ['get', 'post'] => '/administration' => sub {
unless( session('login') )
{
redirect '/';
}
else
{
template 'administration' =>
{ 'login' => session('login'),
'admin' => session('admin') };
}
};
any ['post', 'get'] => '/logout' => sub {
session->destroy;
redirect '/';
};
get '/domainadd' => sub {
# check if user is logged & if domain parameter is set
unless( session('login') )
{
redirect '/';
}
else
{
my $app = app->new( zdir => $cfg->param('zones_path'),
dbname => $cfg->param('dbname'),
dbhost => $cfg->param('host'),
dbport => $cfg->param('port'),
dbuser => $cfg->param('user'),
dbpass => $cfg->param('passwd'),
sgbd => $cfg->param('sgbd'),
dnsapp => $cfg->param('dnsapp') );
$app->init();
if( param('domain') )
{
# create domain
$app->add_domain( session('login'), param('domain') );
# Then, redirect to mapage
redirect '/mapage';
}
}
};
get qr{/domaindel/(.*)} => sub {
my ($domainToDelete) = splat;
my $app = app->new( zdir => $cfg->param('zones_path'),
dbname => $cfg->param('dbname'),
dbhost => $cfg->param('host'),
dbport => $cfg->param('port'),
dbuser => $cfg->param('user'),
dbpass => $cfg->param('passwd'),
sgbd => $cfg->param('sgbd'),
dnsapp => $cfg->param('dnsapp') );
$app->init();
$app->delete_domain(session('login'), $domainToDelete);
redirect '/mapage';
}

20
www/notes.txt Normal file
View File

@ -0,0 +1,20 @@
Développement web :
1. Créer la page d'accueil
- doit fournir un lien vers la page de login ;
- permet la recherche d'un nom de domaine ;
- s'il n'est pas disponible, proposer des choix alternatifs (secondaire) ;
2. Page de login
- doit vérifier si l'utilisateur existe bien dans la base de donnée ;
- cf méthode dnsmanager::auth ;
- si l'utilisateur est un administrateur, fournir un lien supplémentaire vers la page d'administration ;
- cf lire le résultat renvoyé par auth (contient la liste des données de l'utilisateur stockés en bdd ;
- la page d'administration doit refuser un non administrateur ;
3. Permettre à l'utilisateur de pouvoir visualiser ses zones, d'en demander de nouvelles ;
- cf get_zone function ;
- add_zone (doit envoyer une demande aux admins) ;
4. Créer la page d'administration
- doit fournir la possibilité de valider la création d'un utilisateur ;

18
www/public/404.html Normal file
View File

@ -0,0 +1,18 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<title>Error 404</title>
<link rel="stylesheet" href="/css/error.css" />
<meta http-equiv="Content-type" content="text/html; charset=UTF-8" />
</head>
<body>
<h1>Error 404</h1>
<div id="content">
<h2>Page Not Found</h2><p>Sorry, this is the void.</p>
</div>
<div id="footer">
Powered by <a href="http://perldancer.org/">Dancer</a>.
</div>
</body>
</html>

18
www/public/500.html Normal file
View File

@ -0,0 +1,18 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<title>Error 500</title>
<link rel="stylesheet" href="/css/error.css" />
<meta http-equiv="Content-type" content="text/html; charset=UTF-8" />
</head>
<body>
<h1>Error 500</h1>
<div id="content">
<h2>Internal Server Error</h2><p>Wooops, something went wrong</p>
</div>
<div id="footer">
Powered by <a href="http://perldancer.org/">Dancer</a>.
</div>
</body>
</html>

70
www/public/css/error.css Normal file
View File

@ -0,0 +1,70 @@
body {
font-family: Lucida,sans-serif;
}
h1 {
color: #AA0000;
border-bottom: 1px solid #444;
}
h2 { color: #444; }
pre {
font-family: "lucida console","monaco","andale mono","bitstream vera sans mono","consolas",monospace;
font-size: 12px;
border-left: 2px solid #777;
padding-left: 1em;
}
footer {
font-size: 10px;
}
span.key {
color: #449;
font-weight: bold;
width: 120px;
display: inline;
}
span.value {
color: #494;
}
/* these are for the message boxes */
pre.content {
background-color: #eee;
color: #000;
padding: 1em;
margin: 0;
border: 1px solid #aaa;
border-top: 0;
margin-bottom: 1em;
}
div.title {
font-family: "lucida console","monaco","andale mono","bitstream vera sans mono","consolas",monospace;
font-size: 12px;
background-color: #aaa;
color: #444;
font-weight: bold;
padding: 3px;
padding-left: 10px;
}
pre.content span.nu {
color: #889;
margin-right: 10px;
}
pre.error {
background: #334;
color: #ccd;
padding: 1em;
border-top: 1px solid #000;
border-left: 1px solid #000;
border-right: 1px solid #eee;
border-bottom: 1px solid #eee;
}

189
www/public/css/style.css Normal file
View File

@ -0,0 +1,189 @@
body {
margin: 0;
margin-bottom: 25px;
padding: 0;
background-color: #ddd;
background-image: url("/images/perldancer-bg.jpg");
background-repeat: no-repeat;
background-position: top left;
font-family: "Lucida Grande", "Bitstream Vera Sans", "Verdana";
font-size: 13px;
color: #333;
}
h1 {
font-size: 28px;
color: #000;
}
a {color: #03c}
a:hover {
background-color: #03c;
color: white;
text-decoration: none;
}
#page {
background-color: #ddd;
width: 750px;
margin: auto;
margin-left: auto;