From ac41629891c5e837579e1f3a7e3918e0f1615b1b Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 20 Jan 2014 01:08:03 +0100 Subject: [PATCH] =?UTF-8?q?premi=C3=A8re=20version=20de=20la=20lib,=20appl?= =?UTF-8?q?ication=20web=20=C3=A0=20finir?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * la lib (app actuellement, à renommer) partiellement testée permet une utilisation facilitée des différents modules * l'application dancer permet pour le moment de connecter un utilisateur, lister les domaines, ajouter et supprimer un domaine * les fichiers t/zone* sont des fichiers de tests, et non des exemples * tpl.zone est un fichier modèle pour une nouvelle zone --- .gitignore | 2 + app/app.pm | 124 ++++++++++++++ app/bdd/admin.pm | 15 ++ app/bdd/lambda.pm | 63 +++++++ app/bdd/management.pm | 161 ++++++++++++++++++ app/zone/bind_interface.pm | 165 ++++++++++++++++++ app/zone/edit.pm | 107 ++++++++++++ app/zone/interface.pm | 14 ++ app/zone/rndc_interface.pm | 40 +++++ readme.md | 43 +++-- t/tpl.zone | 18 ++ t/zone_add.pl | 28 ++++ t/zone_del.pl | 17 ++ t/zone_rndc.pl | 32 ++++ t/zone_tmp.pl | 20 +++ www/MANIFEST | 19 +++ www/MANIFEST.SKIP | 13 ++ www/Makefile.PL | 21 +++ www/bin/app.pl | 4 + www/conf/config.ini | 11 ++ www/config.yml | 30 ++++ www/environments/development.yml | 27 +++ www/environments/production.yml | 17 ++ www/lib/DNSManager.pm | 278 +++++++++++++++++++++++++++++++ www/notes.txt | 20 +++ www/public/404.html | 18 ++ www/public/500.html | 18 ++ www/public/css/error.css | 70 ++++++++ www/public/css/style.css | 189 +++++++++++++++++++++ www/public/dispatch.cgi | 15 ++ www/public/dispatch.fcgi | 17 ++ www/public/javascripts/jquery.js | 1 + www/t/001_base.t | 5 + www/t/002_index_route.t | 10 ++ www/views/administration.tt | 8 + www/views/details.tt | 105 ++++++++++++ www/views/index.tt | 44 +++++ www/views/layouts/main.tt | 20 +++ www/views/mapage.tt | 37 ++++ 39 files changed, 1830 insertions(+), 16 deletions(-) create mode 100644 .gitignore create mode 100644 app/app.pm create mode 100644 app/bdd/admin.pm create mode 100644 app/bdd/lambda.pm create mode 100644 app/bdd/management.pm create mode 100644 app/zone/bind_interface.pm create mode 100644 app/zone/edit.pm create mode 100644 app/zone/interface.pm create mode 100644 app/zone/rndc_interface.pm create mode 100644 t/tpl.zone create mode 100755 t/zone_add.pl create mode 100755 t/zone_del.pl create mode 100755 t/zone_rndc.pl create mode 100755 t/zone_tmp.pl create mode 100644 www/MANIFEST create mode 100644 www/MANIFEST.SKIP create mode 100644 www/Makefile.PL create mode 100755 www/bin/app.pl create mode 100644 www/conf/config.ini create mode 100644 www/config.yml create mode 100644 www/environments/development.yml create mode 100644 www/environments/production.yml create mode 100644 www/lib/DNSManager.pm create mode 100644 www/notes.txt create mode 100644 www/public/404.html create mode 100644 www/public/500.html create mode 100644 www/public/css/error.css create mode 100644 www/public/css/style.css create mode 100755 www/public/dispatch.cgi create mode 100755 www/public/dispatch.fcgi create mode 120000 www/public/javascripts/jquery.js create mode 100644 www/t/001_base.t create mode 100644 www/t/002_index_route.t create mode 100644 www/views/administration.tt create mode 100644 www/views/details.tt create mode 100644 www/views/index.tt create mode 100644 www/views/layouts/main.tt create mode 100644 www/views/mapage.tt diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1b09627 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.swp +sessions diff --git a/app/app.pm b/app/app.pm new file mode 100644 index 0000000..7f74754 --- /dev/null +++ b/app/app.pm @@ -0,0 +1,124 @@ +#!/usr/bin/env perl + +use v5.14; +use DBI; + +use lib '../'; +use app::zone::interface; +use app::zone::edit; +use app::zone::rndc_interface; +use app::bdd::management; +use app::bdd::admin; +use app::bdd::lambda; + +package app; +use Moose; + +has dbh => ( is => 'rw', builder => '_void'); +has dnsi => ( is => 'rw', builder => '_void'); +has um => ( is => 'rw', builder => '_void'); +has [ qw/zdir dbname dbhost dbport dbuser dbpass sgbd dnsapp/ ] => qw/is ro required 1/; +sub _void { my $x = ''; \$x; } + +### users + +sub init { + my ($self) = @_; + + my $success; + + my $dsn = 'DBI:' . $self->sgbd + . ':database=' . $self->dbname + . ';host=' . $self->dbhost + . ';port=' . $self->dbport; + + ${$self->dbh} = DBI->connect($dsn + , $self->dbuser + , $self->dbpass) + || die "Could not connect to database: $DBI::errstr"; + + ($success, ${$self->dnsi}) = app::zone::interface ->new() + ->get_interface($self->dnsapp, $self->zdir); + + die("zone interface") unless $success; + + ${$self->um} = app::bdd::management->new(dbh => ${$self->dbh}); +} + +sub auth { + my ($self, $login, $passwd) = @_; + return ${$self->um}->auth($login, $passwd); +} + +sub register_user { + my ($self, $login, $passwd) = @_; + return ${$self->um}->register_user($login, $passwd); +} + +# TODO +sub set_admin { + my ($self, $login) = @_; + return ${$self->um}->set_admin($login); +} + +sub update_passwd { + my ($self, $login, $new) = @_; + my $user = ${$self->um}->get_user($login); + return $user->passwd($new); +} + +sub delete_user { + my ($self, $login) = @_; + return ${$self->um}->delete_user($login); +} + +### domains + +# return yes or no +sub add_domain { + my ($self, $login, $domain) = @_; + my $user = ${$self->um}->get_user($login); + $user->add_domain($domain); + + my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir); + $ze->addzone(); +} + +sub delete_domain { + my ($self, $login, $domain) = @_; + my $user = ${$self->um}->get_user($login); + $user->delete_domain($domain); + my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir); + $ze->del(); +} + +sub update_domain { + my ($self, $login, $zone, $domain) = @_; + my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir); + $ze->update($zone); +} + +sub get_domain { + my ($self, $login, $domain) = @_; + my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir); + $ze->get(); +} + +sub get_domains { + my ($self, $login) = @_; + + my $user = ${$self->um}->get_user($login); + return $user->domains; +} + +sub activate_domain { + my ($self, $domain) = @_; +} + +sub new_tmp { + my ($self, $login, $domain) = @_; + my $ze = app::zone::edit->new(zname => $domain, zdir => $self->zdir); + $ze->new_tmp(); +} + +1; diff --git a/app/bdd/admin.pm b/app/bdd/admin.pm new file mode 100644 index 0000000..d9c4b4c --- /dev/null +++ b/app/bdd/admin.pm @@ -0,0 +1,15 @@ +package app::bdd::admin; +use Moose; +extends 'app::bdd::lambda'; + +# ($success) activate_zone($domain) +sub activate_zone { + my ($self, $domain) = @_; +} + +# ($success) delete_zone($file_path) +sub delete_zone { + my ($self, $domain) = @_; +} + +1; diff --git a/app/bdd/lambda.pm b/app/bdd/lambda.pm new file mode 100644 index 0000000..62d550c --- /dev/null +++ b/app/bdd/lambda.pm @@ -0,0 +1,63 @@ +use autodie; +use v5.14; +use DBI; + +use Data::Dump "dump"; + +use lib '../../'; +package app::bdd::lambda; +use Moose; + +has qw/domains is rw/; +has [ qw/login dbh/ ] => qw/is ro required 1/; +has passwd => (is => 'rw', trigger => \&_update_passwd ); +#has qw/dbh is ro required 1/; # database handler + +# $success delete_domain +sub delete_domain { + # check if we are the owner then delete + my ($self, $domain) = @_; + my $sth; + return 0 if (grep { $domain eq $_ } @{ $self->domains }) == 0; + + $sth = $self->dbh->prepare('delete from domain where domain=?'); + unless ( $sth->execute($domain) ) { + $sth->finish(); + return 0; + } + $sth->finish(); + @{ $self->domains } = grep { $_ ne $domain } @{ $self->domains }; + return 1; +} + +sub add_domain { + my ($self, $domain) = @_; + my ($sth); + + # TODO vérifier que personne n'a ce domaine, pas seulement l'utilisateur + return 0 if (grep { $domain eq $_ } @{ $self->domains }) > 0; + + $sth = $self->dbh->prepare('insert into domain VALUES(?,?,?)'); + unless ( $sth->execute($domain, $self->login, 0) ) { + $sth->finish(); + return 0; + } + $sth->finish(); + push @{ $self->domains }, $domain; + return 1; +} + +sub _update_passwd { + my ($self, $new) = @_; + my $sth; + + $sth = $self->dbh->prepare('update user set passwd=? where login=?'); + unless ( $sth->execute($new, $self->login) ) { + $sth->finish(); + return 0; + } + $sth->finish(); + return 1; +} + +1; diff --git a/app/bdd/management.pm b/app/bdd/management.pm new file mode 100644 index 0000000..5557297 --- /dev/null +++ b/app/bdd/management.pm @@ -0,0 +1,161 @@ +use Modern::Perl; +use autodie; +use v5.14; +use DBI; + +use lib '../'; +use app::bdd::lambda; +use app::bdd::admin; +use app::zone::interface; + +package app::bdd::management; +use Moose; + +has [qw/dbh/] => qw/is rw required 1/; + +# ($success, $user, $admin) auth_user($login, $passwd) +sub auth { + my ($self, $login, $passwd) = @_; + my ($sth, $user, @domains); + + $sth = $self->dbh->prepare('SELECT * FROM user WHERE login=? and passwd=?'); + unless ( $sth->execute($login, $passwd)) { + $sth->finish(); + return 0; + } + + if (my $ref = $sth->fetchrow_arrayref) { + $sth = $self->dbh->prepare('SELECT domain FROM domain WHERE login=?'); + unless ( $sth->execute($login)) { + $sth->finish(); + return 0; + } + + # get domains + #push @domains, @$_[0] while($sth->fetchrow_arrayref); + + while(my $ref2 = $sth->fetchrow_arrayref) { + push @domains, @$ref2[0]; + } + + + # si admin + if(@$ref[2]) { + + # TODO : the admin module + $user = app::bdd::admin->new(login => @$ref[0] + , passwd => @$ref[1] + , dbh => $self->dbh + , domains => [@domains]); + $sth->finish(); + return 1, $user, 1; + + } + else { + $user = app::bdd::lambda->new(login => @$ref[0] + , passwd => @$ref[1] + , dbh => $self->dbh + , domains => [@domains]); + $sth->finish(); + return 1, $user, 0; + } + } + + $sth->finish(); + return 0; +} + +# ($success) register_user +sub register_user { + my ($self, $login, $pass) = @_; + + my $sth = $self->dbh->prepare('select * from user where login=?'); + unless ( $sth->execute($login) ) { + $sth->finish(); + return 0; + } + + if (my $ref = $sth->fetchrow_arrayref) { + #say join (', ', @$ref); + $sth->finish(); + return 0; + } + + $sth = $self->dbh->prepare('insert into user VALUES(?,?,?)'); + unless ($sth->execute($login, $pass, 0)) { + $sth->finish(); + return 0; + } + $sth->finish(); + + return 1; +} + +# ($success) delete_user +sub delete_user { + my ($self, $login) = @_; + my $sth; + + $sth = $self->dbh->prepare('delete from user where login=?'); + unless ( $sth->execute($login) ) { + $sth->finish(); + return 0; + } + $sth->finish(); + + $sth = $self->dbh->prepare('delete from domain where login=?'); + unless ( $sth->execute($login) ) { + $sth->finish(); + return 0; + } + $sth->finish(); + + return 1; +} + +sub get_user { + my ($self, $login) = @_; + my ($sth, $user, @domains); + + $sth = $self->dbh->prepare('SELECT * FROM user WHERE login=?'); + unless ( $sth->execute($login)) { + $sth->finish(); + return 0; + } + + if (my $ref = $sth->fetchrow_arrayref) { + $sth = $self->dbh->prepare('SELECT domain FROM domain WHERE login=?'); + unless ( $sth->execute($login)) { + $sth->finish(); + return 0; + } + + # get domains + #push @domains, @$_[0] while($sth->fetchrow_arrayref); + + while(my $ref2 = $sth->fetchrow_arrayref) { + push @domains, @$ref2[0]; + } + + # si admin + if(@$ref[2]) { + $user = app::bdd::admin->new(login => @$ref[0] + , passwd => @$ref[1] + , dbh => $self->dbh + , domains => [@domains]); + + } + else { + $user = app::bdd::lambda->new(login => @$ref[0] + , passwd => @$ref[1] + , dbh => $self->dbh + , domains => [@domains]); + } + $sth->finish(); + return 1, $user; + } + + $sth->finish(); +} + +1; diff --git a/app/zone/bind_interface.pm b/app/zone/bind_interface.pm new file mode 100644 index 0000000..120263d --- /dev/null +++ b/app/zone/bind_interface.pm @@ -0,0 +1,165 @@ +use Modern::Perl; +use strict; +use warnings; +use Data::Dump "dump"; +use v5.14; +use re '/x'; # very important + +use lib '../../'; +package app::zone::bind_interface; +use Moose; +#use Sudo; +# to know where the zone files are stored / to execute a sudo command +# has [ qw/zone_path sudo_pass/ ] => qw/is ro required 1/; +has [ qw/zone_path/ ] => qw/is ro required 1/; + +sub activate_zone { + my ($self, $domain, $admin_file) = @_; + open(my $file, ">>", $admin_file) + or die("error : impossible to open admin file"); +} + +=pod +zone "karchnu.fr" { + type master; + file "/srv/named/karchnu.fr"; + forwarders { 8.8.8.8; }; + allow-update { key DDNS\_UPDATER ; }; + allow-transfer { any; }; + allow-query { any; }; +}; + +zone "0.0.1.0.0.0.0.0.0.0.0.0.0.0.f.c.ip6.arpa" { + type master; + file "/srv/named/karchnu.fr.rv"; + allow-update { key DDNS\_UPDATER ; }; + allow-transfer { any; }; + allow-query { any; }; +}; + +=cut + +# TODO +sub update { + my ($self) = @_; + + #open(my $process, "service bind9 reload|"); + #say while(<$process>); + #close($process); + #my $su = Sudo->new( + # { + # sudo => '/usr/bin/sudo', + # username => 'root', + # password => $self->sudo_pass, + # program => '/usr/bin/service', + # program_args => 'bind9 reload', + # } + #); + +# my $result = $su->sudo_run(); +# if (exists($result->{error})) { +# return 0; +# } +# +# printf "STDOUT: %s\n",$result->{stdout}; +# printf "STDERR: %s\n",$result->{stderr}; +# printf "return: %s\n",$result->{rc}; +# return 1; +} + +sub parse { + my ($self, $file) = @_; + my $fh; + open($fh, "<", $self->zone_path . $file) or return; + my %zone = $self->parse_zone_file($fh) ; + close($fh); + return %zone; +} + +sub comment { + my $self = shift; + m{ ^ \s* ; \s* ( .+ ) } + and return { comment => $1 }; +} + +sub SOA { + my $self = shift; + m{ ^\s* (? \S+) + \s+ (? \S+) + \s+ SOA + \s+(? \S+) + \s+(? \S+) + \s+ \( + \s*(? \d+) + \s+(? \d+) + \s+(? \d+) + \s+(? \d+) + \s+(? \d+) + \s* + \) + } and return {%+} +} + +sub TTL { + my $self = shift; + m{ ^ \s* \$TTL \s+ (\d+) \s* $ } + and return { TTL => $1 } +} + +# rocoto IN A 192.168.0.180 +# karchnu.fr. IN MX 5 rocoto + +# exemple: +# karchnu.fr. IN MX 5 rocoto +sub entry { + my $self = shift; + m{ ^ + \s* (? \S+) + \s+ (? \S+) + (?: + \s+ (? MX) + \s+ (? \S+) + \s+ (? \S+) + | + \s+ (? A | AAAA | CNAME) + \s+ (? \S+) + | + \s+ TXT + \s+ "(? \\. | [^"]+)" + ) + } and return {%+}; +} + +sub empty_line { + my $self = shift; + /^ \s* $/x +} +# element must be used without args +# () is very important + +sub alias { + my $self = shift; + m{^ + \s* \@ + \s+ (? IN ) + \s+ (? A | AAAA | NS | MX | SOA ) + \s+ (? .* ) + } and return {%+} +} + +sub element () { + my $self = shift; + return if empty_line || comment; + SOA || TTL + || alias + || entry + || die "unparsable $_"; +} + +sub parse_zone_file { + my ($self, $fh) = @_; + map element, <$fh>; +} + + +1; diff --git a/app/zone/edit.pm b/app/zone/edit.pm new file mode 100644 index 0000000..89fd15f --- /dev/null +++ b/app/zone/edit.pm @@ -0,0 +1,107 @@ +use Modern::Perl; +use Data::Dump "dump"; +use DNS::ZoneParse; +use File::Copy; +use v5.14; + +use lib '../../'; +use app::zone::rndc_interface; +package app::zone::edit; +use Moose; + +has [ qw/zname zdir/ ] => qw/is ro required 1/; + +sub get { + my ($self) = @_; + my $file = $self->zdir.'/'.$self->zname; + my $zonefile = DNS::ZoneParse->new($file, $self->zname); + return $zonefile; +} + +=pod + copie du template pour créer une nouvelle zone + update du serial + ajout de la zone via rndc + retourne la zone + le nom de la zone +=cut + +sub addzone { + my ($self) = @_; + + my $tpl = $self->zdir."/tpl.zone"; + my $file = $self->zdir.'/'.$self->zname; + + $self->_cp($tpl, $file); + + my $zonefile = DNS::ZoneParse->new($file, $self->zname); + $zonefile->new_serial(); # update the serial number + + # write the new zone file to disk + my $newzone; + open($newzone, '>', $file) or die "error"; + print $newzone $zonefile->output(); + close $newzone; + + my $rndc = app::zone::rndc_interface->new(); + $rndc->addzone($self->zdir, $self->zname); + + return $zonefile; +} + +=pod + màj du serial + push reload de la conf +=cut + +sub update { + my ($self, $zonefile) = @_; + + # update the serial number + $zonefile->new_serial(); + + my $file = $self->zdir.'/'.$self->zname; + + # write the new zone file to disk + my $newzone; + open($newzone, '>', $file) or die "error"; + print $newzone $zonefile->output(); + close $newzone; + + my $rndc = app::zone::rndc_interface->new(); + $rndc->reload($self->zname); +} + +# sera utile plus tard, pour l'interface +sub new_tmp { + my ($self) = @_; + + my $tpl = $self->zdir."/tpl.zone"; + my $file = '/tmp/'.$self->zname; + + $self->_cp($tpl, $file); + my $zonefile = DNS::ZoneParse->new($file, $self->zname); + $zonefile->new_serial(); # update the serial number + + unlink($file); + + return $zonefile; +} + +sub _cp { + my ($self, $src, $dest) = @_; + + File::Copy::copy($src, $dest) or die "Copy failed: $! ($src -> $dest)"; + + my $orig = $self->zname; + my $cmd = qq[sed -i "s/CHANGEMEORIGIN/$orig/" $dest 2>/dev/null 1>/dev/null]; + system($cmd); +} + +sub del { + my ($self) = @_; + my $rndc = app::zone::rndc_interface->new(); + $rndc->delzone($self->zdir, $self->zname); + $rndc->reconfig(); +} + +1; diff --git a/app/zone/interface.pm b/app/zone/interface.pm new file mode 100644 index 0000000..4de538b --- /dev/null +++ b/app/zone/interface.pm @@ -0,0 +1,14 @@ +use lib '../../'; +use app::zone::bind_interface; +use app::zone::rndc_interface; +package app::zone::interface; +use Moose; + +sub get_interface { + my ($self, $type, $zp) = @_; + return 1, app::zone::bind_interface->new(zone_path => $zp) if $type eq 'bind'; + return 1, app::zone::rndc_interface->new(zdir => $zp) if $type eq 'rndc'; + return 0; +} + +1; diff --git a/app/zone/rndc_interface.pm b/app/zone/rndc_interface.pm new file mode 100644 index 0000000..e8e3826 --- /dev/null +++ b/app/zone/rndc_interface.pm @@ -0,0 +1,40 @@ +use v5.14; +package app::zone::rndc_interface; +use Moose; + +# on suppose que tout est déjà mis à jour dans le fichier +sub reload { + my ($self, $zname) = @_; + system("rndc reload $zname 2>/dev/null 1>/dev/null"); +} + +sub addzone { + my ($self, $zdir, $zname, $opt) = @_; + + my $command = "rndc addzone $zname "; + + if(defined $opt) { + $command .= "'$opt'"; + } + else { + $command .= "'{ type master; file \"$zdir/$zname\"; };'" + } + + + $command .= " 2>/dev/null 1>/dev/null"; + system($command); + +} + +sub reconfig { + my ($self, $zname) = @_; + system("rndc reconfig 2>/dev/null 1>/dev/null"); +} + +sub delzone { + my ($self, $zdir, $zname) = @_; + system("rndc delzone $zname 2>/dev/null 1>/dev/null"); + unlink("$zdir/$zname"); +} + +1; diff --git a/readme.md b/readme.md index 4fe7080..e3c8208 100644 --- a/readme.md +++ b/readme.md @@ -1,20 +1,31 @@ -# FR -## trame du projet +## FR trame du projet / TODO / brainstorming / brouillon -> "Faire le projet en POO, pour le rendre un peu modulable (au cas où on change certaines parties en cours de route). Il y aura 2 types d'utilisateurs, l'admin + un utilisateur de base. L'admin peut créer une zone, pas l'utilisateur. L'utilisateur peut juste la modifier." +### page d'inscription -> "L'inscription : l'utilisateur va envoyer une demande pour réserver un ndd en .netlib.re et il faut que ça vérifie que le ndd n'existe pas déjà puis que ça envoie un mail aux admins. De préférence, une page web testera si le ndd est libre, indiquera une erreur à l'utilisateur s'il ne l'est pas et on rajoute un captcha pour éviter des bots." -> "Côté admin : il faut que l'ajout d'une zone soit aussi automatique, pas qu'on ait à aller l'ajouter nous-même (mais ça c'est pour plus tard à la limite). J'ai trouvé quelques modules Perl qui font une partie du travail + je peux faire le site avec Dancer, du coup tout sera fait avec le même langage." +* login +* captcha -- todo + +### utilisateurs + * un login + * des domaines + * un mdp chiffré -- todo + * peuvent modifier leurs zones -- todo + * leur compte doit être activé par un admin -- todo + * réservation d'un ou plusieurs ndd en X.DOMAIN.TLD -- todo + * vérifier qu'ils ne sont pas déjà réservés ou attribués -- todo + +### admins + * Valident les comptes des utilisateurs. -- todo + * en activant une zone d'un utilisateur. -- todo + * Doit être automatisé. -- todo + * Créent et suppriment d'autres administrateurs. -- todo + * Possèdent une page pour voir les comptes non activés. -- todo ## outils -* [Dancer](http://perldancer.org/) -* [Net::DNS](https://metacpan.org/module/NLNETLABS/Net-DNS-0.72/lib/Net/DNS.pm) -* [Net::DNS::ZoneParse](https://metacpan.org/module/BTIETZ/Net-DNS-ZoneParse-0.103/lib/Net/DNS/ZoneParse.pm) -* [Bootstrap](http://twitter.github.io/bootstrap/) -* [DBD::mysql](https://metacpan.org/module/DBD::mysql) - -## TODO -+ "Vérifier si les modules cités dans 'outils' correspondent à ce que l'on cherche." - + "Aller sur #perlfr pour demander conseil." - + "Faire des tests d'exemple sur ces modules." -+ "Rajouter les modules qu'il nous manque (ex: pour le chiffrement du mot de passe avant l'ajout d'un utilisateur/admin)." + * [Dancer](http://perldancer.org/) + * [DNS::ZoneParse](http://search.cpan.org/~mschilli/DNS-ZoneParse-1.10/lib/DNS/ZoneParse.pm) + * [Bootstrap](http://twitter.github.io/bootstrap/) -- todo + * [DBD::mysql](https://metacpan.org/module/DBD::mysql) + * [Net::HTTPS::Any](https://metacpan.org/module/IVAN/Net-HTTPS-Any-0.10/lib/Net/HTTPS/Any.pm) -- todo + * [Moose](https://metacpan.org/module/ETHER/Moose-2.0802/lib/Moose.pm) + * voir pour le chiffrement diff --git a/t/tpl.zone b/t/tpl.zone new file mode 100644 index 0000000..b47432d --- /dev/null +++ b/t/tpl.zone @@ -0,0 +1,18 @@ +; +; Database file tpl.zone for tpl.zone. zone. +; Zone version: 2014011815 +; + +$ORIGIN CHANGEMEORIGIN. + + +$TTL 3600 +@ 3600 IN SOA ns0.netlib.re. postmaster.netlib.re. ( + 2014011815 ; serial number + 3600 ; refresh + 600 ; retry + 86400 ; expire + 600 ; minimum TTL + ) +; +; Zone NS Records diff --git a/t/zone_add.pl b/t/zone_add.pl new file mode 100755 index 0000000..4604843 --- /dev/null +++ b/t/zone_add.pl @@ -0,0 +1,28 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use v5.14; +use autodie; +use Modern::Perl; +use DNS::ZoneParse; + +use lib '../'; +use app::zone::rndc_interface; +use app::zone::edit; + +my $nom = $ARGV[0]; +my $zdir = "/srv/named/"; + +my $ed = app::zone::edit->new(zdir => $zdir, zname => $nom); + +my $zonefile = $ed->addzone(); + +my $a_records = $zonefile->a(); + +push (@$a_records, { name => 'www' + , class => 'IN' + , host => '192.168.0.190' + , ttl => '' + , ORIGIN => $zonefile->origin }); + +$ed->update($zonefile); diff --git a/t/zone_del.pl b/t/zone_del.pl new file mode 100755 index 0000000..96b0279 --- /dev/null +++ b/t/zone_del.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use v5.14; +use autodie; +use Modern::Perl; +use DNS::ZoneParse; + +use lib '../'; +use app::zone::rndc_interface; +use app::zone::edit; + +my $ed = app::zone::edit->new( zname => $ARGV[0], zdir => "/srv/named/"); + +say "suppression de ". $ARGV[0]; + +$ed->del(); diff --git a/t/zone_rndc.pl b/t/zone_rndc.pl new file mode 100755 index 0000000..b669659 --- /dev/null +++ b/t/zone_rndc.pl @@ -0,0 +1,32 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use v5.14; +use autodie; +use Modern::Perl; +use DNS::ZoneParse; + +use lib '../'; +use app::zone::rndc_interface; +use app::zone::edit; + +my $nom = $ARGV[0]; +my $zdir = "/srv/named/"; + +my $ed = app::zone::edit->new(zdir => $zdir, zname => $nom); + +my $zonefile = $ed->get(); + +my $a_records = $zonefile->a(); + +push (@$a_records, { name => 'web' + , class => 'IN' + , host => '192.168.0.190' + , ttl => '3600' + , ORIGIN => $zonefile->origin }); + +$ed->update($zonefile); + +$zonefile = $ed->get(); + +print $zonefile->output(); diff --git a/t/zone_tmp.pl b/t/zone_tmp.pl new file mode 100755 index 0000000..42e9f37 --- /dev/null +++ b/t/zone_tmp.pl @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use v5.14; +use autodie; +use Modern::Perl; +use DNS::ZoneParse; + +use lib '../'; +use app::zone::rndc_interface; +use app::zone::edit; + +my $nom = $ARGV[0]; +my $zdir = "/srv/named/"; + +my $ed = app::zone::edit->new(zdir => $zdir, zname => $nom); + +my $zonefile = $ed->new_tmp(); + +print $zonefile->output(); diff --git a/www/MANIFEST b/www/MANIFEST new file mode 100644 index 0000000..25d7257 --- /dev/null +++ b/www/MANIFEST @@ -0,0 +1,19 @@ +MANIFEST +bin/app.pl +config.yml +environments/development.yml +environments/production.yml +views/index.tt +views/layouts/main.tt +MANIFEST.SKIP +lib/DNSManager.pm +public/css/style.css +public/css/error.css +public/404.html +public/dispatch.fcgi +public/javascripts/jquery.js +public/dispatch.cgi +public/500.html +t/002_index_route.t +t/001_base.t +Makefile.PL diff --git a/www/MANIFEST.SKIP b/www/MANIFEST.SKIP new file mode 100644 index 0000000..8fd3d29 --- /dev/null +++ b/www/MANIFEST.SKIP @@ -0,0 +1,13 @@ +^\.git\/ +maint +^tags$ +.last_cover_stats +Makefile$ +^blib +^pm_to_blib +^.*.bak +^.*.old +^t.*sessions +^cover_db +^.*\.log +^.*\.swp$ diff --git a/www/Makefile.PL b/www/Makefile.PL new file mode 100644 index 0000000..d1cd3b4 --- /dev/null +++ b/www/Makefile.PL @@ -0,0 +1,21 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'DNSManager', + AUTHOR => q{YOUR NAME }, + VERSION_FROM => 'lib/DNSManager.pm', + ABSTRACT => 'YOUR APPLICATION ABSTRACT', + ($ExtUtils::MakeMaker::VERSION >= 6.3002 + ? ('LICENSE'=> 'perl') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'YAML' => 0, + 'Dancer' => 1.311, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'DNSManager-*' }, +); diff --git a/www/bin/app.pl b/www/bin/app.pl new file mode 100755 index 0000000..251b454 --- /dev/null +++ b/www/bin/app.pl @@ -0,0 +1,4 @@ +#!/usr/bin/env perl +use Dancer; +use DNSManager; +dance; diff --git a/www/conf/config.ini b/www/conf/config.ini new file mode 100644 index 0000000..f4d9df0 --- /dev/null +++ b/www/conf/config.ini @@ -0,0 +1,11 @@ +dbname = dnsmanager +host = localhost +# other options : see DBI module +sgbd = mysql +# default port for mysql +port = 3306 +user = bla +passwd = HardPass4bla +# possible options for dnsserver : bind rndc +dnsapp = rndc +zones_path = "/srv/named/" diff --git a/www/config.yml b/www/config.yml new file mode 100644 index 0000000..2d40d75 --- /dev/null +++ b/www/config.yml @@ -0,0 +1,30 @@ +# This is the main configuration file of your Dancer app +# env-related settings should go to environments/$env.yml +# all the settings in this file will be loaded at Dancer's startup. + +# Your application's name +appname: "DNSManager" + +# The default layout to use for your application (located in +# views/layouts/main.tt) +layout: "main" + +# when the charset is set to UTF-8 Dancer will handle for you +# all the magic of encoding and decoding. You should not care +# about unicode within your app when this setting is set (recommended). +charset: "UTF-8" + +# template engine +# simple: default and very basic template engine +# template_toolkit: TT + +# template: "simple" + +template: "template_toolkit" +engines: + template_toolkit: + encoding: 'utf8' + start_tag: '<%' + end_tag: '%>' + +session: "Storable" diff --git a/www/environments/development.yml b/www/environments/development.yml new file mode 100644 index 0000000..1107437 --- /dev/null +++ b/www/environments/development.yml @@ -0,0 +1,27 @@ +# configuration file for development environment + +# the logger engine to use +# console: log messages to STDOUT (your console where you started the +# application server) +# file: log message to a file in log/ +logger: "console" + +# the log level for this environment +# core is the lowest, it shows Dancer's core log messages as well as yours +# (debug, info, warning and error) +log: "core" + +# should Dancer consider warnings as critical errors? +warnings: 1 + +# should Dancer show a stacktrace when an error is caught? +show_errors: 1 + +# auto_reload is a development and experimental feature +# you should enable it by yourself if you want it +# Module::Refresh is needed +# +# Be aware it's unstable and may cause a memory leak. +# DO NOT EVER USE THIS FEATURE IN PRODUCTION +# OR TINY KITTENS SHALL DIE WITH LOTS OF SUFFERING +auto_reload: 0 diff --git a/www/environments/production.yml b/www/environments/production.yml new file mode 100644 index 0000000..86801b4 --- /dev/null +++ b/www/environments/production.yml @@ -0,0 +1,17 @@ +# configuration file for production environment + +# only log warning and error messsages +log: "warning" + +# log message to a file in logs/ +logger: "file" + +# don't consider warnings critical +warnings: 0 + +# hide errors +show_errors: 0 + +# cache route resolution for maximum performance +route_cache: 1 + diff --git a/www/lib/DNSManager.pm b/www/lib/DNSManager.pm new file mode 100644 index 0000000..93c6bd3 --- /dev/null +++ b/www/lib/DNSManager.pm @@ -0,0 +1,278 @@ +package DNSManager; + +use Dancer ':syntax'; +use strict; +use warnings; +use v5.14; +use Modern::Perl; +use Data::Dump qw( dump ); +use Data::Structure::Util qw ( unbless ); +use File::Basename; +use Config::Simple; +use Storable qw( freeze thaw ); +$Storable::Deparse = true; +$Storable::Eval=true; + +# Include other libs relative to current path +use Find::Lib '../../'; +use app::app; + +my $success; +our $cfg = new Config::Simple(dirname(__FILE__).'/../conf/config.ini'); + +our $VERSION = '0.1'; + +get '/' => sub { + if( session('login') ) + { + # my ($auth_ok, $user, $admin) = + # $usermanagement->auth( session('login'), session('password') ); + my $app = app->new( zdir => $cfg->param('zones_path'), + dbname => $cfg->param('dbname'), + dbhost => $cfg->param('host'), + dbport => $cfg->param('port'), + dbuser => $cfg->param('user'), + dbpass => $cfg->param('passwd'), + sgbd => $cfg->param('sgbd'), + dnsapp => $cfg->param('dnsapp') ); + $app->init(); + $app->get_domains( session('login') ); + template 'index' => + { 'logged' => true, + 'login' => session('login'), + 'admin' => session('admin'), + 'domains' => $app->get_domains(session('login')) + }; + } + else + { + template 'index'; + } +}; + +post '/login' => sub { + + # Check if user is already logged + unless ( session('login') ) + { + # Check user login and password + if ( param('login') && param('password') ) + { + my $app = app->new( zdir => $cfg->param('zones_path'), + dbname => $cfg->param('dbname'), + dbhost => $cfg->param('host'), + dbport => $cfg->param('port'), + dbuser => $cfg->param('user'), + dbpass => $cfg->param('passwd'), + sgbd => $cfg->param('sgbd'), + dnsapp => $cfg->param('dnsapp') ); + $app->init(); + my ($auth_ok, $user, $isadmin) = $app->auth(param('login'), + param('password') ); + if( $auth_ok ) + { + + session login => param('login'); + # TODO : change password storage… + session password => param('password'); + session user => freeze( $user ); + session admin => $isadmin; + + } + else + { + # User login and/or password are incorrect + } + } + } + redirect '/'; +}; + + +get '/mapage' => sub { + unless( session('login') ) + { + redirect '/'; + } + else + { + # my ($auth_ok, $user, $admin) = + # $usermanagement->auth( session('login'), session('password') ); + my $app = app->new( zdir => $cfg->param('zones_path'), + dbname => $cfg->param('dbname'), + dbhost => $cfg->param('host'), + dbport => $cfg->param('port'), + dbuser => $cfg->param('user'), + dbpass => $cfg->param('passwd'), + sgbd => $cfg->param('sgbd'), + dnsapp => $cfg->param('dnsapp') ); + $app->init(); + my %domains = (); + my %zone_properties = (); + + + my @d = @{$app->get_domains( session('login') )}; + + + # loop on domains + #foreach( @{ $app->get_domains( session('login') )} ) + #{ + # my @zones = (); + # # TODO + # foreach my $zone ( $app->get_domain($_)->output() ) + # { + # # avoid some var + # # keep only hash type + # if( ref($zone) eq 'HASH' ) + # { + # if( $zone->{'addr'} ) + # { + # unless( $zone->{'addr'} eq '@' ) + # { + # # normal zone, push it + # push( @zones, $zone ); + # } + # else + # { + # # domain properties + # $zone_properties{$_} = $zone; + # } + # } + # } + # } + # $domains{$_} = [ @zones ]; + #} + + #my @keys = keys(%domains); + #print "key : $_ value : $domains{$_}\n" foreach(@keys); +# foreach my $k ( keys %domains) { +# foreach my $v ( keys @{ $domains{$k} } ) { +# #print "dump : ".dump( $v )."\n"; +# if( UNIVERSAL::isa($domains{$k}[$v], "HASH" ) ) +# { +# print "hash...\n"; +# print "start ------\n"; +# print "$_ => $domains{$k}[$v]{$_}\n" foreach( keys $domains{$k}[$v] ); +# print "end ------\n\n"; +# } +# print "value : " . dump( $domains{$k}[$v] ) . "\n"; +# } +# } + #print 'manual dump : ' . dump( $domains{'karchnu.fr'} )."\n"; + #print 'prop dump : ' . dump( %zone_properties ) . "\n"; + template 'mapage' => + { 'login' => session('login'), + 'domains' => $app->get_domains(session('login')), + 'zones_domains' => \%domains, + 'zone_properties' => \%zone_properties, + 'admin' => session('admin') }; + } +}; + +get '/details' => sub { + # check if user is logged & if domain parameter is set + unless( session('login') && param('domain')) + { + redirect '/'; + } + else + { + + # my ($auth_ok, $user, $admin) = + # $usermanagement->auth( session('login'), session('password') ); + my $app = app->new( zdir => $cfg->param('zones_path'), + dbname => $cfg->param('dbname'), + dbhost => $cfg->param('host'), + dbport => $cfg->param('port'), + dbuser => $cfg->param('user'), + dbpass => $cfg->param('passwd'), + sgbd => $cfg->param('sgbd'), + dnsapp => $cfg->param('dnsapp') ); + $app->init(); + my ($auth_ok, $user, $isadmin) = $app->auth( param('login') ); + my @zones = (); + my $zone_properties; + #say 'dump : ' . dump $user->get_zone( param('domain') ); + + for( $user->get_zone( param('domain') ) ) { + + if( ref($_) eq 'HASH' and exists $_->{addr} ) { + push( @zones, $_ ) when $_->{addr} ne '@'; + $zone_properties = $_ when $_->{addr} eq '@'; + } + + } + template 'details' => + { 'login' => session('login'), + 'domain' => param('domain'), + 'zones' => \@zones, + 'zone_properties' => $zone_properties }; + } + +}; + + +any ['get', 'post'] => '/administration' => sub { + unless( session('login') ) + { + redirect '/'; + } + else + { + template 'administration' => + { 'login' => session('login'), + 'admin' => session('admin') }; + } +}; + +any ['post', 'get'] => '/logout' => sub { + session->destroy; + redirect '/'; +}; + +get '/domainadd' => sub { + # check if user is logged & if domain parameter is set + unless( session('login') ) + { + redirect '/'; + } + else + { + + my $app = app->new( zdir => $cfg->param('zones_path'), + dbname => $cfg->param('dbname'), + dbhost => $cfg->param('host'), + dbport => $cfg->param('port'), + dbuser => $cfg->param('user'), + dbpass => $cfg->param('passwd'), + sgbd => $cfg->param('sgbd'), + dnsapp => $cfg->param('dnsapp') ); + $app->init(); + + if( param('domain') ) + { + # create domain + $app->add_domain( session('login'), param('domain') ); + # Then, redirect to mapage + redirect '/mapage'; + } + + } + +}; + +get qr{/domaindel/(.*)} => sub { + my ($domainToDelete) = splat; + my $app = app->new( zdir => $cfg->param('zones_path'), + dbname => $cfg->param('dbname'), + dbhost => $cfg->param('host'), + dbport => $cfg->param('port'), + dbuser => $cfg->param('user'), + dbpass => $cfg->param('passwd'), + sgbd => $cfg->param('sgbd'), + dnsapp => $cfg->param('dnsapp') ); + $app->init(); + $app->delete_domain(session('login'), $domainToDelete); + redirect '/mapage'; +} + diff --git a/www/notes.txt b/www/notes.txt new file mode 100644 index 0000000..243ae62 --- /dev/null +++ b/www/notes.txt @@ -0,0 +1,20 @@ +Développement web : + +1. Créer la page d'accueil + - doit fournir un lien vers la page de login ; + - permet la recherche d'un nom de domaine ; + - s'il n'est pas disponible, proposer des choix alternatifs (secondaire) ; + +2. Page de login + - doit vérifier si l'utilisateur existe bien dans la base de donnée ; + - cf méthode dnsmanager::auth ; + - si l'utilisateur est un administrateur, fournir un lien supplémentaire vers la page d'administration ; + - cf lire le résultat renvoyé par auth (contient la liste des données de l'utilisateur stockés en bdd ; + - la page d'administration doit refuser un non administrateur ; + +3. Permettre à l'utilisateur de pouvoir visualiser ses zones, d'en demander de nouvelles ; + - cf get_zone function ; + - add_zone (doit envoyer une demande aux admins) ; + +4. Créer la page d'administration + - doit fournir la possibilité de valider la création d'un utilisateur ; diff --git a/www/public/404.html b/www/public/404.html new file mode 100644 index 0000000..fc3e1c4 --- /dev/null +++ b/www/public/404.html @@ -0,0 +1,18 @@ + + + +Error 404 + + + + +

Error 404

+
+

Page Not Found

Sorry, this is the void.

+
+ + + diff --git a/www/public/500.html b/www/public/500.html new file mode 100644 index 0000000..232dde9 --- /dev/null +++ b/www/public/500.html @@ -0,0 +1,18 @@ + + + +Error 500 + + + + +

Error 500

+
+

Internal Server Error

Wooops, something went wrong

+
+ + + diff --git a/www/public/css/error.css b/www/public/css/error.css new file mode 100644 index 0000000..003ee2a --- /dev/null +++ b/www/public/css/error.css @@ -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; +} + diff --git a/www/public/css/style.css b/www/public/css/style.css new file mode 100644 index 0000000..706c3e5 --- /dev/null +++ b/www/public/css/style.css @@ -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; +} diff --git a/www/public/dispatch.cgi b/www/public/dispatch.cgi new file mode 100755 index 0000000..3bb7f2a --- /dev/null +++ b/www/public/dispatch.cgi @@ -0,0 +1,15 @@ +#!/usr/bin/env perl +use Dancer ':syntax'; +use FindBin '$RealBin'; +use Plack::Runner; + +# For some reason Apache SetEnv directives dont propagate +# correctly to the dispatchers, so forcing PSGI and env here +# is safer. +set apphandler => 'PSGI'; +set environment => 'production'; + +my $psgi = path($RealBin, '..', 'bin', 'app.pl'); +die "Unable to read startup script: $psgi" unless -r $psgi; + +Plack::Runner->run($psgi); diff --git a/www/public/dispatch.fcgi b/www/public/dispatch.fcgi new file mode 100755 index 0000000..8c42e3a --- /dev/null +++ b/www/public/dispatch.fcgi @@ -0,0 +1,17 @@ +#!/usr/bin/env perl +use Dancer ':syntax'; +use FindBin '$RealBin'; +use Plack::Handler::FCGI; + +# For some reason Apache SetEnv directives dont propagate +# correctly to the dispatchers, so forcing PSGI and env here +# is safer. +set apphandler => 'PSGI'; +set environment => 'production'; + +my $psgi = path($RealBin, '..', 'bin', 'app.pl'); +my $app = do($psgi); +die "Unable to read startup script: $@" if $@; +my $server = Plack::Handler::FCGI->new(nproc => 5, detach => 1); + +$server->run($app); diff --git a/www/public/javascripts/jquery.js b/www/public/javascripts/jquery.js new file mode 120000 index 0000000..b77fd86 --- /dev/null +++ b/www/public/javascripts/jquery.js @@ -0,0 +1 @@ +/usr/share/javascript/jquery/jquery.js \ No newline at end of file diff --git a/www/t/001_base.t b/www/t/001_base.t new file mode 100644 index 0000000..99b3017 --- /dev/null +++ b/www/t/001_base.t @@ -0,0 +1,5 @@ +use Test::More tests => 1; +use strict; +use warnings; + +use_ok 'DNSManager'; diff --git a/www/t/002_index_route.t b/www/t/002_index_route.t new file mode 100644 index 0000000..e114cd3 --- /dev/null +++ b/www/t/002_index_route.t @@ -0,0 +1,10 @@ +use Test::More tests => 2; +use strict; +use warnings; + +# the order is important +use DNSManager; +use Dancer::Test; + +route_exists [GET => '/'], 'a route handler is defined for /'; +response_status_is ['GET' => '/'], 200, 'response status is 200 for /'; diff --git a/www/views/administration.tt b/www/views/administration.tt new file mode 100644 index 0000000..acfc35f --- /dev/null +++ b/www/views/administration.tt @@ -0,0 +1,8 @@ + + +
+

Bienvenue sur la page d'administration

+
+ diff --git a/www/views/details.tt b/www/views/details.tt new file mode 100644 index 0000000..a32ed3d --- /dev/null +++ b/www/views/details.tt @@ -0,0 +1,105 @@ + + +
+ <% IF domain && domain.size %> + + + + + + + + + <% FOREACH zone in zones %> + + + + + + + <% END %> +
Les zones de <%domain%>
HostAdressTypeDomain
+ <% IF zone.host %> + <% zone.host %> + <%END%> + + <% IF zone.addr %> + <% zone.addr %> + <% END %> + + <% IF zone.type %> + <% zone.type %> + <%END%> + + <% IF zone.domain %> + <% zone.domain %> + <%END%> +
+
+ + + + + + + + + + + + + + + + + + + + + +
Domain Properties
Admin de la zoneSerialPrimaryRetryDomainRefreshAddressExpire
+ <% IF zone_properties.admin %> + <%zone_properties.admin%>
+ <%END%> + 		+ <% IF zone_properties.serial %> + <%zone_properties.serial%> + <%END%> + + <% IF zone_properties.primary %> + <%zone_properties.primary%> + <%END%> + + <% IF zone_properties.retry %> + <%zone_properties.retry%> + <%END%> + + <% IF zone_properties.domain %> + <%zone_properties.domain%> + <%END%> + + <% IF zone_properties.refresh %> + <%zone_properties.refresh%> + <%END%> + + <% IF zone_properties.addr %> + <%zone_properties.addr%> + <%END%> + + <% IF zone_properties.expire %> + <%zone_properties.expire%> + <%END%> +
+ <% ELSE %> + Vous n'avez pas encore de noms de domaines… Voulez-vous en réserver un ? + <% END %> +
diff --git a/www/views/index.tt b/www/views/index.tt new file mode 100644 index 0000000..ee17c61 --- /dev/null +++ b/www/views/index.tt @@ -0,0 +1,44 @@ + +
+

Bienvenue sur netlib.re !

+

Netlib.re est un projet qui permettra à tout un chacun d'obtenir un sous-domaine de netlib.re, gratuitement et simplement.

+
+

Pourquoi ?

+ Nous pensons qu'Internet est et doit rester un lieu où l'utilisateur crée le contenu. Ce projet permettra donc d'apporter un peu notre pierre à l'édifice en aidant les gens n'ayant pas forcément de compétences en informatique de créer un nom de domaine.
+ Remarque : ce site ne fera pas d'hébergement, il founira uniquement un serveur de nom de domaine automatisé. +

Qui sommes-nous ?

+

Une bande d'informaticiens passionnés, voulant aider la communauté.

+

Ce qui sera proposé

+ À venir sur le site : +
    +
  • visualisation de la liste des domaines déjà réservés et utilisés ;
    • +
  • création d'un compte vous permettant de demander un nom de domaine en *.netlib.re (un administrateur devra le valider) ;
    • +
  • nous aimerions également proposer une mise à jour dynamique de votre adresse (dyndns).
    • +
+

En résumé : cherchez votre nom de domaine, réservez-le, on s'occupe du reste !

+
diff --git a/www/views/layouts/main.tt b/www/views/layouts/main.tt new file mode 100644 index 0000000..79873ec --- /dev/null +++ b/www/views/layouts/main.tt @@ -0,0 +1,20 @@ + + + + +DNSManager + + + + + + +<% content %> + + + diff --git a/www/views/mapage.tt b/www/views/mapage.tt new file mode 100644 index 0000000..9c760bd --- /dev/null +++ b/www/views/mapage.tt @@ -0,0 +1,37 @@ + + +
+ <% IF domains && domains.size %> +

Vos domaines :

+
+ + <% FOREACH domain in domains %> + + + + + <% END %> +
+ <%domain%> + + Supprimer +
+
+ <% ELSE %> + Vous n'avez pas encore de noms de domaines… Voulez-vous en réserver un ? + <% END %> +

Ajouter un nouveau domaine.

+
+ + +
+