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
This commit is contained in:
parent
2bef4fd845
commit
ac41629891
2
.gitignore
vendored
Normal file
2
.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
*.swp
|
||||
sessions
|
124
app/app.pm
Normal file
124
app/app.pm
Normal 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
15
app/bdd/admin.pm
Normal 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
63
app/bdd/lambda.pm
Normal 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
161
app/bdd/management.pm
Normal 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
165
app/zone/bind_interface.pm
Normal 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
107
app/zone/edit.pm
Normal 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
14
app/zone/interface.pm
Normal 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;
|
40
app/zone/rndc_interface.pm
Normal file
40
app/zone/rndc_interface.pm
Normal 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;
|
39
readme.md
39
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/)
|
||||
* [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)
|
||||
|
||||
## 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)."
|
||||
* [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
18
t/tpl.zone
Normal 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
28
t/zone_add.pl
Executable 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
17
t/zone_del.pl
Executable 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
32
t/zone_rndc.pl
Executable 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
20
t/zone_tmp.pl
Executable 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
19
www/MANIFEST
Normal 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
13
www/MANIFEST.SKIP
Normal 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
21
www/Makefile.PL
Normal 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
4
www/bin/app.pl
Executable file
@ -0,0 +1,4 @@
|
||||
#!/usr/bin/env perl
|
||||
use Dancer;
|
||||
use DNSManager;
|
||||
dance;
|
11
www/conf/config.ini
Normal file
11
www/conf/config.ini
Normal 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
30
www/config.yml
Normal 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"
|
27
www/environments/development.yml
Normal file
27
www/environments/development.yml
Normal 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
|
17
www/environments/production.yml
Normal file
17
www/environments/production.yml
Normal 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
278
www/lib/DNSManager.pm
Normal 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
20
www/notes.txt
Normal 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
18
www/public/404.html
Normal 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
18
www/public/500.html
Normal 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
70
www/public/css/error.css
Normal 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
189
www/public/css/style.css
Normal 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;
|
||||
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;
|
||||
}
|
15
www/public/dispatch.cgi
Executable file
15
www/public/dispatch.cgi
Executable file
@ -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);
|
17
www/public/dispatch.fcgi
Executable file
17
www/public/dispatch.fcgi
Executable file
@ -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);
|
1
www/public/javascripts/jquery.js
vendored
Symbolic link
1
www/public/javascripts/jquery.js
vendored
Symbolic link
@ -0,0 +1 @@
|
||||
/usr/share/javascript/jquery/jquery.js
|
5
www/t/001_base.t
Normal file
5
www/t/001_base.t
Normal file
@ -0,0 +1,5 @@
|
||||
use Test::More tests => 1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use_ok 'DNSManager';
|
10
www/t/002_index_route.t
Normal file
10
www/t/002_index_route.t
Normal file
@ -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 /';
|
8
www/views/administration.tt
Normal file
8
www/views/administration.tt
Normal file
@ -0,0 +1,8 @@
|
||||
<div id="sidebar">
|
||||
<a href='/'>Accueil</a>
|
||||
</div>
|
||||
|
||||
<div id="page">
|
||||
<h1>Bienvenue sur la page d'administration</h1>
|
||||
</div>
|
||||
|
105
www/views/details.tt
Normal file
105
www/views/details.tt
Normal file
@ -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>
|
44
www/views/index.tt
Normal file
44
www/views/index.tt
Normal file
@ -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>
|
20
www/views/layouts/main.tt
Normal file
20
www/views/layouts/main.tt
Normal file
@ -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>
|
37
www/views/mapage.tt
Normal file
37
www/views/mapage.tt
Normal file
@ -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
Block a user