Obsolete
/
dnsmanagerv1
Archived
3
0
Fork 0
This repository has been archived on 2024-06-18. You can view files and clone it, but cannot push or open issues/pull-requests.
dnsmanagerv1/lib/rt/domain.pm

761 lines
21 KiB
Perl

package rt::domain;
use v5.14;
use configuration ':all';
use encryption ':all';
use util ':all';
use app;
use utf8;
use open qw/:std :utf8/;
use Dancer ':syntax';
use Data::Dump qw( dump );
use Data::Validate::IP qw(is_ipv4 is_ipv6);
use MIME::Base64 qw(encode_base64 decode_base64);
use Exporter 'import';
# what we want to export eventually
our @EXPORT_OK = qw/
rt_dom_cli_mod_entry
rt_dom_cli_autoupdate
rt_dom_mod_entry
rt_dom_del_entry
rt_dom_del
rt_dom_add
rt_dom_details
rt_dom_add_entry
rt_dom_updateraw
/;
# bundle of exports (tags)
our %EXPORT_TAGS = ( all => [qw/
rt_dom_cli_mod_entry
rt_dom_cli_autoupdate
rt_dom_mod_entry
rt_dom_del_entry
rt_dom_del
rt_dom_add
rt_dom_details
rt_dom_add_entry
rt_dom_updateraw
/] );
sub rt_dom_cli_autoupdate {
my ($session, $param, $request) = @_;
my $res;
my @missingitems;
my @items = qw/login pass domain name type rdata/;
for(@items) {
push @missingitems, $_ unless($$param{$_});
}
if(@missingitems != 0) {
say "Il manque : " . join ', ', @missingitems;
return $res;
}
for(@items) {
say "::::::::: $_ : $$param{$_}" if $$param{$_};
}
if(! is_ipv4($$param{rdata}) && ! is_ipv6($$param{rdata})) {
say "Attention, ceci n'est pas une adresse IP : $$param{rdata}.";
return $res;
}
eval {
my $pass = encrypt($$param{pass});
my $app = app->new(get_cfg());
my $user;
eval {
$user = $app->auth($$param{login}, $pass);
};
# if the mdp is in base64
# useful for cli and http GET messages
if( $@ ) {
my $passb64 = decode_base64($$param{pass});
$pass = encrypt($passb64);
$user = $app->auth($$param{login}, $pass);
}
unless ( $user && ( $$user{admin} ||
$app->is_owning_domain($$user{login}, $$param{domain}))) {
$app->disconnect();
say q{Donnée privée, petit coquin. ;) };
return $res;
}
my $zone = $app->get_zone( $$param{domain} );
my $zf = $zone->get_zonefile();
my $name = $$param{name};
$name =~ s/@/$$param{domain}./;
if($name =~ /$$param{domain}$/) {
$name .= '.';
}
if($name !~ /\.$/) {
$name .= ".$$param{domain}."
}
my $rr_list = $zf->rr_search($name, $$param{type});
my $rr;
if(@$rr_list) {
$rr = pop @$rr_list;
}
else {
say "Pas d'entrée au nom $name de type $$param{type} trouvée.";
return $res;
}
my $str_old = "$$rr{name} $$rr{ttl} $$rr{type} $$rr{rdata}";
my $str_new = "$$rr{name} $$rr{ttl} $$rr{type} $$param{rdata}";
say "old : $str_old";
say "new : $str_new";
if($$rr{rdata} eq $$param{rdata}) {
say "SAME";
}
else {
$zf->rr_mod($str_old, $str_new);
$zone->update( $zf );
}
$app->disconnect();
};
if ($@) {
say "Problème : $@";
}
$res
}
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;
}
my $zone = $app->get_zone( $$param{domain} );
my $zf = $zone->get_zonefile();
$zf->rr_mod(
"$$param{name} $$param{ttl} $$param{type} $$param{rdata}"
, "$$param{name} $$param{ttl} $$param{type} $$param{ip}"
);
$zone->update( $zf );
$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;
my @items = qw/domain type
oldname oldrdata oldttl
newname newrdata newttl/;
if($$param{type} && $$param{type} eq 'MX') {
push @items, qw/oldpriority newpriority/;
}
if($$param{type} && $$param{type} eq 'SRV') {
push @items, qw/
oldpriority oldweight oldport
newpriority newweight newport/;
}
for(@items) {
push @missingitems, $_ unless($$param{$_});
}
if(@missingitems != 0) {
$$res{deferred}{errmsg} = "Il manque : " . join ', ', @missingitems;
return $res;
}
for(@items) {
say "::::::::: $_ : $$param{$_}" if $$param{$_};
}
eval {
unless( $$param{domain} ) {
$$res{deferred}{errmsg} = q<Domaine non renseigné.>;
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
my $oldname = $$param{oldname};
my $newname = $$param{newname};
my $oldrdata = $$param{oldrdata};
my $newrdata = $$param{newrdata};
$oldname =~ s/@/$$param{domain}./g;
$newname =~ s/@/$$param{domain}./g;
if ($$param{type} eq 'A' && ! is_ipv4($newrdata)) {
$$res{deferred}{errmsg} =
"Il faut une adresse IPv4 pour un enregistrement de type A."
. " Ceci n'est pas une adresse IPv4 : $newrdata";
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
if ($$param{type} eq 'AAAA' && ! is_ipv6($newrdata)) {
$$res{deferred}{errmsg} =
"Il faut une adresse IPv6 pour un enregistrement de type AAAA."
. " Ceci n'est pas une adresse IPv6 : $newrdata";
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
# si le type est A, AAAA, SRV, TXT, CNAME, MX, NS
# le name doit être un domaine
# si ce domaine n'est pas absolu, rajouter ".domain."
if($$param{type} =~ /^(A|AAAA|SRV|TXT|CNAME|MX|NS)$/) {
$newname .= ".$$param{domain}." if($newname !~ /\.$/);
$oldname .= ".$$param{domain}." if($oldname !~ /\.$/);
}
# si le type est CNAME, MX, NS ou PTR
# le rdata doit être un domaine
# si ce domaine n'est pas absolu, rajouter ".domain."
if($$param{type} =~ /^(CNAME|MX|NS|PTR)$/) {
$oldrdata =~ s/@/$$param{domain}./;
$newrdata =~ s/@/$$param{domain}./;
$oldrdata .= ".$$param{domain}." if($oldrdata !~ /\.$/);
$newrdata .= ".$$param{domain}." if($newrdata !~ /\.$/);
}
if ($$param{type} =~ /^(CNAME|MX|NS|PTR|SRV)$/i
&& ! is_domain_name ($newrdata))
{
$$res{deferred}{errmsg} =
"Une entrée $$param{type} doit avoir un nom de domaine "
. "(pas une URL, pas de http://) : '$newrdata' n'est pas correct.";
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
my $str_old = "$oldname $$param{oldttl} $$param{type} ";
my $str_new = "$newname $$param{newttl} $$param{type} ";
if($$param{type} eq "MX") {
$str_old .= "$$param{oldpriority} $oldrdata";
$str_new .= "$$param{newpriority} $newrdata";
}
elsif ($$param{type} eq "SRV") {
$str_old .= "$$param{oldpriority} $$param{oldweight} "
."$$param{oldport} $oldrdata";
$str_new .= "$$param{newpriority} $$param{newweight} "
."$$param{newport} $newrdata";
}
else {
$str_old .= "$oldrdata";
$str_new .= "$newrdata";
}
say "::: ___ str_old : $str_old";
say "::: ___ str_new : $str_new";
# Do the modification of the entry
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;
}
my $zone = $app->get_zone( $$param{domain} );
my $zf = $zone->get_zonefile();
$zf->rr_mod( $str_old, $str_new);
$zone->update( $zf );
$app->disconnect();
};
if($@) {
$$res{deferred}{errmsg} = q{Modification impossible. } . $@;
return $res;
}
$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;
}
my @missingitems;
my @items = qw/domain name ttl type rdata/;
if ($$param{type} && $$param{type} eq 'SRV') {
push @items, qw/priority weight port/;
}
elsif ($$param{type} && $$param{type} eq 'MX') {
push @items, qw/priority/;
}
for(@items) {
push @missingitems, $_ unless($$param{$_});
}
for(@items) {
say "::::::::: $_ : $$param{$_}" if $$param{$_};
}
if(@missingitems != 0) {
$$res{deferred}{errmsg} = "Il manque : " . join ', ', @missingitems;
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
my $rdata = $$param{rdata};
my $name = $$param{name};
$name =~ s/@/$$param{domain}./;
# si le type est A, AAAA, SRV, TXT, CNAME, MX, NS
# le name doit être un domaine
# si ce domaine n'est pas absolu, rajouter ".domain."
if($$param{type} =~ /^(A|AAAA|SRV|TXT|CNAME|MX|NS)$/ && $name !~ /\.$/){
$name .= ".$$param{domain}.";
}
# si le type est CNAME, MX, NS ou PTR
# le rdata doit être un domaine
# si ce domaine n'est pas absolu, rajouter ".domain."
if($$param{type} =~ /^(CNAME|SRV|MX|NS|PTR)$/) {
$rdata =~ s/@/$$param{domain}./;
$rdata .= ".$$param{domain}." if $rdata !~ /\.$/;
}
my $zone = $app->get_zone( $$param{domain} );
my $zf = $zone->get_zonefile();
my $str_del = "$name $$param{ttl} $$param{type} ";
if( $$param{type} eq 'SRV') {
$str_del .=
"$$param{priority} $$param{weight} $$param{port} $rdata";
}
elsif ($$param{type} eq 'MX') {
$str_del .= "$$param{priority} $rdata";
}
else {
$str_del .= "$rdata";
}
$zf->rr_del_raw( $str_del );
$zone->update( $zf );
$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_zone( $$param{domain} );
my $zf = $zone->get_zonefile();
$app->disconnect();
$$res{template} = 'details';
$$res{params} = {
login => $$session{login}
, admin => $$user{admin}
, domain => $$param{domain}
, domain_zone => $zf->dump()
, user_ip => $$request{address}
};
if($$param{expert}) {
$$res{params}{expert} = 1;
}
else {
$$res{params}{zone} = $zf->rr_array_to_array_stripped();
}
};
if($@) {
$app->disconnect() if $app;
$$res{deferred}{errmsg} = q{Une erreur est survenue. } . $@;
$$res{route} = '/';
return $res;
}
$res
}
sub rt_dom_add_entry {
my ($session, $param, $request) = @_;
my $res;
unless( $$session{login} && $$param{domain} ) {
$$res{route} = '/';
return $res;
}
$$res{route} = '/domain/details/'. $$param{domain};
my @missingitems;
my @items = qw/domain type name ttl rdata/;
if($$param{type} && $$param{type} eq 'MX') {
push @items, qw/priority/;
}
if($$param{type} && $$param{type} eq 'SRV') {
push @items, qw/priority weight port/;
}
for(@items) {
push @missingitems, $_ unless($$param{$_});
}
if(@missingitems != 0) {
$$res{deferred}{errmsg} = "Il manque : " . join ', ', @missingitems;
return $res;
}
eval {
# Perform tests on the different entries
my $name = $$param{name};
$name =~ s/@/$$param{domain}./;
if($name =~ /$$param{domain}$/) {
$name .= '.';
}
if($name !~ /\.$/) {
$name .= ".$$param{domain}."
}
my $str_new = "$name $$param{ttl} $$param{type} ";
my $rdata = $$param{rdata};
if($$param{type} =~ /^(CNAME|MX|NS|PTR|SRV)$/) {
$rdata =~ s/@/$$param{domain}./;
$rdata .= ".$$param{domain}." if( $rdata !~ /\.$/);
}
if ($$param{type} =~ /^(CNAME|MX|NS|PTR|SRV)$/i
&& ! is_domain_name ($rdata))
{
$$res{deferred}{errmsg} =
"Une entrée $$param{type} doit avoir un nom de domaine "
. "(pas une URL, pas de http://) : '$rdata' n'est pas correct.";
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
if ($$param{type} eq 'A' && ! is_ipv4($rdata)) {
$$res{deferred}{errmsg} =
"Il faut une adresse IPv4 pour un enregistrement de type A."
. " Ceci n'est pas une adresse IPv4 : $rdata";
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
if ($$param{type} eq 'AAAA' && ! is_ipv6($rdata)) {
$$res{deferred}{errmsg} =
"Il faut une adresse IPv6 pour un enregistrement de type AAAA."
. " Ceci n'est pas une adresse IPv6 : $rdata";
$$res{route} = ($$request{referer}) ? $$request{referer} : '/';
return $res;
}
if($$param{type} eq "MX") {
$str_new .= "$$param{priority} $rdata";
}
elsif ($$param{type} eq "SRV") {
$str_new .=
"$$param{priority} $$param{weight} $$param{port} $rdata";
}
else {
$str_new .= "$rdata";
}
# Add the entry
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_zone( $$param{domain} );
my $zf = $zone->get_zonefile();
$zf->rr_add_raw($str_new);
$zf->new_serial();
$zone->update( $zf );
$app->disconnect();
};
if ( $@ ) {
$$res{deferred}{errmsg} = q{Problème à l'ajout d'une entrée. }. $@;
}
$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 $zone = $app->get_zone( $$param{domain} );
my $zf = $zone->update_raw( $$param{zoneupdated} );
$zone->update( $zf );
$$res{route} = '/domain/details/' . $$param{domain};
}
$app->disconnect();
};
if($@) {
$$res{deferred}{errmsg} = $@;
$$res{route} = '/user/home';
}
$res
}
1;