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 2015-10-13 19:06:37 +02:00
parent 5f627aa47c
commit 527313614c
125 changed files with 3832 additions and 2588 deletions

2
.gitignore vendored
View File

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

View File

@ -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

View File

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

View File

@ -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-*' },
);

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

8
bin/app.psgi Executable file
View File

@ -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;

31
cli/daemon/ca.cert Normal file
View File

@ -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-----

29
cli/get_domain.pl Normal file
View File

@ -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. } . $@;
}

28
cli/get_domains.pl Normal file
View File

@ -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. } . $@;
}

27
cli/get_users.pl Normal file
View File

@ -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. } . $@;
}

28
cli/toggle_admin.pl Normal file
View File

@ -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. } . $@;
}

28
cli/user_add.pl Normal file
View File

@ -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. } . $@;
}

32
cli/user_auth.pl Normal file
View File

@ -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. } . $@;
}

27
cli/user_del.pl Normal file
View File

@ -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. } . $@;
}

27
cli/user_update_passwd.pl Normal file
View File

@ -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. } . $@;
}

28
cli/zone_add.pl Normal file
View File

@ -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. } . $@;
}

26
cli/zone_del.pl Normal file
View File

@ -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. } . $@;
}

44
conf/config.yml Normal file
View File

@ -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

View File

@ -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.
# Your application's name
appname: "DNSManager"
appname: "MyWeb::App"
# 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
# when the charset is set to UTF-8 Dancer2 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"
@ -18,13 +18,17 @@ charset: "UTF-8"
# simple: default and very basic template engine
# template_toolkit: TT
# template: "simple"
#template: "simple"
template: "template_toolkit"
engines:
template_toolkit:
encoding: 'utf8'
start_tag: '<%'
end_tag: '%>'
template:
template_toolkit:
start_tag: '<%'
end_tag: '%>'
session: "Storable"
#session: "Storable"
session: "YAML"
logging: "console"

11
cpanfile Normal file
View File

@ -0,0 +1,11 @@
requires "Dancer2" => "0.161000";
recommends "YAML" => "0";
recommends "URL::Encode::XS" => "0";
recommends "CGI::Deurl::XS" => "0";
recommends "HTTP::Parser::XS" => "0";
on "test" => sub {
requires "Test::More" => "0";
requires "HTTP::Request::Common" => "0";
};

View File

@ -0,0 +1,23 @@
# 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 Dancer2's core log messages as well as yours
# (debug, info, warning and error)
log: "core"
# should Dancer2 consider warnings as critical errors?
warnings: 1
# should Dancer2 show a stacktrace when an error is caught?
# if set to yes, public/500.html will be ignored and either
# views/500.tt, 'error_template' template, or a default error template will be used.
show_errors: 1
# print the banner
startup_info: 1

View File

@ -9,9 +9,8 @@ logger: "file"
# don't consider warnings critical
warnings: 0
# hide errors
# hide errors
show_errors: 0
# cache route resolution for maximum performance
route_cache: 1
# disable server tokens in production environments
no_server_tokens: 1

13
init/deploiement.sh Executable file
View File

@ -0,0 +1,13 @@
#!/bin/bash
# install applications
sudo apt-get install mysql-server # bind9
# Get libs
bash ./get_libs.sh
# db install
mysql -u root --password="${PASS}" < init-create-user.sql
mysql -u root --password="${PASS}" < init-create-db.sql
mysql -u root --password="${PASS}" < init-grant-user.sql
mysql -u root --password="${PASS}" < init-tables.sql

View File

@ -1,11 +1,20 @@
#!/bin/bash
sudo apt-get update
sudo apt-get install libssl1.0.0 libssl-dev cpanminus make gcc
## En attendant de faire de vrais paquets pour l'application
cpanm YAML
sudo apt-get update
sudo apt-get install libssl1.0.0 libssl-dev cpanminus make gcc \
libdbi-perl libdbd-mysql-perl
# sudo apt-get install bind9
cpanm --local-lib=~/perl5 local::lib && eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
cpanm Dancer2
cpanm Dancer2::Plugin::Deferred
#cpanm Dancer::Plugin::FlashMessage
cpanm YAML::XS
cpanm Data::Dump
cpanm File::Basename
cpanm Find::Lib
@ -16,17 +25,13 @@ cpanm Modern::Perl
cpanm Config::Simple
cpanm Crypt::Digest::SHA256
cpanm Dancer::Session::Storable
cpanm Moose
cpanm Template
cpanm Template::Toolkit
cpanm Dancer
cpanm Dancer::Test
cpanm ExtUtils::MakeMaker
cpanm Storable
cpanm Plack::Handler::FCGI
cpanm Plack::Runner
cpanm DNS::ZoneParse
cpanm Net::OpenSSH
cpanm Template
cpanm Net::SSH
cpanm Date::Calc
# cpanm Template::Toolkit non trouvé

1
init/init-create-db.sql Normal file
View File

@ -0,0 +1 @@
CREATE DATABASE IF NOT EXISTS dnsmanager;

View File

@ -0,0 +1,2 @@
CREATE USER "dnsmanageruser"@'localhost';
set password for "dnsmanageruser"@'localhost' = password('my-not-so-dummy-password');

1
init/init-grant-user.sql Normal file
View File

@ -0,0 +1 @@
grant all on dnsmanager.* to "dnsmanageruser"@'localhost';

21
init/init-tables.sql Normal file
View File

@ -0,0 +1,21 @@
USE dnsmanager;
CREATE TABLE IF NOT EXISTS user (
login varchar(50) NOT NULL,
passwd varchar(100) DEFAULT NULL,
admin tinyint(1) DEFAULT 0,
PRIMARY KEY (login)
) ENGINE=InnoDB;
CREATE TABLE IF NOT EXISTS domain (
domain varchar(100) NOT NULL,
login varchar(50) NOT NULL,
activated tinyint(1) NOT NULL DEFAULT 0,
PRIMARY KEY (domain)
) ENGINE=InnoDB;
CREATE TABLE IF NOT EXISTS tld (
tld varchar(50) NOT NULL,
activated tinyint(1) NOT NULL DEFAULT 0,
PRIMARY KEY (tld)
) ENGINE=InnoDB;

10
init/recreate.sh Executable file
View File

@ -0,0 +1,10 @@
#!/bin/bash
PASS="not-so-dummy"
mysql -u root --password=${PASS} < remove-db.sql
mysql -u root --password=${PASS} < remove-user.sql
mysql -u root --password=${PASS} < init-create-db.sql
mysql -u root --password=${PASS} < init-create-user.sql
mysql -u root --password=${PASS} < init-grant-user.sql
mysql -u root --password=${PASS} < init-tables.sql

1
init/remove-db.sql Normal file
View File

@ -0,0 +1 @@
DROP DATABASE dnsmanager;

1
init/remove-user.sql Normal file
View File

@ -0,0 +1 @@
DROP USER "dnsmanageruser"@'localhost';

View File

@ -1,5 +1,5 @@
;
; Database file tpl.zone for tpl.zone. zone.
; Database file CHANGEMEORIGIN for CHANGEMEORIGIN. zone.
; Zone version: 2014030200
;

196
lib/MyWeb/App.pm Normal file
View File

@ -0,0 +1,196 @@
package MyWeb::App;
use v5.14;
use strict;
use warnings;
use Dancer2;
use Dancer2::Plugin::Deferred;
use File::Basename;
#use Storable qw( freeze thaw );
#$Storable::Deparse = true;
#$Storable::Eval=true;
use utf8;
use YAML::XS;
use configuration ':all';
use util ':all';
use rt::root ':all';
use rt::domain ':all';
use rt::user ':all';
use rt::admin ':all';
use app;
our $VERSION = '0.1';
sub what_is_next {
my ($res) = @_;
if($$res{sessiondestroy}) {
app->destroy_session;
}
for(keys %{$$res{deferred}}) {
deferred $_ => $$res{deferred}{$_};
}
for(keys %{$$res{addsession}}) {
session $_ => $$res{addsession}{$_};
}
for(keys %{$$res{delsession}}) {
session $_ => undef;
}
if(exists $$res{route}) {
redirect $$res{route};
}
elsif(exists $$res{template}) {
template $$res{template} => $$res{params};
} else {
redirect '/';
}
}
sub get_param {
my $param_values;
for(@_) {
$$param_values{$_} = param "$_";
}
$param_values;
}
sub get_request {
my $request_values;
for(@_) {
if(/^address$/) { $$request_values{$_} = request->address; }
elsif(/^referer$/) { $$request_values{$_} = request->referer; }
}
$request_values;
}
sub get_session {
my $session_values;
for(@_) {
$$session_values{$_} = session "$_";
}
$session_values;
}
get '/' => sub {
what_is_next rt_root
get_session( qw/login passwd/ );
};
prefix '/domain' => sub {
any ['post', 'get'] => '/updateraw/:domain' => sub {
what_is_next rt_dom_updateraw
get_session( qw/login passwd/ )
, get_param( qw/domain zoneupdated/)
, get_request( qw/address referer/ );
};
any ['post', 'get'] => '/update/:domain' => sub {
what_is_next rt_dom_update
get_session( qw/login passwd/ )
, get_param( qw/type name value ttl priority domain/ );
};
get '/details/:domain' => sub {
what_is_next rt_dom_details
get_session( qw/login passwd/ )
, get_param( qw/domain expert/ )
, get_request( qw/address referer/ );
};
post '/add/' => sub {
what_is_next rt_dom_add
get_session( qw/login passwd/ )
, get_param( qw/domain tld/ );
};
get '/del/:domain' => sub {
what_is_next rt_dom_del
get_session( qw/login passwd/ )
, get_param( qw/domain/ )
, get_request( qw/address referer/ );
};
get '/del/:domain/:name/:type/:host/:ttl' => sub {
what_is_next rt_dom_del_entry
get_session( qw/login passwd/ )
, get_param( qw/domain name type host ttl/ )
, get_request( qw/address referer/ );
};
get '/mod/:domain/:name/:type/:host/:ttl' => sub {
what_is_next rt_dom_mod_entry
get_session( qw/login passwd/ )
, get_param( qw/type name ttl domain name type host ttl
newpriority newtype newhost newname newttl / )
, get_request( qw/address referer/ );
};
get '/cli/:login/:pass/:domain/:name/:type/:host/:ttl/:ip' => sub {
what_is_next rt_dom_cli_mod_entry
get_session( qw/login/ )
, get_param( qw/passwd domain name type host ttl ip/ );
};
};
any ['get', 'post'] => '/admin' => sub {
what_is_next rt_admin
get_session( qw/login passwd/ );
};
prefix '/user' => sub {
get '/home' => sub {
what_is_next rt_user_home
get_session( qw/login passwd/ )
, get_param( qw// )
, get_request( qw// );
};
get '/logout' => sub {
app->destroy_session;
redirect '/';
};
get '/del/:user' => sub {
what_is_next rt_user_del
get_session( qw/login passwd/ )
, get_param( qw/user/ )
, get_request( qw/referer/ );
};
# add a user => registration
post '/add/' => sub {
what_is_next rt_user_add
get_session( qw// )
, get_param( qw/login password password2/ )
, get_request( qw// );
};
get '/subscribe' => sub {
what_is_next rt_user_subscribe
get_session( qw/login/ );
};
get '/toggleadmin/:user' => sub {
what_is_next rt_user_toggleadmin
get_session( qw/login passwd/ )
, get_param( qw/user/ )
, get_request( qw/referer/ );
};
post '/login' => sub {
what_is_next rt_user_login
get_session( qw/login/ )
, get_param( qw/login password/ )
, get_request( qw/referer/ );
};
};
true;

7
lib/README.markdown Normal file
View File

@ -0,0 +1,7 @@
# TODO
* redesign zone.pm
* moar testz !!! Kitten will die !!!
* décider de la procédure d'init de app, pas besoin de tout charger à chaque fois
* comment passer des informations à chaque interface ?
* est-ce que ce qui est fait est pertinent ?

144
lib/app.pm Normal file
View File

@ -0,0 +1,144 @@
package app;
use v5.14;
use Moo;
use db;
use zone;
has db => ( is => 'rw', builder => '_void');
has [qw/tld tmpdir database primarydnsserver secondarydnsserver/]
=> qw/is ro required 1/;
sub _void { my $x = ''; \$x; }
sub BUILD {
my ($self) = @_;
$$self{db} = db->new(data => $self);
my $db = $$self{database};
unless(exists $$db{sgbd} && exists $$db{name}
&& exists $$db{host} && exists $$db{port}
&& exists $$db{user} && exists $$db{passwd})
{
die "Unable to connect to the database.\n"
. "Check the existance of theses parameters in the config file :\n"
. "\tsgbd name host port user passwd";
}
}
# USER
sub auth {
my ($self, $login, $passwd) = @_;
$self->db->auth($login, $passwd)
}
sub update_passwd {
my ($self, $login, $newpass) = @_;
$self->db->update_passwd($login, $newpass)
}
sub register_user {
my ($self, $login, $passwd) = @_;
$self->db->register_user($login, $passwd)
}
sub toggle_admin {
my ($self, $login) = @_;
$self->db->toggle_admin($login)
}
sub delete_user {
my ($self, $login) = @_;
$self->db->delete_user($login)
}
sub get_all_users {
my ($self) = @_;
$self->db->get_all_users
}
sub is_owning_domain {
my ($self, $login, $domain) = @_;
$self->db->is_owning_domain($login, $domain)
}
# DOMAIN
sub _get_zone {
my ($self, $domain) = @_;
# say "";
# say "GET ZONE";
# say "";
# say "";
# say "domain $domain";
# say "tmpdir $$self{tmpdir}";
# say "tld $$self{tld}";
zone->new( domain => $domain
, tmpdir => $$self{tmpdir}
, tld => $$self{tld}
, primarydnsserver => $$self{primarydnsserver}
, secondarydnsserver => $$self{secondarydnsserver}
, slavedzones => $self->get_all_domains()
)
}
sub add_domain {
my ($self, $login, $domain) = @_;
$self->db->add_domain($login, $domain);
$self->_get_zone($domain)->addzone()
}
sub delete_domain {
my ($self, $domain) = @_;
$self->db->delete_domain($domain);
$self->_get_zone($domain)->del()
}
sub modify_entry {
my ($self, $domain, $entryToModify, $newEntry) = @_;
my $zone = $self->_get_zone($domain)->modify_entry(
$entryToModify, $newEntry );
$self->update_domain($zone, $domain)
}
sub delete_entry {
my ($self, $domain, $entryToDelete) = @_;
my $zone = $self->_get_zone($domain)->delete_entry( $entryToDelete );
$self->update_domain($zone, $domain)
}
sub update_domain_raw {
my ($self, $zone, $domain) = @_;
$self->_get_zone($domain)->update_raw($zone)
}
sub update_domain {
my ($self, $zone, $domain) = @_;
$self->_get_zone($domain)->update($zone)
}
sub get_domain {
my ($self, $domain) = @_;
$self->_get_zone($domain)->get()
}
sub get_domains {
my ($self, $login) = @_;
$self->db->get_domains($login)
}
sub get_all_domains {
my ($self) = @_;
$self->db->get_all_domains
}
sub disconnect {
my ($self) = @_;
$self->db->disconnect
}
1;

166
lib/configuration.pm Normal file
View File

@ -0,0 +1,166 @@
package configuration;
use YAML::XS;
use URI;
use fileutil ':all';
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/
get_cfg is_reserved
get_zonedir_from_cfg
get_dnsslavekey_from_cfg
get_v4_from_name
get_v6_from_name
get_v4_from_cfg
get_v6_from_cfg
get_host_from_cfg
get_user_from_cfg
get_port_from_cfg
/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/
get_cfg is_reserved
get_zonedir_from_cfg
get_dnsslavekey_from_cfg
get_v4_from_name
get_v6_from_name
get_v4_from_cfg
get_v6_from_cfg
get_host_from_cfg
get_user_from_cfg
get_port_from_cfg
/] );
sub is_conf_file {
my $f = shift;
unless(-f $f) {
die "$f : not a file";
}
unless(-r $f) {
die "$f : not readable";
}
unless(-T $f) {
die "$f : not plain text";
}
}
sub get_cfg {
my ($cfgdir) = @_;
$cfgdir //= './conf/';
my $f = "$cfgdir/config.yml";
is_conf_file $f;
YAML::XS::LoadFile($f)
}
sub is_reserved {
my ($domain) = @_;
my $filename = 'conf/reserved.zone';
is_conf_file $filename;
my $data = read_file $filename;
$data =~ /^$domain$/m;
}
# TODO : tests
sub get_v6_from_name {
my $name = shift;
my $val = qx/host -t AAAA $name | grep -oE '[^[:space:]]+\$'/;
chomp $val;
#die q{There is no available v6. TODO.} if($val =~ 'NXDOMAIN');
return undef if($val =~ 'NXDOMAIN');
$val
}
sub get_v4_from_name {
my $name = shift;
my $val = qx/host -t A $name | grep -oE '[^[:space:]]+\$'/;
chomp $val;
die q{There is no available v4. TODO.} if($val =~ 'NXDOMAIN');
$val
}
sub get_v6_from_cfg {
my $cfg = shift;
$$cfg{domain}{v6} // get_v6_from_name($$cfg{domain}{name})
}
sub get_v4_from_cfg {
my $cfg = shift;
$$cfg{domain}{v4} // get_v4_from_name($$cfg{domain}{name})
}
sub get_zonedir_from_cfg {
my $cfg = shift;
unless($$cfg{zonedir}) {
die 'For now, the only way to get the zone path is to setup zonedir '
. 'in the primaryserver configuration in config.yml.';
}
URI->new($$cfg{zonedir})->path;
}
sub get_host_from_cfg {
my $cfg = shift;
if($$cfg{zonedir}) {
my $u = URI->new($$cfg{zonedir});
return $u->host;
}
elsif($$cfg{domain}{name}) {
return $$cfg{domain}{name};
}
die "Impossible to get the host from the configuration."
}
sub get_dnsslavekey_from_cfg {
my $cfg = shift;
if($$cfg{dnsslavekey}) {
return $$cfg{dnsslavekey};
}
die "Impossible to get the dns slave key from the configuration."
}
sub get_user_from_cfg {
my $cfg = shift;
if($$cfg{zonedir}) {
my $u = URI->new($$cfg{zonedir});
return $u->user;
}
elsif($$cfg{domain}{user}) {
return $$cfg{domain}{user};
}
die "Impossible to get the user from the configuration."
}
sub get_port_from_cfg {
my $cfg = shift;
if($$cfg{zonedir}) {
my $u = URI->new($$cfg{zonedir});
return $u->port;
}
elsif($$cfg{domain}{port}) {
return $$cfg{domain}{port};
}
die "Impossible to get the port from the configuration."
}
1;

72
lib/copycat.pm Normal file
View File

@ -0,0 +1,72 @@
package copycat;
use v5.14;
use File::Copy;
use URI;
use Net::OpenSSH;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/copycat/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/copycat/] );
sub _cp {
my ($src, $dest) = @_;
say "cp $src $dest";
File::Copy::copy($src, $dest) or die "Copy failed: $! ($src -> $dest)";
}
sub _scp_put {
my ($co, $src, $dest) = @_;
my $ssh = Net::OpenSSH->new($co);
say "scp put $src $dest";
$ssh->scp_put($src, $dest) or die "scp failed: " . $ssh->error;
}
sub _scp_get {
my ($co, $src, $dest) = @_;
my $ssh = Net::OpenSSH->new($co);
say "scp get $src $dest";
$ssh->scp_get($src, $dest) or die "scp failed: " . $ssh->error;
}
# SUPPORT
# local to local
# distant to local
# local to distant
sub copycat {
my ($source, $destination) = @_;
# TODO if it's not URI
my $src = URI->new($source);
my $dest = URI->new($destination);
if($src->scheme eq 'file' && $dest->scheme eq 'file') {
_cp $src->path, $dest->path;
}
elsif($src->scheme eq 'ssh' && $dest->scheme eq 'file') {
my $co = $src->userinfo . '@' . $src->host . ':' . $src->port;
_scp_get $co, $src->path, $dest->path;
}
elsif($src->scheme eq 'file' && $dest->scheme eq 'ssh') {
my $co = $dest->userinfo . '@' . $dest->host . ':' . $dest->port;
_scp_put $co, $src->path, $dest->path;
}
else {
die "CopyCat : wrong arguments";
}
}
1;

269
lib/db.pm Normal file
View File

@ -0,0 +1,269 @@
package db;
use v5.14;
use Moo;
use Modern::Perl;
use autodie;
use DBI;
use getiface ':all';
# db handler
has dbh => ( is => 'rw', builder => '_void');
sub _void { my $x = ''; \$x; }
# reference to the application
has data => qw/is ro required 1/;
sub BUILD {
my $self = shift;
my $db = $$self{data}{database};
my $dsn = "DBI:$$db{sgbd}:database=$$db{name};"
. "host=$$db{host};port=$$db{port}";
$$self{dbh} = DBI->connect($dsn, $$db{user}, $$db{passwd})
|| die "Could not connect to database: $DBI::errstr";
$$self{dbh}->{mysql_enable_utf8} = 1;
$$self{dbh}->do('SET NAMES \'utf8\';') || die;
}
# USER
sub auth {
my ($self, $login, $passwd) = @_;
my $sth;
$sth = $self->dbh->prepare('SELECT * FROM user WHERE login=? and passwd=?');
unless ($sth->execute($login, $passwd)) {
$sth->finish();
die q{Can't authenticate.};
}
# if we can't find the user with this password
unless (my $ref = $sth->fetchrow_arrayref) {
$sth->finish();
die q{The user can't be authenticated.};
}
$sth->finish();
# if this user exists and is auth
$self->get_user($login)
}
sub register_user {
my ($self, $login, $pass) = @_;
my $sth = $self->dbh->prepare('select * from user where login=?');
unless ( $sth->execute($login) ) {
$sth->finish();
die "Impossible to check if the user $login exists.";
}
# if an user already exists
if (my $ref = $sth->fetchrow_arrayref) {
$sth->finish();
die "The user $login already exists.";
}
# if not
$sth = $self->dbh->prepare('insert into user VALUES(?,?,?)');
unless ($sth->execute($login, $pass, 0)) {
$sth->finish();
die "Impossible to register the user $login.";
}
$sth->finish();
}
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();
die "Impossible to delete the user $login.";
}
$sth->finish();
$self->delete_domains_from_user($login)
}
sub get_user {
my ($self, $login) = @_;
my ($sth, $user);
$sth = $self->dbh->prepare('SELECT * FROM user WHERE login=?');
unless ( $sth->execute($login)) {
$sth->finish();
die "Impossible to check if the user $login exists.";
}
unless ($user = $sth->fetchrow_hashref) {
$sth->finish();
die "User $login doesn't exist.";
}
$sth->finish();
# the user gets all his domains
$$user{domains} = $self->get_domains($login);
$user
}
sub get_all_users {
my ($self) = @_;
my ($sth, $users);
$sth = $self->dbh->prepare('SELECT * FROM user');
unless ( $sth->execute()) {
$sth->finish();
die q{Impossible to list the users.};
}
while( my $ref = $sth->fetchrow_hashref) {
push @$users, $ref;
}
$sth->finish();
$users
}
sub toggle_admin {
my ($self, $login) = @_;
my $user = $self->get_user($login);
my $val = ($$user{admin}) ? 0 : 1;
my $sth = $self->dbh->prepare('update user set admin=? where login=?');
unless ( $sth->execute( $val, $login ) ) {
$sth->finish();
die "Impossible to toggle admin the user $login.";
}
$sth->finish()
}
sub update_passwd {
my ($self, $login, $new) = @_;
my $sth;
$sth = $self->dbh->prepare('update user set passwd=? where login=?');
unless ( $sth->execute($new, $login) ) {
$sth->finish();
die q{The password can't be updated.};
}
$sth->finish()
}
# DOMAIN
sub get_domains {
my ($self, $login) = @_;
my ($sth);
my $domains = [];
$sth = $self->dbh->prepare('SELECT * FROM domain where login=?');
unless ($sth->execute($login)) {
$sth->finish();
die "Impossible to check if the user $login has domains.";
}
while(my $ref = $sth->fetchrow_hashref) {
push @$domains, $ref;
}
$sth->finish();
$domains
}
sub delete_domain {
my ($self, $domain) = @_;
my $sth;
$sth = $self->dbh->prepare('delete from domain where domain=?');
unless ( $sth->execute($domain) ) {
$sth->finish();
die "Impossible to delete the $domain.";
}
$sth->finish()
}
sub delete_domains_from_user {
my ($self, $login) = @_;
my $sth;
$sth = $self->dbh->prepare('delete from domain where login=?');
unless ( $sth->execute($login) ) {
$sth->finish();
die "Impossible to delete the domains of the user $login.";
}
$sth->finish()
}
# TODO check if the domain is reserved
sub add_domain {
my ($self, $login, $domain) = @_;
my ($sth);
$sth = $self->dbh->prepare('select domain from domain where domain=?');
unless ( $sth->execute($domain) ) {
$sth->finish();
die 'Impossible to search if the domain already exists.';
}
# if the domain already exists
if (my $ref = $sth->fetchrow_arrayref) {
$sth->finish();
die 'The domain already exists.';
}
$sth = $self->dbh->prepare('insert into domain VALUES(?,?,?)');
unless ( $sth->execute($domain, $login, 0) ) {
$sth->finish();
die 'Impossible to add a domain.';
}
$sth->finish();
}
sub get_all_domains {
my ($self) = @_;
my ($sth, $domains);
$sth = $self->dbh->prepare('SELECT * FROM domain');
unless ( $sth->execute()) {
$sth->finish();
die q{Impossible to list the domains.};
}
while( my $ref = $sth->fetchrow_hashref) {
push @$domains, $ref;
}
$sth->finish();
$domains
}
sub disconnect {
my ($self) = @_;
$$self{dbh}->disconnect()
}
sub is_owning_domain {
my ($self, $login, $domain) = @_;
my $sth =
$self->dbh->prepare('SELECT * FROM domain where login=? and domain=?');
unless ($sth->execute($login, $domain)) {
$sth->finish();
die "Impossible to check if the user $login has domains.";
}
unless($sth->fetchrow_hashref) {
$sth->finish();
return 0
}
1
}
1;

16
lib/encryption.pm Normal file
View File

@ -0,0 +1,16 @@
package encryption;
use Crypt::Digest::SHA256 qw( sha256_hex ) ;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/encrypt/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/encrypt/] );
sub encrypt {
my ($x) = @_;
sha256_hex($x)
}
1;

46
lib/fileutil.pm Normal file
View File

@ -0,0 +1,46 @@
package fileutil;
use v5.14;
use URI;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/read_file write_file/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/read_file write_file/] );
sub read_file {
my ($filename) = @_;
if($filename =~ "://")
{
my $fileuri = URI->new($filename);
$filename = $fileuri->path;
}
open my $entry, '<:encoding(UTF-8)', $filename or
die "Impossible d'ouvrir '$filename' en lecture : $!";
local $/ = undef;
my $all = <$entry>;
close $entry;
return $all;
}
sub write_file {
my ($filename, $data) = @_;
if($filename =~ "://")
{
my $fileuri = URI->new($filename);
$filename = $fileuri->path;
}
open my $sortie, '>:encoding(UTF-8)', $filename or
die "Impossible d'ouvrir '$filename' en écriture : $!";
print $sortie $data;
close $sortie;
}
1;

27
lib/getiface.pm Normal file
View File

@ -0,0 +1,27 @@
package getiface;
use v5.14;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/getiface/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/getiface/] );
use interface::bind9;
use interface::knot;
use interface::nsd3;
use interface::nsd4;
sub getiface {
my ($type, $params) = @_;
for($type) {
if (/bind9/) { return interface::bind9->new($params) }
elsif (/knot/) { return interface::knot->new($params) }
elsif (/nsd3/) { return interface::nsd3->new($params) }
elsif (/nsd/) { return interface::nsd4->new($params) }
else { die "Interface for the $_ dns type not found."; }
}
}
1;

85
lib/interface/bind9.pm Normal file
View File

@ -0,0 +1,85 @@
package interface::bind9;
use v5.14;
use Moo;
use configuration ':all';
use remotecmd ':all';
has [ qw/mycfg tmpdir primarydnsserver secondarydnsserver/ ] => qw/is ro required 1/;
sub reload {
my ($self, $domain) = @_;
my $cmd = "rndc reload $domain ";
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
remotecmd $user, $host, $port, $cmd;
$cmd = "rndc notify $domain ";
remotecmd $user, $host, $port, $cmd;
}
sub primary_addzone {
my ($self, $domain, $opt) = @_;
my $cmd = "rndc addzone $domain ";
if(defined $opt) {
$cmd .= "'$opt'";
}
else {
my $dir = get_zonedir_from_cfg($$self{mycfg});
$cmd .= "\"{ type master; file \\\"$dir/$domain\\\"; allow-transfer { ";
my $sec = $$self{secondarydnsserver};
for(@$sec) {
my $v4 = get_v4_from_cfg($_);
my $v6 = get_v6_from_cfg($_);
$cmd .= $v4 . '; ' if $v4;
$cmd .= $v6 . '; ' if $v6;
}
$cmd .= " }; notify yes; };\"";
}
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
remotecmd $user, $host, $port, $cmd;
}
sub reconfig {
my ($self, $domain) = @_;
my $cmd = "rndc reconfig ";
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
remotecmd $user, $host, $port, $cmd;
}
sub delzone {
my ($self, $domain) = @_;
my $cmd = "rndc delzone $domain ";
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
remotecmd $user, $host, $port, $cmd;
my $file = get_zonedir_from_cfg($$self{mycfg});
$file .= "/$domain";
$cmd = "rm $file";
remotecmd $user, $host, $port, $cmd
}
1;

View File

@ -1,6 +1,6 @@
package app::interface::knot;
use v5.14;
package app::zone::knot_interface;
use Moose;
use Moo;
# on suppose que tout est déjà mis à jour dans le fichier
sub reload {

90
lib/interface/nsd3.pm Normal file
View File

@ -0,0 +1,90 @@
package interface::nsd3;
use v5.14;
use Moo;
use URI;
use fileutil ':all';
use remotecmd ':all';
use copycat ':all';
use configuration ':all';
has [ qw/mycfg tmpdir primarydnsserver secondarydnsserver/ ] => qw/is ro required 1/;
# on suppose que tout est déjà mis à jour dans le fichier
sub reload_sec {
my ($self, $slavedzones) = @_;
$self->_reload_conf($slavedzones);
my $cmd = "sudo nsdc rebuild && "
. " sudo nsdc restart ";
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
remotecmd $user, $host, $port, $cmd
}
# get, modify, push the file
sub _reload_conf {
my ($self, $slavedzones) = @_;
my $f = "file://$$self{tmpdir}/nsd.conf";
my $remote = ($$self{mycfg}{cfg}) ? $$self{mycfg}{cfg} : undef;
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
$remote //= "ssh://$user". '@' . "$host/etc/nsd/nsd.conf";
copycat $remote, $f;
my $data = read_file $f;
my $debut = "## BEGIN_GENERATED";
my $nouveau = '';
my $dnsslavekey = get_dnsslavekey_from_cfg($$self{primarydnsserver});
for(@{$slavedzones}) {
$nouveau .= "zone:\n\n\tname: \"$_\"\n"
. "\tzonefile: \"slave/$_\"\n\n";
my $v4 = get_v4_from_cfg($$self{primarydnsserver});
my $v6 = get_v6_from_cfg($$self{primarydnsserver});
if($v4) {
# allow notify & request xfr, v4 & v6
$nouveau .= "\tallow-notify: $v4 $dnsslavekey \n"
. "\trequest-xfr: $v4 $dnsslavekey \n\n";
}
if($v6) {
$nouveau .= "\tallow-notify: $v6 $dnsslavekey \n"
. "\trequest-xfr: $v6 $dnsslavekey \n\n";
}
}
$data =~ s/$debut.*/$debut\n$nouveau/gsm;
write_file $f, $data;
copycat $f, $remote;
my $cmd = "sudo nsdc patch && "
. " sudo rm /var/nsd3/ixfr.db";
remotecmd $user, $host, $port, $cmd;
}
sub reconfig {
my ($self, $zname) = @_;
die "nsd3 reconfig not implemented.";
}
sub delzone {
my ($self) = @_;
die "nsd3 delzone not implemented.";
}
1;

125
lib/interface/nsd4.pm Normal file
View File

@ -0,0 +1,125 @@
package interface::nsd4;
use v5.14;
use Moo;
use URI;
use fileutil ':all';
use remotecmd ':all';
use copycat ':all';
use configuration ':all';
has [ qw/mycfg tmpdir primarydnsserver secondarydnsserver/ ] => qw/is ro required 1/;
# on suppose que tout est déjà mis à jour dans le fichier
sub reload_sec {
my ($self, $slavedzones) = @_;
$self->_reload_conf($slavedzones);
my $cmd = "sudo nsd-control reconfig";
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
remotecmd $user, $host, $port, $cmd
}
# get, modify, push the file
sub _reload_conf {
my ($self, $slavedzones) = @_;
my $f = "file://$$self{tmpdir}/nsd.conf";
my $remote = ($$self{mycfg}{cfg}) ? $$self{mycfg}{cfg} : undef;
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
$remote //= "ssh://$user". '@' . "$host/etc/nsd/nsd.conf";
copycat $remote, $f;
my $data = read_file $f;
# if it's the first time we get the configuration, fresh start
$data .= "\n## BEGIN_GENERATED" if( $data !~ /BEGIN_GENERATED/);
my $v4 = get_v4_from_cfg($$self{primarydnsserver});
my $v6 = get_v6_from_cfg($$self{primarydnsserver});
my $debut = "## BEGIN_GENERATED";
my $nouveau = '';
my $dnsslavekey = get_dnsslavekey_from_cfg($$self{primarydnsserver});
# $nouveau .= "
#remote-control:
# control-enable: yes
# control-interface: 127.0.0.1
# control-port: 8952
# server-key-file: '/etc/nsd/nsd_server.key'
# server-cert-file: '/etc/nsd/nsd_server.pem'
# control-key-file: '/etc/nsd/nsd_control.key'
# control-cert-file: '/etc/nsd/nsd_control.pem'
#
#key:
#
## pattern : configuration to reproduce on every slaves
$nouveau .= "
pattern:
\tname: 'slavepattern'
";
if($v4) {
# allow notify & request xfr, v4 & v6
$nouveau .= "\tallow-notify: $v4 \"$dnsslavekey\" \n"
. "\trequest-xfr: $v4 \"$dnsslavekey\" \n";
}
if($v6) {
$nouveau .= "\tallow-notify: $v6 \"$dnsslavekey\" \n"
. "\trequest-xfr: $v6 \"$dnsslavekey\" \n";
}
$nouveau .= "\n";
for(@{$slavedzones}) {
$nouveau .= "zone:\n\tname: \"$$_{domain}\"\n"
. "\tzonefile: \"slave/$$_{domain}\"\n";
$nouveau .= "\tinclude-pattern: 'slavepattern'\n\n";
}
$data =~ s/$debut.*/$debut\n$nouveau/gsm;
write_file $f, $data;
copycat $f, $remote;
my $cmd = "sudo nsd-control reconfig";
remotecmd $user, $host, $port, $cmd
}
sub reconfig {
my ($self, $zname) = @_;
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
my $cmd = "sudo nsd-control reconfig";
remotecmd $user, $host, $port, $cmd
}
sub delzone {
my ($self) = @_;
my $user = get_user_from_cfg($$self{mycfg});
my $host = get_host_from_cfg($$self{mycfg});
my $port = get_port_from_cfg($$self{mycfg});
my $cmd = "sudo nsd-control reconfig";
remotecmd $user, $host, $port, $cmd;
#die "nsd4 delzone not implemented.";
}
1;

35
lib/remotecmd.pm Normal file
View File

@ -0,0 +1,35 @@
package remotecmd;
use v5.14;
use Net::OpenSSH;
use Net::SSH q<sshopen2>;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/remotecmd/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/remotecmd/] );
sub remotecmd {
my ($user, $host, $port, $cmd) = @_;
#sshopen2("-p '$port' $user\@$host", *READER, *WRITER, "$cmd")
#|| die "ssh: $!";
#system("ssh -p '$port' '$user". '@'. "$host' '$cmd'");
#my $ret = '';
#$ret .= $_ while(<READER>);
#close(READER);
#close(WRITER);
my $str = "ssh -p $port $user". '@' . "$host '$cmd'";
say "";
say "CMD : $str";
say "";
qx/$str/;
}
1;

46
lib/rt/admin.pm Normal file
View File

@ -0,0 +1,46 @@
package rt::admin;
use configuration ':all';
use app;
use utf8;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/rt_admin/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/rt_admin/] );
sub rt_admin {
my ($session, $param, $request) = @_;
my $res;
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ($user && $$user{admin}) {
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
my $alldomains = $app->get_all_domains;
my $allusers = $app->get_all_users;
my $domains = $app->get_domains($$session{login});
$$res{template} = 'administration';
$$res{params} = {
login => $$session{login}
, admin => 1 # we know it, or we couldn't reach this
, domains => $domains
, alldomains => $alldomains
, allusers => $allusers
};
$app->disconnect();
};
$res
}
1;

502
lib/rt/domain.pm Normal file
View File

@ -0,0 +1,502 @@
package rt::domain;
use v5.14;
use configuration ':all';
use encryption ':all';
use util ':all';
use app;
use utf8;
use Dancer ':syntax';
use Data::Dump qw( dump );
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/
rt_dom_cli_mod_entry
rt_dom_mod_entry
rt_dom_del_entry
rt_dom_del
rt_dom_add
rt_dom_details
rt_dom_update
rt_dom_updateraw
/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/
rt_dom_cli_mod_entry
rt_dom_mod_entry
rt_dom_del_entry
rt_dom_del
rt_dom_add
rt_dom_details
rt_dom_update
rt_dom_updateraw
/] );
sub rt_dom_cli_mod_entry {
my ($session, $param, $request) = @_;
my $res;
eval {
my $pass = encrypt($$param{pass});
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $pass);
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
$app->modify_entry( $$param{domain}
, {
type => $$param{type}
, name => $$param{name}
, host => $$param{host}
, ttl => $$param{ttl}
}
, {
newtype => $$param{type}
, newname => $$param{name}
, newhost => $$param{ip}
, newttl => $$param{ttl}
, newpriority => ''
});
$app->disconnect();
};
$res
}
sub rt_dom_mod_entry {
my ($session, $param, $request) = @_;
my $res;
$$res{route} = '/domain/details/'. $$param{domain};
# check if user is logged
unless( $$session{login}) {
$$res{deferred}{errmsg} = q{Vous n'êtes pas enregistré. };
$$res{sessiondestroy} = 1;
return $res;
}
my @missingitems;
for(qw/type name ttl domain name type host ttl
newtype newhost newname newttl/) {
push @missingitems, $_ unless($$param{$_});
}
if($$param{type} eq 'MX' && ! $$param{newpriority}) {
push @missingitems, "newpriority";
}
if(@missingitems != 0) {
$$res{deferred}{errmsg} = "Il manque : " . join ', ', @missingitems;
return $res;
}
for(qw/type name ttl domain name type host ttl
newpriority newtype newhost newname newttl/) {
say "$_ : $$param{$_}" if $$param{$_};
}
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
return $res;
}
unless( $$param{domain} ) {
$$res{deferred}{errmsg} = q<Domaine non renseigné.>;
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
$app->modify_entry( $$param{domain}
, {
type => $$param{type}
, name => $$param{name}
, host => $$param{host}
, ttl => $$param{ttl}
}
, {
newtype => $$param{newtype}
, newname => $$param{newname}
, newhost => $$param{newhost}
, newttl => $$param{newttl}
, newpriority => $$param{newpriority}
});
$app->disconnect();
};
$res
}
sub rt_dom_del_entry {
my ($session, $param, $request) = @_;
my $res;
eval {
# Load :domain and search for corresponding data
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
unless( $$param{domain} ) {
$$res{deferred}{errmsg} = q{Domaine non renseigné.};
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
$app->delete_entry( $$param{domain}, {
type => $$param{type},
name => $$param{name},
host => $$param{host},
ttl => $$param{ttl}
});
$app->disconnect();
};
$$res{route} = '/domain/details/'. $$param{domain};
$res
}
sub rt_dom_del {
my ($session, $param, $request) = @_;
my $res;
unless( $$param{domain} ) {
$$res{deferred}{errmsg} = q<Domaine non renseigné.>;
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
if( ! is_domain_name($$param{domain})) {
$$res{deferred}{errmsg} = q<Domaine non conforme.>;
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
$app->delete_domain($$param{domain});
$app->disconnect();
};
if($@) {
$$res{deferred}{errmsg} = q{Impossible de supprimer le domaine. } . $@;
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
if( $$request{referer} =~ "/domain/details" ) {
$$res{route} = '/user/home';
}
else {
$$res{route} = $$request{referer};
}
$res
}
sub rt_dom_add {
my ($session, $param) = @_;
my $res;
$$res{route} = '/user/home';
# check if user is logged
unless( $$session{login}) {
$$res{deferred}{errmsg} = q{Vous n'êtes pas enregistré. };
$$res{sessiondestroy} = 1;
$$res{route} = '/';
return $res;
}
# check if domain parameter is set
unless( $$param{domain} && length $$param{domain} > 0) {
$$res{deferred}{errmsg} =
q{Domaine personnel non renseigné correctement. };
return $res;
}
# check if tld parameter is set
unless( $$param{tld} && length $$param{tld} > 0) {
$$res{deferred}{errmsg} = q{Choix du domaine non fait. };
return $res;
}
if(is_reserved($$param{domain})) {
$$res{deferred}{errmsg} = q{Nom de domaine réservé. };
}
elsif ( ! is_domain_name($$param{domain}) ) {
$$res{deferred}{errmsg} =
q{Nom de domaine choisi comportant des caractères invalides. };
}
elsif ( ! is_valid_tld($$param{tld}) ) {
$$res{deferred}{errmsg} =
q{Mauvais choix de domaine. };
}
else {
my $domain = $$param{domain} . $$param{tld};
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
$app->add_domain( $$user{login}, $domain );
$$res{addsession}{domainName} = $$param{domain};
$$res{deferred}{succmsg} =
q{Le nom de domaine a bien été réservé ! };
$app->disconnect();
};
if( $@ ) {
$$res{deferred}{errmsg} = q{Une erreur est survenue. } . $@;
}
}
$res
}
sub rt_dom_details {
my ($session, $param, $request) = @_;
my $res;
# check if user is logged & if domain parameter is set
unless($$session{login}) {
$$res{deferred}{errmsg} = q{Session inactive.};
$$res{route} = '/';
return $res;
}
unless($$param{domain}) {
$$res{deferred}{errmsg} = q{Domaine non renseigné.};
$$res{route} = '/';
return $res;
}
my $app;
eval {
$app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
my $zone = $app->get_domain($$param{domain});
$app->disconnect();
$$res{template} = 'details';
$$res{params} = {
login => $$session{login}
, admin => $$user{admin}
, domain => $$param{domain}
, domain_zone => $zone->output()
, user_ip => $$request{address}
};
if($$param{expert}) {
$$res{params}{expert} = 1;
}
else {
$$res{params}{a} = $zone->a();
$$res{params}{aaaa} = $zone->aaaa();
$$res{params}{cname} = $zone->cname();
$$res{params}{ptr} = $zone->ptr();
$$res{params}{mx} = $zone->mx();
$$res{params}{ns} = $zone->ns();
for(qw/a aaaa cname ptr mx ns/) {
my $t = $_;
map { $$_{type} = uc $t } @{$$res{params}{$t}};
}
}
};
if($@) {
$app->disconnect() if $app;
$$res{deferred}{errmsg} = $@;
$$res{route} = '/';
return $res;
}
$res
}
sub rt_dom_update {
my ($session, $param) = @_;
my $res;
unless( $$session{login} && $$param{domain} ) {
$$res{route} = '/';
return $res;
}
$$res{route} = '/domain/details/'. $$param{domain};
my @missingitems;
for(qw/type name value ttl domain/) {
push @missingitems, $_ unless($$param{$_});
}
if($$param{type} eq 'MX' && ! $$param{priority}) {
push @missingitems, "priority";
}
if(@missingitems != 0) {
$$res{deferred}{errmsg} = "Il manque : " . join ', ', @missingitems;
return $res;
}
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
my $zone = $app->get_domain( $$param{domain} );
# TODO better naming convention
my $entries;
for( $$param{type} ) {
if($_ eq 'A') { $entries = $zone->a }
elsif( $_ eq 'AAAA') { $entries = $zone->aaaa }
elsif( $_ eq 'CNAME') { $entries = $zone->cname }
elsif( $_ eq 'MX') { $entries = $zone->mx }
elsif( $_ eq 'PTR') { $entries = $zone->ptr }
elsif( $_ eq 'NS') { $entries = $zone->ns }
elsif( $_ eq 'TXT') { $entries = $zone->txt } # TODO verify this
}
my $new_entry = {
name => $$param{name}
, class => "IN"
, host => $$param{value}
, ttl => $$param{ttl}
, ORIGIN => $zone->origin
};
$$new_entry{priority} = $$param{priority} if $$param{type} eq 'MX';
push @$entries, $new_entry;
$zone->new_serial();
$app->update_domain( $zone , $$param{domain} );
$app->disconnect();
};
if ( $@ ) {
$$res{deferred}{errmsg} = q{Problème de mise à jour du domaine. }. $@;
}
$res
}
sub rt_dom_updateraw {
my ($session, $param, $request) = @_;
my $res;
# check if user is logged & if domain parameter is set
unless($$session{login} && $$param{domain}) {
$$res{sessiondestroy} = 1;
$$res{route} = '/';
return $res;
}
my @missingitems;
for(qw/domain zoneupdated/) {
push @missingitems, $_ unless($$param{$_});
}
if(@missingitems != 0) {
$$res{deferred}{errmsg} = "Il manque : " . join ', ', @missingitems;
$$res{route} = '/user/home';
return $res;
}
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
# if the user exists and if
# he is admin or he owns the requested domain
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
$$res{deferred}{errmsg} = q{Donnée privée, petit coquin. ;) };
$$res{route} = '/';
return $res;
}
else {
my $success =
$app->update_domain_raw($$param{zoneupdated}, $$param{domain});
unless($success) {
$$res{deferred}{errmsg} = q{Problème de mise à jour du domaine.};
}
$$res{route} = '/domain/details/' . $$param{domain};
}
$app->disconnect();
};
if($@) {
$$res{deferred}{errmsg} = $@;
$$res{route} = '/user/home';
}
$res
}
1;

45
lib/rt/root.pm Normal file
View File

@ -0,0 +1,45 @@
package rt::root;
use configuration ':all';
use app;
use utf8;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/rt_root/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/rt_root/] );
sub rt_root {
my ($session) = @_;
my $res;
$$res{template} = 'index';
if( exists $$session{login} && length $$session{login} > 0) {
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
if( $user ) {
$$res{params} = {
login => $$session{login}
, admin => $$user{admin}
, domains => $$user{domains}
};
}
$app->disconnect();
};
if( $@ ) {
$$res{deferred}{errmsg} = q{Une erreur est survenue. } . $@;
$$res{sessiondestroy} = 1;
}
}
$res
}
1;

255
lib/rt/user.pm Normal file
View File

@ -0,0 +1,255 @@
package rt::user;
use v5.14;
use configuration ':all';
use encryption ':all';
use app;
use utf8;
use YAML::XS;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/
rt_user_login
rt_user_del
rt_user_toggleadmin
rt_user_subscribe
rt_user_add
rt_user_home
/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/
rt_user_login
rt_user_del
rt_user_toggleadmin
rt_user_subscribe
rt_user_add
rt_user_home
/] );
sub rt_user_login {
my ($session, $param, $request) = @_;
my $res;
# Check if user is already logged
if ( exists $$session{login} && length $$session{login} > 0 ) {
$$res{deferred}{errmsg} = q{Vous êtes déjà connecté.};
$$res{route} = '/';
return $res;
}
# Check user login and password
unless ( exists $$param{login}
&& exists $$param{password}
&& length $$param{login} > 0
&& length $$param{password} > 0 ) {
$$res{deferred}{errmsg} = q{Vous n'avez pas renseigné tous les paramètres.};
$$res{route} = '/';
return $res;
}
eval {
my $app = app->new(get_cfg());
my $pass = encrypt($$param{password});
my $user = $app->auth($$param{login}, $pass);
unless( $user ) {
$$res{deferred}{errmsg} =
q{Impossible de se connecter (login ou mot de passe incorrect).};
$$res{route} = '/';
return $res;
}
$$res{addsession}{login} = $$param{login};
$$res{addsession}{passwd} = $pass;
# TODO adds a freeze feature, not used for now
# $$res{addsession}{user} = freeze( $user );
if( $$user{admin} ) {
$$res{route} = '/admin';
}
else {
$$res{route} = '/user/home';
}
$app->disconnect();
};
if( $@ ) {
$$res{deferred}{errmsg} = q{Impossible de se connecter ! } . $@;
$$res{sessiondestroy} = 1;
$$res{route} = '/';
}
$res
}
sub rt_user_del {
my ($session, $param, $request) = @_;
my $res;
unless ( $$param{user} ) {
$$res{deferred}{errmsg} = q{Le nom d'utilisateur n'est pas renseigné.};
return $res;
}
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
if ( $user && $$user{admin} || $$session{login} eq $$param{user} ) {
$app->delete_user($$param{user});
}
$app->disconnect();
};
if ( $@ ) {
$$res{deferred}{errmsg} =
"L'utilisateur $$res{user} n'a pas pu être supprimé. $@";
}
if( $$request{referer} ) {
$$res{route} = $$request{referer};
}
else {
$$res{route} = '/';
}
$res
}
sub rt_user_toggleadmin {
my ($session, $param, $request) = @_;
my $res;
unless( $$param{user} ) {
$$res{deferred}{errmsg} = q{L'utilisateur n'est pas défini.};
$$res{route} = $$request{referer};
return $res;
}
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless ( $user && $$user{admin} ) {
$$res{deferred}{errmsg} = q{Vous n'êtes pas administrateur.};
return $res;
}
$app->toggle_admin($$param{user});
$app->disconnect();
};
if( $$request{referer} =~ '/admin' ) {
$$res{route} = $$request{referer};
}
else {
$$res{route} = '/';
}
$res
}
sub rt_user_subscribe {
my ($session, $param, $request) = @_;
my $res;
if( $$session{login} ) {
$$res{route} = '/user/home';
}
else {
$$res{template} = 'subscribe';
}
$res
}
sub rt_user_add {
my ($session, $param, $request) = @_;
my $res;
unless ( $$param{login} && $$param{password} && $$param{password2} ) {
$$res{deferred}{errmsg} = q{Identifiant ou mot de passe non renseigné.};
$$res{route} = '/user/subscribe';
return $res;
}
unless ( $$param{password} eq $$param{password2} ) {
$$res{deferred}{errmsg} = q{Les mots de passes ne sont pas identiques.};
$$res{route} = '/user/subscribe';
return $res;
}
eval {
my $pass = encrypt($$param{password});
my $app = app->new(get_cfg());
$app->register_user($$param{login}, $pass);
$app->disconnect();
$$res{addsession}{login} = $$param{login};
$$res{addsession}{passwd} = $pass;
$$res{route} = '/user/home';
};
if($@) {
$$res{deferred}{errmsg} = q{Ce pseudo est déjà pris.} . $@;
$$res{route} = '/user/subscribe';
return $res;
}
$res
}
sub rt_user_home {
my ($session, $param, $request) = @_;
my $res;
$$res{template} = 'home';
eval {
my $app = app->new(get_cfg());
my $user = $app->auth($$session{login}, $$session{passwd});
unless( $user ) {
$$res{deferred}{errmsg} = q{Problème de connexion à votre compte.};
$$res{sessiondestroy} = 1;
$$res{route} = '/';
return $res;
}
my $domains = $app->get_domains($$session{login});
my $dn = $$session{domainName};
#$$res{delsession}{domainName};
$$res{params} = {
login => $$session{login}
, admin => $$user{admin}
, domains => $domains
, provideddomains => $$app{tld}
, domainName => $dn
};
$app->disconnect();
};
if( $@ ) {
$$res{sessiondestroy} = 1;
$$res{deferred}{errmsg} = q{On a chié quelque-part.} . $@;
$$res{route} = '/';
}
$res
}
1;

113
lib/testapp.pl Normal file
View File

@ -0,0 +1,113 @@
#!/usr/bin/perl -w
use v5.14;
use strict;
use warnings;
use File::Basename;
use utf8;
use YAML::XS;
use configuration ':all';
use util ':all';
use app;
use rt::root ':all';
use rt::domain ':all';
use rt::user ':all';
use rt::admin ':all';
#my $test_updateraw = sub {
# rt_dom_updateraw
# get_session( qw/login passwd/ )
# , get_param( qw/domain zoneupdated/ ); # TODO verify this
#};
my $test_update = sub {
rt_dom_update
{ qw/login test passwd test/ }
, { qw/type A
name www
value 10.0.0.1
ttl 100
priority 1
domain test.netlib.re./ };
};
#my $test_detail = sub {
# rt_dom_details
# get_session( qw/login passwd/ )
# , get_param( qw/domain expert/ )
# , get_request( qw/address referer/ );
#};
my $test_add_domain = sub {
rt_dom_add
{ qw/login test passwd test/}
, { qw/domain test tld .netlib.re./ };
};
my $test_del_domain = sub {
rt_dom_del
{ qw/login test passwd test/ }
, { qw/domain test.netlib.re./ }
, { qw/address referer/ }; # TODO
};
#my $test_del_entry = sub {
# rt_dom_del_entry
# get_session( qw/login passwd/ )
# , get_param( qw/domain name type host ttl/ )
# , get_request( qw/address referer/ );
#};
#my $test_mod_entry = sub {
# rt_dom_mod_entry
# get_session( qw/login passwd/ )
# , get_param( qw/domain name type host ttl/ )
# , get_request( qw/address referer/ );
#};
my $test_cli_mod_entry = sub {
rt_dom_cli_mod_entry
get_session( qw/login/ )
, get_param( qw/passwd domain name type host ttl ip/ );
};
#any ['get', 'post'] => '/admin' => sub {
# rt_admin
# get_session( qw/login passwd/ );
#};
#get '/home' => sub {
# rt_user_home
# get_session( qw/login passwd/ )
# , get_param( qw// )
# , get_request( qw// );
#};
my $test_del_user = sub {
rt_user_del
get_session( qw/login passwd/ )
, { qw/user test/ }
, { qw/referer/ };
};
my $test_add_user = sub {
rt_user_add
{ qw// }
, { qw/login test password test password2 test/ }
, { qw// };
};
say "Tests - ";
# get '/subscribe' => sub {
# rt_user_subscribe
# get_session( qw/login/ );
# };
#my $test_toggle_admin = sub {
# rt_user_toggleadmin
# { qw/login passwd/ }
# , get_param( qw/user/ )
# , get_request( qw/referer/ );
#};

31
lib/util.pm Normal file
View File

@ -0,0 +1,31 @@
package util;
use v5.10;
use configuration ':all';
use YAML::XS;
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/is_domain_name is_valid_tld/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/is_domain_name is_valid_tld/] );
# TODO we can check if dn matches our domain name
sub is_domain_name {
my ($dn) = @_;
my $ndd = qr/^
([a-zA-Z0-9]+[a-zA-Z0-9-]*[a-zA-Z0-9]*[.])*
[a-zA-Z0-9]+[a-zA-Z0-9-]*[a-zA-Z0-9]([.])?
$/x;
return $dn =~ $ndd;
}
sub is_valid_tld {
my ($tld) = @_;
my $cfg = get_cfg;
grep { $_ eq $tld } @{$$cfg{tld}};
}
1;

284
lib/zone.pm Normal file
View File

@ -0,0 +1,284 @@
package zone;
use v5.14;
use Moo;
use Modern::Perl;
# TODO all this file is to redesign
use getiface ':all';
use copycat ':all';
use fileutil ':all';
use configuration ':all';
use Data::Dump qw( dump );
use zonefile;
# primary dns interface
has dnsi => ( is => 'rw', builder => '_void_arr');
# dns interface for secondary name servers
has dnsisec => ( is => 'rw', builder => '_void');
has [ qw/tld tmpdir domain primarydnsserver secondarydnsserver slavedzones/ ]
=> qw/is ro required 1/;
sub _void { my $x = ''; \$x; }
sub _void_arr { [] }
sub get_ztmp_file_ {my $s = shift; "$$s{tmpdir}/$$s{domain}" }
sub get_ztpl_dir_ {my $s = shift; "$$s{dnsi}{mycfg}{zonedir}" }
sub get_ztpl_file_ {
my $s = shift;
# for each TLD
for(@{$$s{tld}}) {
# if our domain is part of this TLD, get the right template
if($$s{domain} =~ $_) {
return $s->get_ztpl_dir_() . '/' . $_ . '.tpl';
}
}
die "There is no template for $$s{domain}.";
}
sub get_dnsserver_interface {
my ($self, $dnsserver) = @_;
my $cfg = {
mycfg => $dnsserver
, primarydnsserver => $$self{primarydnsserver}
, secondarydnsserver => $$self{secondarydnsserver}
, tmpdir => $$self{tmpdir}
};
getiface $$dnsserver{app}, $cfg
}
sub get_dns_server_interfaces {
my $self = shift;
my $primary = $$self{primarydnsserver};
my $s = $$self{secondarydnsserver};
my $prim = $self->get_dnsserver_interface($primary);
my @sec;
for(@{$s}) {
push @sec, $self->get_dnsserver_interface($_);
}
($prim, [ @sec ])
}
sub BUILD {
my $self = shift;
($$self{dnsi}, $$self{dnsisec}) = $self->get_dns_server_interfaces()
}
# change the origin in a zone file template
sub mod_orig_template {
my ($file, $domain) = @_;
say "s/CHANGEMEORIGIN/$domain/ on $file";
qx[sed -i "s/CHANGEMEORIGIN/$domain/" $file];
}
sub get_remote_zf_ {
my $self = shift;
"$$self{dnsi}{mycfg}{zonedir}/$$self{domain}"
}
sub are_same_records_ {
my ($a, $b) = @_;
#debug({ a => $a });
#debug({ b => $b });
#$a->{priority} eq $b->{priority} &&
( $$a{name} eq $$b{name} &&
$$a{host} eq $$b{host} &&
$$a{ttl} == $$b{ttl} )
}
# returns the lists of domains of a certain type
sub get_records_ {
my ($zone, $entry) = @_;
for( lc $$entry{type} ) {
if ($_ eq 'a') { return $zone->a }
elsif ($_ eq 'aaaa') { return $zone->aaaa }
elsif ($_ eq 'cname') { return $zone->cname }
elsif ($_ eq 'ns') { return $zone->ns }
elsif ($_ eq 'mx') { return $zone->mx }
elsif ($_ eq 'ptr') { return $zone->ptr }
}
die 'Impossible to get the entry type.'
}
sub reload_secondary_dns_servers {
my $self = shift;
$_->reload_sec($$self{slavedzones}) for(@{$$self{dnsisec}})
}
sub delete_entry {
my ($self, $entryToDelete) = @_;
my $zone = $self->get();
my $records = get_records_ $zone, $entryToDelete;
if( defined $records ) {
foreach my $i ( 0 .. scalar @{$records}-1 ) {
if(are_same_records_($records->[$i], $entryToDelete)) {
delete $records->[$i];
}
}
}
$zone
}
sub modify_entry {
my ($self, $entryToModify, $newEntry) = @_;
my $zone = $self->get();
my $records = get_records_ $zone, $entryToModify;
if( defined $records ) {
foreach my $i ( 0 .. scalar @{$records}-1 ) {
if(are_same_records_($records->[$i], $entryToModify)) {
say "ENTRY TO MODIFY";
say $records->[$i]->{name} . ' = ' . $newEntry->{newname};
say $records->[$i]->{host} . ' = ' . $newEntry->{newhost};
say $records->[$i]->{ttl} . ' = ' . $newEntry->{newttl};
#say $records->[$i]->{type} . ' = ' . $newEntry->{newtype};
$records->[$i]->{name} = $newEntry->{newname};
$records->[$i]->{host} = $newEntry->{newhost};
$records->[$i]->{ttl} = $newEntry->{newttl};
#$records->[$i]->{type} = $newEntry->{newtype};
if( $$newEntry{newtype} eq 'MX' ) {
say
$records->[$i]->{priority}.' = '.$newEntry->{newpriority};
$records->[$i]->{priority} = $newEntry->{newpriority};
}
}
}
}
dump($records);
$zone
}
sub get {
my $self = shift;
my $file = $self->get_remote_zf_();
my $dest = $self->get_ztmp_file_();
copycat ($file, $dest);
zonefile->new(domain => $$self{domain}, zonefile => $dest);
}
=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->get_ztpl_file_();
my $tmpfile = $self->get_ztmp_file_();
copycat ($tpl, $tmpfile); # get the template
# get the file path
my $f = URI->new($tmpfile);
# sed CHANGEMEORIGIN by the real origin
mod_orig_template ($f->path, $$self{domain});
my $zonefile = zonefile->new(zonefile => $f->path
, domain => $$self{domain});
$zonefile->new_serial(); # update the serial number
# write the new zone tmpfile to disk
write_file $f->path, $zonefile->output();
my $file = $self->get_remote_zf_();
copycat ($tmpfile, $file); # put the final zone on the server
unlink($f->path); # del the temporary file
# add new zone on the primary ns
$self->dnsi->primary_addzone($$self{domain});
# add new zone on secondary ns
$self->reload_secondary_dns_servers()
}
=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 = $self->get_ztmp_file_();
# write the new zone tmpfile to disk
write_file $tmpfile, $zonefile->output();
my $file = $self->get_remote_zf_();
copycat ($tmpfile, $file); # put the final zone on the server
unlink($tmpfile); # del the temporary file
$self->dnsi->reload($$self{domain});
}
=pod
udpate via the raw content of the zonefile
=cut
sub update_raw {
my ($self, $zonetext) = @_;
my $zonefile;
my $file = $self->get_ztmp_file_();
# write the updated zone file to disk
write_file $file, $zonetext;
eval { $zonefile = zonefile->new(zonefile => $file
, domain => $$self{domain}); };
if( $@ ) {
unlink($file);
die 'zone update_raw, zonefile->new error. ' . $@;
}
unlink($file);
$self->update($zonefile)
}
sub del {
my ($self) = @_;
$self->dnsi->delzone($$self{domain});
$self->dnsi->reconfig();
$self->reload_secondary_dns_servers()
}
1;

52
lib/zonefile.pm Normal file
View File

@ -0,0 +1,52 @@
package zonefile;
use v5.14;
use Moo;
use DNS::ZoneParse;
has zone => qw/is rw/ ;
has [ qw/domain/ ] => qw/ is ro required 1/;
has [ qw/zonefile/ ] => qw/ is rw required 1/;
sub BUILD {
my ($self) = @_;
my $filename = $$self{zonefile};
if($filename =~ "://")
{
my $fileuri = URI->new($filename);
$filename = $fileuri->path;
}
$$self{zone} = DNS::ZoneParse->new($filename, $$self{domain});
}
sub new_serial {
my $self = shift;
$self->zone->new_serial();
}
sub origin {
my $self = shift;
$self->zone->origin();
}
sub output {
my $self = shift;
$self->zone->output();
}
sub dump {
my $self = shift;
$self->zone->dump();
}
# better encapsulation
sub a { my $self = shift; $self->zone->a }
sub aaaa { my $self = shift; $self->zone->aaaa }
sub cname { my $self = shift; $self->zone->cname }
sub ns { my $self = shift; $self->zone->ns }
sub mx { my $self = shift; $self->zone->mx }
sub ptr { my $self = shift; $self->zone->ptr }
sub txt { my $self = shift; $self->zone->txt } # TODO TEST THIS
1;

View File

@ -12,7 +12,7 @@
<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>.
Powered by <a href="http://perldancer.org/">Dancer2</a>.
</div>
</body>
</html>

View File

@ -12,7 +12,7 @@
<h2>Internal Server Error</h2><p>Wooops, something went wrong</p>
</div>
<div id="footer">
Powered by <a href="http://perldancer.org/">Dancer</a>.
Powered by <a href="http://perldancer.org/">Dancer2</a>.
</div>
</body>
</html>

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

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

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

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

View File

@ -1,15 +1,16 @@
#!/usr/bin/env perl
use Dancer ':syntax';
BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';}
use Dancer2;
use FindBin '$RealBin';
use Plack::Runner;
# For some reason Apache SetEnv directives dont propagate
# correctly to the dispatchers, so forcing PSGI and env here
# 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 $psgi = path($RealBin, '..', 'bin', 'app.psgi');
die "Unable to read startup script: $psgi" unless -r $psgi;
Plack::Runner->run($psgi);

View File

@ -1,15 +1,16 @@
#!/usr/bin/env perl
use Dancer ':syntax';
BEGIN { $ENV{DANCER_APPHANDLER} = 'PSGI';}
use Dancer2;
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
# 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 $psgi = path($RealBin, '..', 'bin', 'app.psgi');
my $app = do($psgi);
die "Unable to read startup script: $@" if $@;
my $server = Plack::Handler::FCGI->new(nproc => 5, detach => 1);

BIN
public/favicon.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

View File

Before

Width:  |  Height:  |  Size: 61 KiB

After

Width:  |  Height:  |  Size: 61 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

23
public/js/jquery.min.js vendored Normal file

File diff suppressed because one or more lines are too long

View File

@ -6,16 +6,17 @@ Ce qui permet d'être un remplaçant de DynDNS.
## Outils
* [Dancer](http://perldancer.org/)
* [DNS::ZoneParse](http://search.cpan.org/~mschilli/DNS-ZoneParse-1.10/lib/DNS/ZoneParse.pm)
* [Dancer2](http://perldancer.org/)
* [DNS::ZoneParse](https://metacpan.org/pod/DNS::ZoneParse)
* [Bootstrap](http://twitter.github.io/bootstrap/)
* [DBD::mysql](https://metacpan.org/module/DBD::mysql)
* [Moose](https://metacpan.org/module/ETHER/Moose-2.0802/lib/Moose.pm)
* [Crypt::Digest::SHA256](http://search.cpan.org/~mik/CryptX-0.021/lib/Crypt/Digest/SHA256.pm)
* [Moo](https://metacpan.org/pod/Moo)
* [Crypt::Digest::SHA256](https://metacpan.org/pod/Crypt::Digest::SHA256)
## TODO
* captcha
* demander confirmation avant suppression d'une zone
* rajouter les types de RR manquants dans l'interface
* rajouter les types de RR manquants dans l'interface (remplacement de
DNS::ZoneParse, ou amélioration)
* déléguer les zones

View File

@ -1,5 +1,5 @@
use Test::More tests => 1;
use strict;
use warnings;
use_ok 'DNSManager';
use Test::More tests => 1;
use_ok 'MyWeb::App';

15
t/002_index_route.t Normal file
View File

@ -0,0 +1,15 @@
use strict;
use warnings;
use MyWeb::App;
use Test::More tests => 2;
use Plack::Test;
use HTTP::Request::Common;
my $app = MyWeb::App->to_app;
is( ref $app, 'CODE', 'Got app' );
my $test = Plack::Test->create($app);
my $res = $test->request( GET '/' );
ok( $res->is_success, '[GET /] successful' );

23
t/003_basic_functions.t Normal file
View File

@ -0,0 +1,23 @@
use Test::More;
use Modern::Perl;
use lib 'lib';
use util ':all';
chdir 'lib'; # TODO hack at 2am
map {
ok
( ( is_domain_name $_ ), "is '$_' a domain name" )
} qw( foo.bar bar localhost. localhost );
map {
ok
( ( is_valid_tld $_ ), "is '$_' a tld in the cfg file" )
} qw( .netlib.re );
map {
ok
( ( ! is_valid_tld $_ ), "is '$_' a tld in the cfg file" )
} qw( example.com );
done_testing;

28
t/004_filutil.t Normal file
View File

@ -0,0 +1,28 @@
use Test::More;
use Modern::Perl;
use URI;
use lib 'lib';
use fileutil ':all';
my $f1 = "lib/fileutil.pm";
my $p1 = "read_file";
my $f2 = "/tmp/test";
my $d2 = "DATA";
sub t_read_file {
my ($f, $pattern) = @_;
my $data = read_file $f;
$data =~ /$pattern/;
}
sub t_write_file {
my ($f, $data) = @_;
write_file $f, $data;
my $d = read_file $f;
$d =~ /$data/;
}
ok ((t_read_file $f1, $p1) , "read_file avec $f1 / $p1" );
ok ((t_write_file $f2, $d2) , "write_file" );
done_testing;

22
t/005_copycat.t Normal file
View File

@ -0,0 +1,22 @@
use Test::More;
use Modern::Perl;
use URI;
use lib 'lib';
use fileutil ':all';
use copycat ':all';
my $l1 = "file:///etc/hosts";
my $l2 = "file:///tmp/truc";
sub t_local_local {
my ($f1, $f2) = @_;
copycat $f1, $f2;
my $file = URI->new($f2);
my $d = read_file $file->path;
$d =~ /localhost/;
}
ok ((t_local_local $l1, $l2) , "copycat local local avec $l1 / $l2" );
done_testing;

23
t/006_remotecmd.t Normal file
View File

@ -0,0 +1,23 @@
use Test::More;
use Modern::Perl;
use URI;
use lib 'lib';
use remotecmd ':all';
my $port = 22;
my $user = 'karchnu';
my $host = "karchnu.fr";
my $cmd = "ls /";
my $pattern = qr/etc/;
sub t_remotecmd {
my ($user, $host, $port, $cmd, $pattern) = @_;
my $ret = remotecmd $user, $host, $port, $cmd;
$ret =~ $pattern;
}
ok ((t_remotecmd $user, $host, $port, $cmd, $pattern) , "remote cmd" );
done_testing;

9
t/007_get_iface.t Normal file
View File

@ -0,0 +1,9 @@
use Test::More;
use Modern::Perl;
use YAML::XS;
use URI;
use lib 'lib';
use getiface':all';
my $x = getiface("bind9", { mycfg => '', data => '' });
say Dump $x;

22
t/00x_dump_cfg_file.t Normal file
View File

@ -0,0 +1,22 @@
use Test::More;
use Modern::Perl;
use YAML::XS;
use URI;
use lib 'lib';
use configuration ':all';
my $x = get_cfg();
#say Dump $x;
say $$x{database}{host};
for($$x{secondarydnsserver})
{
for(@$_)
{
while( my ($k, $v) = each %$_)
{
say $k . ' ' . $v ;
}
}
}

View File

@ -1,40 +0,0 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use Config::Simple;
use Data::Dump qw( dump );
use lib '../';
use app::app;
sub initco {
my $cfg = new Config::Simple('./config.ini');
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();
return $app;
}
if( @ARGV < 2) {
say "usage : ./auth.pl login mdp";
exit 1;
}
my $app = initco();
my ($auth_ok, $user, $isadmin) = $app->auth($ARGV[0], $ARGV[1]);
say "auth $auth_ok";
say "isadmin $isadmin";

View File

@ -1,13 +0,0 @@
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/"
sshhost = pizza
sshuser = karchnu

View File

@ -1,36 +0,0 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use Config::Simple;
use Data::Dump qw( dump );
use lib '../';
use app::app;
use initco;
if( @ARGV != 0 ) {
say "usage : ./get_all_domains.pl";
exit 1;
}
my $app = initco::initco();
my %domains = $app->get_all_domains();
dump(%domains);
#if( $domains ) {
# if( scalar(@$domains) != 0) {
# say join ", ", @{$domains};
# }
# else {
# say "tableau vide";
# }
#}
#else {
# say "domains undef";
#}

View File

@ -1,36 +0,0 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use Config::Simple;
use Data::Dump qw( dump );
use lib '../';
use app::app;
use initco;
if( @ARGV != 0 ) {
say "usage : ./get_all_domains.pl";
exit 1;
}
my $app = initco::initco();
my %users = $app->get_all_users();
dump(%users);
#if( $domains ) {
# if( scalar(@$domains) != 0) {
# say join ", ", @{$domains};
# }
# else {
# say "tableau vide";
# }
#}
#else {
# say "domains undef";
#}

View File

@ -1,43 +0,0 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use Config::Simple;
use Data::Dump qw( dump );
use lib '../';
use app::app;
use initco;
if( @ARGV < 2) {
say "usage : ./auth.pl login mdp";
exit 1;
}
my $app = initco::initco();
my ($auth_ok, $user, $isadmin) = $app->auth($ARGV[0], $ARGV[1]);
if($auth_ok) {
say "auth $auth_ok";
say "isadmin $isadmin";
}
my ($success, $domains) = $app->get_domains( $ARGV[0] );
say "success $success";
dump($domains);
#if( $domains ) {
# if( scalar(@$domains) != 0) {
# say join ", ", @{$domains};
# }
# else {
# say "tableau vide";
# }
#}
#else {
# say "domains undef";
#}

View File

@ -1,29 +0,0 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use DNS::ZoneParse;
use Config::Simple;
use Data::Dump qw( dump );
use lib '../';
use app::app;
use initco;
if( @ARGV != 0 ) {
say "usage : ./get_all_domains.pl";
exit 1;
}
my $app = initco::initco();
my ($success) = $app->register_user("bla", 'password');
die "erreur de nom, déjà pris" unless $success;
($success) = $app->register_user("bla", 'password');
die "erreur de nom, déjà pris" unless $success;
say "fin";

View File

@ -1,32 +0,0 @@
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use Config::Simple;
package initco;
sub initco {
my ($cfgfile) = @_;
$cfgfile = defined $cfgfile ? $cfgfile : './config.ini';
my $cfg = new Config::Simple($cfgfile);
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')
, sshhost => $cfg->param('sshhost')
, sshuser => $cfg->param('sshuser')
, dnsapp => $cfg->param('dnsapp') );
$app->init();
return $app;
}
1;

View File

@ -1,22 +0,0 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use v5.14;
use autodie;
use Modern::Perl;
use Net::OpenSSH;
my $hostname = "ns0.arn-fai.net";
my $username = "dnsmanager";
my $co = "$username\@$hostname:2222";
say $co;
my $ssh = Net::OpenSSH->new($co);
$ssh->scp_put("tpl.zone", "/home/$username/") or die "scp failed: " . $ssh->error;
#use Net::SCP; # ne fonctionne pas avec des ports :/
#my $scp = Net::SCP->new( { host => $hostname, user => $username, port => 2222} );
#$scp->put("tpl.zone", "lolwat") or die $scp->{errstr};
# $scp->put("filename") or die $scp->{errstr};

Some files were not shown because too many files have changed in this diff Show More