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
parent
2bef4fd845
commit
ac41629891
|
|
@ -0,0 +1,2 @@
|
|||
*.swp
|
||||
sessions
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
43
readme.md
43
readme.md
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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);
|
||||
|
|
@ -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();
|
||||
|
|
@ -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();
|
||||
|
|
@ -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();
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
^\.git\/
|
||||
maint
|
||||
^tags$
|
||||
.last_cover_stats
|
||||
Makefile$
|
||||
^blib
|
||||
^pm_to_blib
|
||||
^.*.bak
|
||||
^.*.old
|
||||
^t.*sessions
|
||||
^cover_db
|
||||
^.*\.log
|
||||
^.*\.swp$
|
||||
|
|
@ -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-*' },
|
||||
);
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
#!/usr/bin/env perl
|
||||
use Dancer;
|
||||
use DNSManager;
|
||||
dance;
|
||||
|
|
@ -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/"
|
||||
|
|
@ -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"
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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';
|
||||
}
|
||||
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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>
|
||||
|
|
@ -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>
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
@ -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;
|
||||
padding-left: 0px;
|
||||
margin-right: auto;
|
||||
}
|
||||
|
||||
#content {
|
||||
background-color: white;
|
||||
border: 3px solid #aaa;
|
||||
border-top: none;
|
||||
padding: 25px;
|
||||
width: 500px;
|
||||
}
|
||||
|
||||
#sidebar {
|
||||
float: right;
|
||||
width: 175px;
|
||||
}
|
||||
|
||||
#header, #about, #getting-started {
|
||||
padding-left: 75px;
|
||||
padding-right: 30px;
|
||||
}
|
||||
|
||||
|
||||
#header {
|
||||
background-image: url("/images/perldancer.jpg");
|
||||
background-repeat: no-repeat;
|
||||
background-position: top left;
|
||||
height: 64px;
|
||||
}
|
||||
#header h1, #header h2 {margin: 0}
|
||||
#header h2 {
|
||||
color: #888;
|
||||
font-weight: normal;
|
||||
font-size: 16px;
|
||||
}
|
||||
|
||||
#about h3 {
|
||||
margin: 0;
|
||||
margin-bottom: 10px;
|
||||
font-size: 14px;
|
||||
}
|
||||
|
||||
#about-content {
|
||||
background-color: #ffd;
|
||||
border: 1px solid #fc0;
|
||||
margin-left: -11px;
|
||||
}
|
||||
#about-content table {
|
||||
margin-top: 10px;
|
||||
margin-bottom: 10px;
|
||||
font-size: 11px;
|
||||
border-collapse: collapse;
|
||||
}
|
||||
#about-content td {
|
||||
padding: 10px;
|
||||
padding-top: 3px;
|
||||
padding-bottom: 3px;
|
||||
}
|
||||
#about-content td.name {color: #555}
|
||||
#about-content td.value {color: #000}
|
||||
|
||||
#about-content.failure {
|
||||
background-color: #fcc;
|
||||
border: 1px solid #f00;
|
||||
}
|
||||
#about-content.failure p {
|
||||
margin: 0;
|
||||
padding: 10px;
|
||||
}
|
||||
|
||||
#getting-started {
|
||||
border-top: 1px solid #ccc;
|
||||
margin-top: 25px;
|
||||
padding-top: 15px;
|
||||
}
|
||||
#getting-started h1 {
|
||||
margin: 0;
|
||||
font-size: 20px;
|
||||
}
|
||||
#getting-started h2 {
|
||||
margin: 0;
|
||||
font-size: 14px;
|
||||
font-weight: normal;
|
||||
color: #333;
|
||||
margin-bottom: 25px;
|
||||
}
|
||||
#getting-started ol {
|
||||
margin-left: 0;
|
||||
padding-left: 0;
|
||||
}
|
||||
#getting-started li {
|
||||
font-size: 18px;
|
||||
color: #888;
|
||||
margin-bottom: 25px;
|
||||
}
|
||||
#getting-started li h2 {
|
||||
margin: 0;
|
||||
font-weight: normal;
|
||||
font-size: 18px;
|
||||
color: #333;
|
||||
}
|
||||
#getting-started li p {
|
||||
color: #555;
|
||||
font-size: 13px;
|
||||
}
|
||||
|
||||
#search {
|
||||
margin: 0;
|
||||
padding-top: 10px;
|
||||
padding-bottom: 10px;
|
||||
font-size: 11px;
|
||||
}
|
||||
#search input {
|
||||
font-size: 11px;
|
||||
margin: 2px;
|
||||
}
|
||||
#search-text {width: 170px}
|
||||
|
||||
#sidebar ul {
|
||||
margin-left: 0;
|
||||
padding-left: 0;
|
||||
}
|
||||
#sidebar ul h3 {
|
||||
margin-top: 25px;
|
||||
font-size: 16px;
|
||||
padding-bottom: 10px;
|
||||
border-bottom: 1px solid #ccc;
|
||||
}
|
||||
#sidebar li {
|
||||
list-style-type: none;
|
||||
}
|
||||
#sidebar ul.links li {
|
||||
margin-bottom: 5px;
|
||||
}
|
||||
|
||||
h1, h2, h3, h4, h5 {
|
||||
font-family: sans-serif;
|
||||
margin: 1.2em 0 0.6em 0;
|
||||
}
|
||||
|
||||
p {
|
||||
line-height: 1.5em;
|
||||
margin: 1.6em 0;
|
||||
}
|
||||
|
||||
code, tt {
|
||||
font-family: 'Andale Mono', Monaco, 'Liberation Mono', 'Bitstream Vera Sans Mono', 'DejaVu Sans Mono', monospace;
|
||||
}
|
||||
|
||||
#footer {
|
||||
clear: both;
|
||||
padding-top: 2em;
|
||||
text-align: center;
|
||||
padding-right: 160px;
|
||||
font-family: sans-serif;
|
||||
font-size: 10px;
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#!/usr/bin/env perl
|
||||
use Dancer ':syntax';
|
||||
use FindBin '$RealBin';
|
||||
use Plack::Runner;
|
||||
|
||||
# For some reason Apache SetEnv directives dont propagate
|
||||
# correctly to the dispatchers, so forcing PSGI and env here
|
||||
# is safer.
|
||||
set apphandler => 'PSGI';
|
||||
set environment => 'production';
|
||||
|
||||
my $psgi = path($RealBin, '..', 'bin', 'app.pl');
|
||||
die "Unable to read startup script: $psgi" unless -r $psgi;
|
||||
|
||||
Plack::Runner->run($psgi);
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
#!/usr/bin/env perl
|
||||
use Dancer ':syntax';
|
||||
use FindBin '$RealBin';
|
||||
use Plack::Handler::FCGI;
|
||||
|
||||
# For some reason Apache SetEnv directives dont propagate
|
||||
# correctly to the dispatchers, so forcing PSGI and env here
|
||||
# is safer.
|
||||
set apphandler => 'PSGI';
|
||||
set environment => 'production';
|
||||
|
||||
my $psgi = path($RealBin, '..', 'bin', 'app.pl');
|
||||
my $app = do($psgi);
|
||||
die "Unable to read startup script: $@" if $@;
|
||||
my $server = Plack::Handler::FCGI->new(nproc => 5, detach => 1);
|
||||
|
||||
$server->run($app);
|
||||
|
|
@ -0,0 +1 @@
|
|||
/usr/share/javascript/jquery/jquery.js
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
use Test::More tests => 1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use_ok 'DNSManager';
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
use Test::More tests => 2;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
# the order is important
|
||||
use DNSManager;
|
||||
use Dancer::Test;
|
||||
|
||||
route_exists [GET => '/'], 'a route handler is defined for /';
|
||||
response_status_is ['GET' => '/'], 200, 'response status is 200 for /';
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
<div id="sidebar">
|
||||
<a href='/'>Accueil</a>
|
||||
</div>
|
||||
|
||||
<div id="page">
|
||||
<h1>Bienvenue sur la page d'administration</h1>
|
||||
</div>
|
||||
|
||||
|
|
@ -0,0 +1,105 @@
|
|||
<div id="sidebar">
|
||||
Welcome <% login %> !
|
||||
<form action='logout' method="get" accept-charset="utf-8">
|
||||
<input type="submit" name="logout" value="Déconnexion">
|
||||
</form>
|
||||
<% IF admin == 1 %>
|
||||
<a href='administration'>Page d'administration</a>
|
||||
<% END %>
|
||||
<a href='/'>Accueil</a>
|
||||
</div>
|
||||
|
||||
<div id="page">
|
||||
<% IF domain && domain.size %>
|
||||
<table border='1px'>
|
||||
<caption>Les zones de <%domain%></caption>
|
||||
<tr>
|
||||
<th>Host</th>
|
||||
<th>Adress</th>
|
||||
<th>Type</th>
|
||||
<th>Domain</th>
|
||||
</tr>
|
||||
<% FOREACH zone in zones %>
|
||||
<tr>
|
||||
<td>
|
||||
<% IF zone.host %>
|
||||
<% zone.host %>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone.addr %>
|
||||
<% zone.addr %>
|
||||
<% END %>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone.type %>
|
||||
<% zone.type %>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone.domain %>
|
||||
<% zone.domain %>
|
||||
<%END%>
|
||||
</td>
|
||||
</tr>
|
||||
<% END %>
|
||||
</table>
|
||||
<br/>
|
||||
<table border='1px'>
|
||||
<caption>Domain Properties</caption>
|
||||
<tr>
|
||||
<th>Admin de la zone</th>
|
||||
<th>Serial</th>
|
||||
<th>Primary</th>
|
||||
<th>Retry</th>
|
||||
<th>Domain</th>
|
||||
<th>Refresh</th>
|
||||
<th>Address</th>
|
||||
<th>Expire</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
<% IF zone_properties.admin %>
|
||||
<%zone_properties.admin%><br/>
|
||||
<%END%>
|
||||
<td>
|
||||
<% IF zone_properties.serial %>
|
||||
<%zone_properties.serial%>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone_properties.primary %>
|
||||
<%zone_properties.primary%>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone_properties.retry %>
|
||||
<%zone_properties.retry%>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone_properties.domain %>
|
||||
<%zone_properties.domain%>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone_properties.refresh %>
|
||||
<%zone_properties.refresh%>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone_properties.addr %>
|
||||
<%zone_properties.addr%>
|
||||
<%END%>
|
||||
</td>
|
||||
<td>
|
||||
<% IF zone_properties.expire %>
|
||||
<%zone_properties.expire%>
|
||||
<%END%>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
<% ELSE %>
|
||||
Vous n'avez pas encore de noms de domaines… Voulez-vous en réserver un ?
|
||||
<% END %>
|
||||
</div>
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
<div id="sidebar">
|
||||
<% IF logged == 1 %>
|
||||
Welcome <% login %> !
|
||||
<form action='logout' method="get" accept-charset="utf-8">
|
||||
<input type="submit" name="logout" value="Déconnexion">
|
||||
</form>
|
||||
<a href='mapage'>Votre page de configuration</a><br />
|
||||
<% IF admin == 1 %>
|
||||
<a href='administration'>Page d'administration</a><br />
|
||||
<% END %>
|
||||
<% IF domains %>
|
||||
Liens rapides :<br />
|
||||
<% FOREACH domain IN domains %>
|
||||
<a href="details?domain=<% domain %>"><% domain %> </a><br />
|
||||
<% END %>
|
||||
<% END %>
|
||||
<% ELSE %>
|
||||
<form action="login" method="post" accept-charset="utf-8">
|
||||
<label for="login">Votre login : </label>
|
||||
<input type="text" name="login" value="" />
|
||||
<label for="password">Votre mot de passe : </label>
|
||||
<input type="password" name="password" value="" />
|
||||
<p><input type="submit" value="Connexion →" /></p>
|
||||
</form>
|
||||
<% END %>
|
||||
</div>
|
||||
<div id="page">
|
||||
<h1 style="text-align:center">Bienvenue sur netlib.re ! </h1>
|
||||
<p style="text-align:center;">Netlib.re est un projet qui permettra à tout un chacun d'obtenir un sous-domaine de netlib.re, gratuitement et simplement. </p>
|
||||
<br />
|
||||
<h2>Pourquoi ?</h2>
|
||||
Nous pensons qu'Internet est et doit rester un lieu où l'utilisateur crée le contenu. Ce projet permettra donc d'apporter un peu notre pierre à l'édifice en aidant les gens n'ayant pas forcément de compétences en informatique de créer un nom de domaine.<br />
|
||||
Remarque : ce site ne fera pas d'hébergement, il founira uniquement un serveur de nom de domaine automatisé.
|
||||
<h2>Qui sommes-nous ?</h2>
|
||||
<p>Une bande d'informaticiens passionnés, voulant aider la communauté.</p>
|
||||
<h2>Ce qui sera proposé</h2>
|
||||
À venir sur le site :
|
||||
<ul>
|
||||
<li>visualisation de la liste des domaines déjà réservés et utilisés ; </li>
|
||||
<li>création d'un compte vous permettant de demander un nom de domaine en *.netlib.re (un administrateur devra le valider) ;</li>
|
||||
<li>nous aimerions également proposer une mise à jour dynamique de votre adresse (dyndns).</li>
|
||||
</ul>
|
||||
<p>En résumé : cherchez votre nom de domaine, réservez-le, on s'occupe du reste ! </p>
|
||||
</div>
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
|
||||
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
||||
<html xmlns="http://www.w3.org/1999/xhtml">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=<% settings.charset %>" />
|
||||
<title>DNSManager</title>
|
||||
<link rel="stylesheet" href="<% request.uri_base %>/css/style.css" />
|
||||
|
||||
<script type="text/javascript">/* <![CDATA[ */
|
||||
!window.jQuery && document.write('<script type="text/javascript" src="<% request.uri_base %>/javascripts/jquery.js"><\/script>')
|
||||
/* ]]> */</script>
|
||||
|
||||
</head>
|
||||
<body>
|
||||
<% content %>
|
||||
<div id="footer">
|
||||
Powered by <a href="http://perldancer.org/">Dancer</a> <% dancer_version %>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
<div id="sidebar">
|
||||
Welcome <% login %> !
|
||||
<form action='logout' method="get" accept-charset="utf-8">
|
||||
<input type="submit" name="logout" value="Déconnexion">
|
||||
</form>
|
||||
<% IF admin == 1 %>
|
||||
<a href='administration'>Page d'administration</a>
|
||||
<% END %>
|
||||
<a href='/'>Accueil</a>
|
||||
</div>
|
||||
|
||||
<div id="page">
|
||||
<% IF domains && domains.size %>
|
||||
<h3>Vos domaines :</h3>
|
||||
<br />
|
||||
<table>
|
||||
<% FOREACH domain in domains %>
|
||||
<tr>
|
||||
<td>
|
||||
<%domain%>
|
||||
</td>
|
||||
<td>
|
||||
<a href="domaindel/<%domain%>">Supprimer</a>
|
||||
</td>
|
||||
</tr>
|
||||
<% END %>
|
||||
</table>
|
||||
<br/>
|
||||
<% ELSE %>
|
||||
Vous n'avez pas encore de noms de domaines… Voulez-vous en réserver un ?
|
||||
<% END %>
|
||||
<h3>Ajouter un nouveau domaine.</h3>
|
||||
<form action='domainadd'>
|
||||
<input type='text' name='domain'/>
|
||||
<input type='submit' name='submit'/>
|
||||
</form>
|
||||
</div>
|
||||
Reference in New Issue