simplification du code, gestion plus claire des erreurs

Le code a été simplifié de plusieurs manières :
    du code plus générique, dans la gestion des utilisateurs et des
        routes, mais aussi côté gestion des zones et serveurs de zones
    ajout de commandes en cli pour gérer les zones et utilisateurs, et
        faire des tests du code plus simplement qu'en passant par
        l'interface web

Le projet est passé à Dancer2.

Le dépôt est désormais moins éparpillé également, ce qui est visible est
directement le projet Dancer.

Le code concernant l'init reste pas top, idem pour la gestion de
dépendances (un simple script), il faudrait utiliser les outils du cpan.
master
karchnu 8 years ago
parent 5f627aa47c
commit 527313614c

2
.gitignore vendored

@ -1,2 +1,4 @@
*.swp
sessions
init/bind9.cfg.tar.gz
init/varnamed.tar.gz

@ -1,19 +1,23 @@
MANIFEST
bin/app.pl
cpanfile
Makefile.PL
config.yml
MANIFEST.SKIP
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
t/001_base.t
t/002_index_route.t
public/500.html
public/favicon.ico
public/dispatch.cgi
public/404.html
public/dispatch.fcgi
public/js/jquery.min.js
public/dispatch.cgi
public/500.html
t/002_index_route.t
t/001_base.t
Makefile.PL
public/images/perldancer-bg.jpg
public/images/perldancer.jpg
public/javascripts/jquery.js
public/css/error.css
public/css/style.css
bin/app.psgi
views/index.tt
views/layouts/main.tt
lib/MyWeb/App.pm

@ -11,3 +11,7 @@ Makefile$
^cover_db
^.*\.log
^.*\.swp$
MYMETA.*
^.gitignore
^.svn\/
^MyWeb-App-

@ -2,20 +2,25 @@ use strict;
use warnings;
use ExtUtils::MakeMaker;
# Normalize version strings like 6.30_02 to 6.3002,
# so that we can do numerical comparisons on it.
my $eumm_version = $ExtUtils::MakeMaker::VERSION;
$eumm_version =~ s/_//;
WriteMakefile(
NAME => 'DNSManager',
NAME => 'MyWeb::App',
AUTHOR => q{YOUR NAME <youremail@example.com>},
VERSION_FROM => 'lib/DNSManager.pm',
VERSION_FROM => 'lib/MyWeb/App.pm',
ABSTRACT => 'YOUR APPLICATION ABSTRACT',
($ExtUtils::MakeMaker::VERSION >= 6.3002
($eumm_version >= 6.3001
? ('LICENSE'=> 'perl')
: ()),
PL_FILES => {},
PREREQ_PM => {
'Test::More' => 0,
'YAML' => 0,
'Dancer' => 1.311,
'Dancer2' => 0.161000,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'DNSManager-*' },
clean => { FILES => 'MyWeb-App-*' },
);

@ -1,271 +0,0 @@
#!/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 dnsisec => ( is => 'rw', builder => '_void');
has um => ( is => 'rw', builder => '_void');
has [ qw/zdir dbname dbhost dbport dbuser dbpass sgbd dnsapp dnsappsec sshhost sshhostsec sshuser sshusersec sshport sshportsec nsmasterv4 nsmasterv6 nsslavev4 nsslavev6 dnsslavekey/ ] => 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);
die("zone interface") unless $success;
($success, ${$self->dnsisec}) = app::zone::interface ->new()
->get_interface($self->dnsappsec, $self);
die("zone interface (secondary ns)") unless $success;
${$self->um} = app::bdd::management->new(dbh => ${$self->dbh});
}
sub auth {
my ($self, $login, $passwd) = @_;
${$self->um}->auth($login, $passwd);
}
sub register_user {
my ($self, $login, $passwd) = @_;
${$self->um}->register_user($login, $passwd);
}
sub set_admin {
my ($self, $login, $val) = @_;
${$self->um}->set_admin($login, $val);
}
sub update_passwd {
my ($self, $login, $new) = @_;
my ($success, $user, $isadmin) = ${$self->um}->get_user($login);
$user->passwd($new);
}
sub delete_user {
my ($self, $login) = @_;
my ($success, @domains) = $self->get_domains($login);
if($success) {
$self->delete_domain($login, $_) foreach(@domains);
${$self->um}->delete_user($login);
}
}
### domains
sub _get_zone_edit {
my ($self, $domain) = @_;
return app::zone::edit->new(
zname => $domain
, data => $self );
}
# return yes or no
sub add_domain {
my ($self, $login, $domain) = @_;
my ($success, $user, $isadmin) = ${$self->um}->get_user($login);
unless($success) {
return 0;
}
unless ($user->add_domain($domain)) {
return 0;
}
my $ze = $self->_get_zone_edit($domain);
$ze->addzone();
}
sub delete_domain {
my ($self, $login, $domain) = @_;
my ($success, $user, $isadmin) = ${$self->um}->get_user($login);
return 0 unless $success;
return 0 unless $user->delete_domain($domain);
my $ze = $self->_get_zone_edit($domain);
$ze->del();
1;
}
sub update_domain_raw {
my ($self, $zone, $domain) = @_;
my $ze = $self->_get_zone_edit($domain);
$ze->update_raw($zone);
}
sub update_domain {
my ($self, $zone, $domain) = @_;
my $ze = $self->_get_zone_edit($domain);
$ze->update($zone);
}
sub get_domain {
my ($self, $domain) = @_;
my $ze = $self->_get_zone_edit($domain);
$ze->get();
}
sub get_domains {
my ($self, $login) = @_;
${$self->um}->get_domains($login);
}
sub get_all_domains {
my ($self) = @_;
# % domain login
${$self->um}->get_all_domains;
}
sub get_all_users {
my ($self) = @_;
# % login admin
${$self->um}->get_all_users;
}
sub new_tmp {
my ($self, $domain) = @_;
my $ze = $self->_get_zone_edit($domain);
$ze->new_tmp();
}
sub _mod_entry {
my ($self, $domain, $entryToDelete, $action, $newEntry) = @_;
my $name = $entryToDelete->{'name'};
my $type = $entryToDelete->{'type'};
my $ttl = $entryToDelete->{'ttl'};
my $host = $entryToDelete->{'host'};
my $priority = $entryToDelete->{'priority'};
my $new_name = $newEntry->{'newname'};
my $new_type = $newEntry->{'newtype'};
my $new_ttl = $newEntry->{'newttl'};
my $new_host = $newEntry->{'newhost'};
my $new_priority = $newEntry->{'newpriority'};
# say "in _mod_entry : $action";
# say "in _mod_entry : $new_name";
my $zone = $self->get_domain($domain);
my $dump = $zone->dump;
my $record;
my $found = 0;
given( lc $type )
{
when ('a')
{
$record = $zone->a;
$found = 1;
}
when ('aaaa')
{
$record = $zone->aaaa;
$found = 1;
}
when ('cname')
{
$record = $zone->cname;
$found = 1;
}
when ('ns')
{
$record = $zone->ns;
$found = 1;
}
when ('mx')
{
$record = $zone->mx;
$found = 1;
}
when ('ptr')
{
$record = $zone->ptr;
$found = 1;
}
}
if( $found )
{
foreach my $i ( 0 .. scalar @{$record}-1 )
{
if( $action eq 'del' )
{
delete $record->[$i]
if( $record->[$i]->{'name'} eq $name &&
$record->[$i]->{'host'} eq $host &&
$record->[$i]->{'ttl'} == $ttl );
}
if ( $action eq 'mod' )
{
if( $record->[$i]->{'name'} eq $name &&
$record->[$i]->{'host'} eq $host &&
$record->[$i]->{'ttl'} == $ttl )
{
$record->[$i]->{'name'} = $new_name;
$record->[$i]->{'host'} = $new_host;
$record->[$i]->{'ttl'} = $new_ttl;
if( defined $new_priority )
{
$record->[$i]->{'priority'} = $new_priority
}
}
}
}
}
$self->update_domain( $zone, $domain );
}
sub delete_entry {
my ($self, $domain, $entryToDelete) = @_;
$self->_mod_entry( $domain, $entryToDelete, 'del' );
}
sub modify_entry {
my ($self, $domain, $entryToDelete, $newEntry) = @_;
$self->_mod_entry( $domain, $entryToDelete, 'mod', $newEntry );
}
1;

@ -1,33 +0,0 @@
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) = @_;
}
# $success delete_domain
sub delete_domain {
my ($self, $domain) = @_;
my $sth;
$sth = $self->dbh->prepare('delete from domain where domain=?');
unless ( $sth->execute($domain) ) {
$sth->finish();
return 0;
}
$sth->finish();
# delete the domain from our domains
@{ $self->domains } = grep { $_ ne $domain } @{ $self->domains };
return 1;
}
1;

@ -1,78 +0,0 @@
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 {
my ($self, $domain) = @_;
my $sth;
# check if we are the owner then delete
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();
# delete the domain from our domains
@{ $self->domains } = grep { $_ ne $domain } @{ $self->domains };
return 1;
}
# $success add_domain
sub add_domain {
my ($self, $domain) = @_;
my ($sth);
$sth = $self->dbh->prepare('select domain from domain where domain=?');
unless ( $sth->execute($domain) ) {
$sth->finish();
return 0;
}
# if the domain already exists
if (my $ref = $sth->fetchrow_arrayref) {
$sth->finish();
return 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;

@ -1,194 +0,0 @@
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, $success, $user, $isadmin);
$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) {
# if this user exists and is auth
($success, $user, $isadmin) = $self->get_user($login);
}
else {
$success = 0;
}
$sth->finish();
return ($success, $user, $isadmin);
}
# ($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 an user already exists
if (my $ref = $sth->fetchrow_arrayref) {
$sth->finish();
return 0;
}
# if not
$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;
# TODO : vérifier que ça renvoie la bonne valeur
$sth = $self->dbh->prepare('delete from user 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;
}
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, @$ref[2]);
}
$sth->finish();
return 0;
}
sub get_domains {
my ($self, $login) = @_;
my ($sth, @domains);
$sth = $self->dbh->prepare('SELECT domain FROM domain where login=?');
unless ($sth->execute($login)) {
$sth->finish();
return (0, @domains);
}
while(my $ref = $sth->fetchrow_arrayref) {
push @domains, @$ref[0];
}
$sth->finish();
return (1, @domains);
}
sub get_all_domains {
my ($self) = @_;
my ($sth, %domains);
$sth = $self->dbh->prepare('SELECT domain, login FROM domain');
unless ( $sth->execute()) {
$sth->finish();
undef;
}
while( my $ref = $sth->fetchrow_arrayref) {
$domains{@$ref[0]} = @$ref[1];
}
$sth->finish();
%domains;
}
sub get_all_users {
my ($self) = @_;
my ($sth, %users);
$sth = $self->dbh->prepare('SELECT login, admin FROM user');
unless ( $sth->execute()) {
$sth->finish();
undef;
}
while( my $ref = $sth->fetchrow_arrayref) {
$users{@$ref[0]} = @$ref[1];
}
$sth->finish();
%users;
}
sub set_admin {
my ($self, $login, $val) = @_;
my $sth = $self->dbh->prepare('update user set admin=? where login=?');
unless ( $sth->execute( $val, $login) ) {
$sth->finish();
return 0;
}
$sth->finish();
return 1;
}
1;

@ -1,196 +0,0 @@
use Modern::Perl;
use Data::Dump "dump";
use DNS::ZoneParse;
use File::Copy;
use Net::OpenSSH;
use Net::SSH q<sshopen2>;
use v5.14;
use lib '../../';
use app::zone::interface;
package app::zone::edit;
use Moose;
has [ qw/zname data/ ] => qw/is ro required 1/;
sub get {
my ($self) = @_;
my $dest = '/tmp/' . $self->zname;
my $file = $self->data->zdir.'/'.$self->zname;
$self->_scp_get($file, $dest);
DNS::ZoneParse->new($dest, $self->zname);
}
=pod
copie du template pour créer une nouvelle zone
update du serial
ajout de la zone via dnsapp (rndc, knot)
retourne la zone + le nom de la zone
=cut
sub addzone {
my ($self) = @_;
my $tpl = $self->data->zdir."/tpl.zone";
my $tmpfile = '/tmp/'.$self->zname;
$self->_scp_get($tpl, $tmpfile); # get the template
$self->_sed($tmpfile); # sed CHANGEMEORIGIN by the real origin
my $zonefile = DNS::ZoneParse->new($tmpfile, $self->zname);
$zonefile->new_serial(); # update the serial number
# write the new zone tmpfile to disk
my $newzone;
open($newzone, '>', $tmpfile) or die "error";
print $newzone $zonefile->output();
close $newzone;
my $file = $self->data->zdir.'/'.$self->zname;
$self->_scp_put($tmpfile, $file); # put the final zone on the server
unlink($tmpfile); # del the temporary file
# add new zone on the primary ns
my $prim = app::zone::interface->new()
->get_interface($self->data->dnsapp, $self->data);
$prim->addzone($self->data->zdir, $self->zname);
# add new zone on the secondary ns
my $sec = app::zone::interface->new()
->get_interface($self->data->dnsappsec, $self->data);
$sec->reload_sec();
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 $tmpfile = '/tmp/' . $self->zname;
# write the new zone tmpfile to disk
my $newzone;
open($newzone, '>', $tmpfile) or die "error";
print $newzone $zonefile->output();
close $newzone;
my $file = $self->data->zdir.'/'.$self->zname;
$self->_scp_put($tmpfile, $file); # put the final zone on the server
unlink($tmpfile); # del the temporary file
my $prim = app::zone::interface->new()
->get_interface($self->data->dnsapp, $self->data);
$prim->reload($self->zname);
1;
}
=pod
udpate via the raw content of the zonefile
=cut
sub update_raw {
my ($self, $zonetext) = @_;
my $zonefile;
my $file = '/tmp/'.$self->zname;
# write the updated zone file to disk
my $newzone;
open($newzone, '>', $file) or die "error";
print $newzone $zonetext;
close $newzone;
eval { $zonefile = DNS::ZoneParse->new($file, $self->zname); };
if( $@ ) {
unlink($file);
0;
}
unlink($file);
$self->update($zonefile);
}
# sera utile plus tard, pour l'interface
sub new_tmp {
my ($self) = @_;
my $tpl = $self->data->zdir."/tpl.zone";
my $file = '/tmp/'.$self->zname;
$self->_scp($tpl, $file);
$self->_sed($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)";
}
sub _scp_put {
my ($self, $src, $dest) = @_;
my $co = $self->data->sshuser . '@' . $self->data->sshhost . ':' . $self->data->sshport;
my $ssh = Net::OpenSSH->new($co);
$ssh->scp_put($src, $dest) or die "scp failed: " . $ssh->error;
}
sub _scp_get {
my ($self, $src, $dest) = @_;
my $co = $self->data->sshuser . '@' . $self->data->sshhost . ':' . $self->data->sshport;
my $ssh = Net::OpenSSH->new($co);
$ssh->scp_get($src, $dest) or die "scp failed: " . $ssh->error;
}
sub _sed {
my ($self, $file) = @_;
my $orig = $self->zname;
my $cmd = qq[sed -i "s/CHANGEMEORIGIN/$orig/" $file 2>/dev/null 1>/dev/null];
system($cmd);
}
sub del {
my ($self) = @_;
my $prim = app::zone::interface->new()
->get_interface($self->data->dnsapp, $self->data);
$prim->delzone($self->data->zdir, $self->zname);
$prim->reconfig();
my $sec = app::zone::interface->new()
->get_interface($self->data->dnsappsec, $self->data);
$sec->reload_sec();
my $file = $self->data->zdir.'/'.$self->zname;
my $host = $self->data->sshhost;
my $user = $self->data->sshuser;
my $cmd = "rm $file";
Net::SSH::sshopen2("$user\@$host", *READER, *WRITER, "$cmd") || die "ssh: $!";
close(READER);
close(WRITER);
1;
}
1;

@ -1,16 +0,0 @@
use lib '../../';
use app::zone::rndc_interface;
use app::zone::knot_interface;
use app::zone::nsdc_interface;
package app::zone::interface;
use Moose;
sub get_interface {
my ($self, $type, $data) = @_;
return 1, app::zone::rndc_interface->new(data => $data) if $type eq 'rndc';
return 1, app::zone::knot_interface->new(data => $data) if $type eq 'knot';
return 1, app::zone::nsdc_interface->new(data => $data) if $type eq 'nsdc';
return 0;
}
1;

@ -1,117 +0,0 @@
use v5.14;
package app::zone::nsdc_interface;
use Moose;
has [ qw/data/ ] => qw/is ro required 1/;
# on suppose que tout est déjà mis à jour dans le fichier
sub reload_sec {
my ($self) = @_;
$self->_reload_conf();
system('ssh -p ' . $self->data->sshportsec . ' '
. $self->data->sshusersec . '@' . $self->data->sshhostsec
. ' "sudo nsdc rebuild 2>/dev/null 1>/dev/null && sudo nsdc restart 2>/dev/null 1>/dev/null "');
}
sub _reload_conf {
my ($self) = @_;
# get the file
# modify the file
# push the file
my $f = "/tmp/nsd.conf";
_scp_get($self->data->sshusersec
, $self->data->sshhostsec
, $self->data->sshportsec
, "/etc/nsd3/nsd.conf"
, $f);
my %slavedzones = $self->data->get_all_domains();
my $data = read_file($f);
my $debut = "## BEGIN_GENERATED";
my $nouveau = '';
for(keys %slavedzones) {
$nouveau .= "zone:\n\n\tname: \"$_\"\n"
. "\tzonefile: \"slave/$_\"\n\n";
# allow notify & request xfr, v4 & v6
$nouveau .=
"\tallow-notify: " . $self->data->nsmasterv4 . ' ' . $self->data->dnsslavekey . "\n"
. "\trequest-xfr: " . $self->data->nsmasterv4 . ' ' . $self->data->dnsslavekey . "\n\n";
$nouveau .=
"\tallow-notify: " . $self->data->nsmasterv6. ' ' . $self->data->dnsslavekey . "\n"
. "\trequest-xfr: " . $self->data->nsmasterv6. ' ' . $self->data->dnsslavekey . "\n\n";
}
$data =~ s/$debut.*/$debut\n$nouveau/gsm;
write_file($f, $data);
system('ssh -p ' . $self->data->sshportsec . ' '
. $self->data->sshusersec . '@' . $self->data->sshhostsec
. ' "sudo nsdc patch 2>/dev/null 1>/dev/null && sudo rm /var/nsd3/ixfr.db"');
_scp_put($self->data->sshusersec
, $self->data->sshhostsec
, $self->data->sshportsec
, $f
, "/etc/nsd3/");
}
sub _scp_get {
my ($user, $host, $port, $src, $dest) = @_;
my $co = $user . '@' . $host . ':' . $port;
my $ssh = Net::OpenSSH->new($co);
$ssh->scp_get($src, $dest) or die "scp failed: " . $ssh->error;
}
sub _scp_put {
my ($user, $host, $port, $src, $dest) = @_;
my $co = $user . '@' . $host . ':' . $port;
my $ssh = Net::OpenSSH->new($co);
$ssh->scp_put($src, $dest) or die "scp failed: " . $ssh->error;
}
sub reconfig {
my ($self, $zname) = @_;
die "not implemented";
#system("nsdc reconfig 2>/dev/null 1>/dev/null");
}
sub delzone {
my ($self) = @_;
die "not implemented";
#system("nsdc delzone $zname 2>/dev/null 1>/dev/null");
}
sub read_file {
my ($filename) = @_;
open my $entree, '<:encoding(UTF-8)', $filename or
die "Impossible d'ouvrir '$filename' en lecture : $!";
local $/ = undef;
my $tout = <$entree>;
close $entree;
return $tout;
}
sub write_file {
my ($filename, $data) = @_;
open my $sortie, '>:encoding(UTF-8)', $filename or die "Impossible d'ouvrir '$filename' en écriture : $!";
print $sortie $data;
close $sortie;
return;
}
1;

@ -1,41 +0,0 @@
use v5.14;
package app::zone::rndc_interface;
use Moose;
has [ qw/data/ ] => qw/is ro required 1/;
# 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");
system("rndc notify $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\"; allow-transfer { ". $self->data->nsslavev4 . '; '. $self->data->nsslavev6 . "; }; notify yes; };'";
}
$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");
}
1;

@ -0,0 +1,8 @@
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use MyWeb::App;
MyWeb::App->to_app;

@ -0,0 +1,31 @@
-----BEGIN CERTIFICATE-----
MIIFUDCCAzgCCQDV/QJQr9sX7DANBgkqhkiG9w0BAQsFADBqMQswCQYDVQQGEwJG
UjEPMA0GA1UECAwGQWxzYWNlMRMwEQYDVQQHDApTdHJhc2JvdXJnMRIwEAYDVQQD
DAluZXRsaWIucmUxITAfBgkqhkiG9w0BCQEWEmthcmNobnVAa2FyY2hudS5mcjAe
Fw0xNDA4MjMwODAwNThaFw0xNTA4MjMwODAwNThaMGoxCzAJBgNVBAYTAkZSMQ8w
DQYDVQQIDAZBbHNhY2UxEzARBgNVBAcMClN0cmFzYm91cmcxEjAQBgNVBAMMCW5l
dGxpYi5yZTEhMB8GCSqGSIb3DQEJARYSa2FyY2hudUBrYXJjaG51LmZyMIICIjAN
BgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAxaqx8ToKV4lxqOJa+h7WA9qh7ygk
3JGOx6EEquL29YUfZXvKHjA3fNUIAXzlUJZXferLO/w62t4M9Lha0beOuM3gQvXz
RzeGAgzeEAfDN892+GIYwf7e4a6VQFU99Bb6/cetnqFSw9PiFIC1XpG/lCSR4INd
8msGuW6YIJ30AYE2PWNhn8C44szpe4xzQrv5omJsRC4+DXe9yLAdurbvUXzEijE3
3rii+vlj52awfsCwxGDh8oblm/ir0ISBqTpq6V/xsCD8S4L9c80HeqGzmcF1LpEl
dpcSDKLCXLszwKJz/aNiUxPq4m7IWe0av87hUGunzDT9+NUwWcsqHBdAuACQ6xK+
j3ZtzoiZtPDKLyfdKc4kgx1heiWLn6KCSqgHmfYLQiT7o0kYpOMM7wCjfkMAFI7G
LCv5Vx3hgx2erjwnWKXCt+QiUISvzNs9kP3DhcOKtKr4bzEwW8CCML+qnftCjb4w
+TLKIQNTUlp2I+To2VCnywylFyqOGxR7NKapSjoUUKyCkjcUpNUojy3sLsc1/QeM
YRYvOyQpU+xxCGrAQjf+AE0G8QEPPry2MOLGJvg2BUJstgn2IEoYPL7uwtRSwh8b
VtXdXX5kAdKj00XBEKOEJ0rRq/ahVTsJaC5ndvcicnp5oMbb5xx0Uvhr+SjqbOo1
VU1qXIbGq87lMu0CAwEAATANBgkqhkiG9w0BAQsFAAOCAgEAhiIHGcruJ6kZLuFD
wmi+ZMu3V8v0MlN6v4+VhqHbu5NGsNqXVKKo+JXs9oGlgVgSYN/OaKHc56Xs0/8m
5mOzxm42IbMs8bj1twGAdngOo+HeXHmJMU87WaD7Igv4IG6bgE5pkhnrvsBxsvyn
tnbRvbX582RC40OIw1uVMmYmQGNYBpl4+i94oIEjTDZys6t8MfOsJj1yAuJdYfzn
oKZfsxfLy1Ze68u6ZOkxdNhvVmyddMGOEhhC2KgWEsFbC9aRmfPKWHS2x8pmyiwz
eUgwDVKeuLTuPn8XzYk9BW8TFGnhEfj1wrTb3jdY9NSBBsc2o4bgb8nYQfqsRv8y
F0yqzWbBiYKPhITf2n8qdUV3k5FE+uVLlqRERQOa07+kS5kUrpPHurhhgIXN2c2p
Xutz+EmDyWyLyDCXAk4kKGldiqUpIozs4faYJOxtlZmNKXmokmalSl9eN/S8tIXQ
JQ/dJnvYW9L0hvHWxF03LJ5Pee88nZfIRyN0R6olLcI3oSWCOJAfFeqklnJj5YHs
G43BeSW4DGPKCRz6x3i7Y2S5mbfqHFzg1OloU2ybbvCSJhuxyEiSxPkWv5Tl867x
ltju9/n8caTlMRAxskGhYnlmg7xsMrr474YAWxelo1OAEbwA+8mWKlbOFa40BHMt
Ih5Vwu3gN7dmX293gXRYTSnYBgs=
-----END CERTIFICATE-----

@ -0,0 +1,29 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
use utf8;
if( @ARGV != 1 ) {
say "usage : ./$0 domain";
exit 1;
}
my $dom = $ARGV[0];
eval {
my $app = app->new(get_cfg());
my $domain = $app->get_domain($dom);
dump($domain);
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,28 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
#use DNS::ZoneParse;
#use Config::Simple;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use app;
use utf8;
if( @ARGV != 0 ) {
say "usage : ./$0";
exit 1;
}
eval {
my $app = app->new(get_cfg());
my $domains = $app->get_all_domains();
dump($domains);
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,27 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use utf8;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use app;
if( @ARGV != 0 ) {
say "usage : ./$0";
exit 1;
}
eval {
my $app = app->new(get_cfg());
my $users = $app->get_all_users();
dump($users);
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,28 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
use utf8;
if( @ARGV != 1 ) {
say "usage : ./$0 login";
exit 1;
}
my $login = $ARGV[0];
eval {
my $app = app->new(get_cfg());
$app->toggle_admin($login);
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,28 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
use utf8;
if( @ARGV != 2 ) {
say "usage : ./$0 login passwd";
exit 1;
}
my ($login, $passwd) = ($ARGV[0], $ARGV[1]);
eval {
my $app = app->new(get_cfg());
$app->register_user($login, encrypt($passwd));
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,32 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
use utf8;
if( @ARGV != 0 && @ARGV != 2 ) {
say "usage : ./$0 [ login passwd ]";
exit 1;
}
my ($login, $passwd) = qw/test test/;
($login, $passwd) = ($ARGV[0], $ARGV[1]) if ( @ARGV == 2 );
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($login, encrypt($passwd));
dump($user);
if($$user{admin}) { say "ADMIN" }
else { say "NOT ADMIN" }
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,27 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use app;
use utf8;
if( @ARGV != 1 ) {
say "usage : ./$0 user";
exit 1;
}
my $login = $ARGV[0];
eval {
my $app = app->new(get_cfg());
$app->delete_user($login);
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,27 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use Data::Dump qw( dump );
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
if( @ARGV != 2 ) {
say "usage : ./$0 userid newpasswd";
exit 1;
}
my ($login, $passwd) = ($ARGV[0], $ARGV[1]);
eval {
my $app = app->new(get_cfg());
$app->update_passwd($login, encrypt($passwd));
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,28 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
use utf8;
if( @ARGV != 2 ) {
say "usage : ./$0 login ndd ";
exit 1;
}
my ($login, $dom) = ($ARGV[0], $ARGV[1]);
eval {
my $app = app->new(get_cfg());
$app->add_domain( $login, $dom );
my $zone = $app->get_domain($dom);
say $zone->output();
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,26 @@
#!/usr/bin/perl -w
use v5.14;
use autodie;
use Modern::Perl;
use lib './lib/';
use configuration ':all';
use encryption ':all';
use app;
use utf8;
if( @ARGV != 1 ) {
say "usage : ./$0 ndd ";
exit 1;
}
my $dom = $ARGV[0];
eval {
my $app = app->new(get_cfg());
$app->delete_domain( $dom );
};
if( $@ ) {
say q{Une erreur est survenue. } . $@;
}

@ -0,0 +1,44 @@
# TLD
# Must contains the first "."
tld:
- '.netlib.re'
- '.autre.tld'
- '.codelib.re'
tmpdir: file:///media/fast/
database:
sgbd: mysql # other options : see DBI module
name: dnsmanager
host: localhost
port: 3306
user: dnsmanageruser
passwd: "my-not-so-dummy-password"
primarydnsserver:
app: bind9
dnsslavekey: demokey
zonedir: ssh://root@localhost:22/var/named/zones/rndczones/
domain:
user: root
port: 22
host: web.loc
name: web.loc
v4: 192.168.0.60 # optional
#v6: ::1 # optional
secondarydnsserver:
- app: nsd
cfg: ssh://root@nsdl:22/etc/nsd/nsd.conf
zonedir: ssh://root@nsdl:22/etc/nsd/
domain:
name: nsdl
v4: 192.168.0.61 # optional
#v6: ::1 # optional
# - app: nsd
# cfg: ssh://dnsmanager@host3:2222/etc/nsd3/nsd.conf
# domain:
# name: third.example.com
# v4: 192.0.2.3 # optional
# v6: 2001:db8::3 # optional

@ -1,15 +1,15 @@
# This is the main configuration file of your Dancer app
# This is the main configuration file of your Dancer2 app
# env-related settings should go to environments/$env.yml
# all the settings in this file will be loaded at Dancer's startup.