#!/usr/bin/perl

=head1 NAME

pfdns - PacketFence DNS server

=head1 SYNOPSIS

pfdns [options]

 Options:
   -d      Daemonize
   -h      Help
   -v      Verbose

=cut

use warnings;
use strict;
use Readonly;
use File::Basename qw(basename);
use Getopt::Std;
use Pod::Usage;
use POSIX qw(:signal_h);
use Try::Tiny;
use Net::DNS::Nameserver;
use NetAddr::IP;
use Net::DNS::Resolver;

BEGIN {
    # log4perl init
    use constant INSTALL_DIR => '/usr/local/pf';
    use lib INSTALL_DIR . "/lib";
    use pf::log(service => 'pfdns');
}

use pf::config;
use pf::config::cached;
use pf::util;
use pf::services::util;
use pf::pfdns::constants;
use pf::CHI;
use pf::ConfigStore::Interface;
use pf::cluster;
use pf::SwitchFactory;

pf::SwitchFactory::preLoadModules();

# initialization
# --------------
# assign process name (see #1464)

# init signal handlers
our $PROGRAM_NAME = $0 = "pfdns";

my $logger = get_logger( $PROGRAM_NAME );

POSIX::sigaction(
    &POSIX::SIGHUP,
    POSIX::SigAction->new(
        'normal_sighandler', POSIX::SigSet->new(), &POSIX::SA_NODEFER
    )
) or $logger->logdie("pfdns: could not set SIGHUP handler: $!");

POSIX::sigaction(
    &POSIX::SIGTERM,
    POSIX::SigAction->new(
        'normal_sighandler', POSIX::SigSet->new(), &POSIX::SA_NODEFER
    )
) or $logger->logdie("pfdns: could not set SIGTERM handler: $!");

POSIX::sigaction(
    &POSIX::SIGINT,
    POSIX::SigAction->new(
        'normal_sighandler', POSIX::SigSet->new(), &POSIX::SA_NODEFER
    )
) or $logger->logdie("pfdns: could not set SIGINT handler: $!");


my %args;
getopts( 'dhi:', \%args );

my $daemonize = $args{d};

pod2usage( -verbose => 1 ) if ( $args{h} );

our $RUNNING = 1;


# standard signals and daemonize
daemonize($PROGRAM_NAME) if ($daemonize);

my @ip_addr;
my $loadb_ip;
my @routed_inline_nets_named;
my @routed_isolation_nets_named;
my @routed_registration_nets_named;

my $CHI_CACHE = pf::CHI->new( namespace => 'pfdns' );
our $IPSET_SESSION = 'pfsession_passthrough';
our %IPSET_CACHE;

Readonly::Scalar our $TTL                => '15';
Readonly::Scalar our $HTTPS_PORT         => '443';
Readonly::Scalar our $HTTP_PORT         => '80';

my $cs = pf::ConfigStore::Interface->new;
foreach my $interface ( @{$cs->readAllIds} ) {
    my $full_interface = "interface $interface";
    my $ip = $Config{$full_interface}{'vip'} || $Config{$full_interface}{'ip'};
    if (
        defined ($Config{$full_interface}{'enforcement'}) &&
        (
          ($Config{$full_interface}{'enforcement'} eq $IF_ENFORCEMENT_VLAN)
          || is_type_inline($Config{$full_interface}{'enforcement'})
        )
    ){
        # if cluster is enabled we return the VIP when queried on the server interface
        # we also listen on the VIP in case it's needed
        if ($cluster_enabled){
            $loadb_ip->{$ip} = pf::cluster::cluster_ip($interface);
            push @ip_addr, pf::cluster::cluster_ip($interface);
        }
        push @ip_addr, $ip;
    }
}

foreach my $network ( keys %ConfigNetworks ) {
    if ( $ConfigNetworks{$network}{'named'} eq 'enabled' ) {
        if ( pf::config::is_network_type_inline($network) ) {
            my $inline_obj = NetAddr::IP->new( $network, $ConfigNetworks{$network}{'netmask'} );
            push @routed_inline_nets_named, $inline_obj;
        } elsif ( pf::config::is_network_type_vlan_isol($network) ) {
            my $isolation_obj = NetAddr::IP->new( $network, $ConfigNetworks{$network}{'netmask'} );
            push @routed_isolation_nets_named, $isolation_obj;

        } elsif ( pf::config::is_network_type_vlan_reg($network) ) {
            my $registration_obj = NetAddr::IP->new( $network, $ConfigNetworks{$network}{'netmask'} );
            push @routed_registration_nets_named, $registration_obj;
        }
    }
}

tie our %domain_dns_servers, 'pfconfig::cached_hash', 'resource::domain_dns_servers';

our $PARENT_PID = $$;
my %CHILDREN;
my $IS_CHILD = 0;
my $CHILDREN_TO_START = $Config{advanced}{pfdns_processes};

sub start_children {
    my $i = 1;
    while($i <= $CHILDREN_TO_START){
        run_child($i);
        $i++;
    }
}

sub run_child {
    my ($id) = @_;
    my $pid = fork();
    if($pid) {
        $CHILDREN{$pid} = $id;
        $SIG{CHLD} = "IGNORE";
    } elsif ($pid == 0) {
        $SIG{CHLD} = "DEFAULT";
        $IS_CHILD = 1;
        _run_child($id);
    } 
}

populate_ipset_cache($IPSET_SESSION);

my $ns = new Net::DNS::Nameserver(
    LocalAddr       => [@ip_addr],
    LocalPort    => 53,
    ReplyHandler => \&response_handler,
    Verbose      => 0
    ) || die "couldn't create nameserver object\n";


sub _run_child {
    my ($id) = @_;
    $0 = "$0 - $id";
    while($RUNNING) {
        $ns->loop_once(10);
    }
}

END {
    deletepid("pfdns") unless $args{h};
}

sub response_handler {
    my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    pf::config::cached::ReloadConfigs();
    $logger->trace(sub { "Process $0 handling request" });
    my $ip = new NetAddr::IP::Lite clean_ip($peerhost);
    foreach my $network (@routed_registration_nets_named) {
        if ($network->contains($ip)) {
           return  regzone($qname, $qclass, $qtype, $peerhost,$query,$conn);
        }
    }
    foreach my $network (@routed_isolation_nets_named) {
        if ($network->contains($ip)) {
           # Should be different for isolation network.
           return  isolzone($qname, $qclass, $qtype, $peerhost,$query,$conn);
        }
    }

    foreach my $network (@routed_inline_nets_named) {
        if ($network->contains($ip)) {
           # Should be different for inline
           return  regzone($qname, $qclass, $qtype, $peerhost,$query,$conn);
        }
    }
}

sub regzone {
    my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    my ($rcode, @ans, @auth, @add);

    $logger->trace("Requested Domain: ".$qname);
    if ($qtype eq "A") {
        if ( ($qname =~ /$OAUTH::ALLOWED_SOURCES_DOMAINS/o && $OAUTH::ALLOWED_SOURCES_DOMAINS ne '') || ($qname =~ /$PASSTHROUGH::ALLOWED_PASSTHROUGH_DOMAINS/o && $PASSTHROUGH::ALLOWED_PASSTHROUGH_DOMAINS ne '') ) {
            my ($ttl, $rdata);
            my $res   = Net::DNS::Resolver->new;
            my $query = $CHI_CACHE->compute($qname, sub { $res->search($qname) });
            if ($query) {
                add_answers_to_ipset($query,$IPSET_SESSION,$HTTP_PORT,$HTTPS_PORT);
                foreach my $rr ($query->answer) {
                    next unless $rr->type eq "A";
                    $rdata= $rr->address;
                    push @ans, new Net::DNS::RR("$qname $TTL $qclass $qtype $rdata");
                }
                if(@ans) {
                    $rcode = "NOERROR";
                } else {
                    $logger->warn("Unresolved passthrough domain $qname");
                    $rcode = "NXDOMAIN";
                }
            }

        }
        elsif ($qname eq $Config{'general'}{'hostname'}.".".$Config{'general'}{'domain'}) {
            my ($ttl, $rdata) = ($TTL, $conn->{sockhost});
            my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata");
            push @ans, $rr;
            $rcode = "NOERROR";
        } else {
            #Check if the answer already exist
            my ($ttl, $rdata);
            my $query = $CHI_CACHE->get($qname);
            if ($query) {
                foreach my $rr ($query->answer) {
                    next unless $rr->type eq "A";
                    $rdata= $rr->address;
                    push @ans, new Net::DNS::RR("$qname $TTL $qclass $qtype $rdata");
                }
                if(@ans) {
                    $rcode = "NOERROR";
                } else {
                    $rcode = "NXDOMAIN";
                }
            } else {
                my ($ttl, $rdata) = ($TTL, $Config{'general'}{'hostname'}.".".$Config{'general'}{'domain'}.".");
                my $rr = new Net::DNS::RR("$qname $ttl IN CNAME $rdata");
                my $rdata2 = (defined($loadb_ip->{$conn->{sockhost}})) ? $loadb_ip->{$conn->{sockhost}} : $conn->{sockhost};
                my $rr2 = new Net::DNS::RR("$rdata $ttl $qclass $qtype $rdata2");
                push @ans, $rr;
                push @ans, $rr2;
                $rcode = "NOERROR";
            }
        }
    } elsif ($qtype eq "NS") {
        my $rr = new Net::DNS::RR(
            name    => $Config{'general'}{'domain'},
            type    => 'NS',
            nsdname => $Config{'general'}{'hostname'}.".".$Config{'general'}{'domain'},
        );
        push @ans, $rr;
        $rcode = "NOERROR";
    } elsif ($qtype eq "SRV") {
        #Handle SRV record to be able to contact Active Directory in the reg vlan
        $rcode = "NXDOMAIN";
        foreach my $key ( keys %domain_dns_servers ) {
            if ($qname =~ /(.*)_msdcs.$key/i) {
                my $resolver = new Net::DNS::Resolver(nameservers => [$domain_dns_servers{$key}]);
                my $reply = $resolver->search($qname, $qtype);
                foreach my $answer ($reply->answer) {
                    my $query = $CHI_CACHE->compute($answer->target, sub { $resolver->search($answer->target, 'A') });
                    if ($query) {
                        get_logger->info("Resolved $qname as an Active Directory domain name. Adding passthroughs into ipset.");
                        add_answers_to_ipset($query,$IPSET_SESSION,$answer->port, 'udp:88', 'udp:123', 'udp:135', '135', 'udp:137', 'udp:138', '139', 'udp:389', 'udp:445', '445', 'udp:464', '464', 'tcp:1025', '49155', '49156', '49172');
                    }
                }
                $rcode = "NOERROR";
                push @ans, $reply->answer;
            }
        }
    } else{
        $rcode = "NXDOMAIN";
    }

    # mark the answer as authoritive (by setting the 'aa' flag
    return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

=head2 add_answers_to_ipset

=cut

sub add_answers_to_ipset {
    my ($query,$setname,@ports) = @_;
    my @ops;
    foreach my $rr ($query->answer) {
        next unless $rr->type eq "A";
        my $ip = $rr->address;
        foreach my $port (@ports) {
            push @ops, "add $setname $ip,$port" unless is_in_ipset_cache($setname,$ip,$port);
        }
    }
    if(@ops) {
        my $ipset;
        my $data = join("\n", @ops, "");
        open($ipset,"| LANG=C sudo ipset restore 2>&1");
        print $ipset $data;
        close($ipset);
    }
}

=head2 add_ip_port_to_ipset

add ipset rule to the cache if it is not already there

=cut

sub add_ip_port_to_ipset {
    my ($setname,$ip,$port) = @_;
    unless (is_in_ipset_cache($setname,$ip,$port)) {
        my $cmd = "LANG=C sudo ipset --add $setname $ip,$port 2>&1";
        my $_EXIT_CODE_EXISTS = "1";
        my @lines = pf_run($cmd, accepted_exit_status => [$_EXIT_CODE_EXISTS]);
    }
}


sub isolzone {
    my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    my ($rcode, @ans, @auth, @add);
    my $_EXIT_CODE_EXISTS = "1";

    $logger->trace("Requested Domain: ".$qname);
    if ($qtype eq "A") {
        my $ttl = $TTL;
        my $rdata = (defined($loadb_ip->{$conn->{sockhost}})) ? $loadb_ip->{$conn->{sockhost}} : $conn->{sockhost};
        my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata");
        push @ans, $rr;
        $rcode = "NOERROR";
    } elsif ($qtype eq "NS") {
        my $rr = new Net::DNS::RR(
            name    => $Config{'general'}{'domain'},
            type    => 'NS',
            nsdname => $Config{'general'}{'hostname'}.".".$Config{'general'}{'domain'},
        );
        push @ans, $rr;
        $rcode = "NOERROR";
    } else{
        $rcode = "NXDOMAIN";
    }

    # mark the answer as authoritive (by setting the 'aa' flag
    return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

sub normal_sighandler {
    foreach my $pid (keys %CHILDREN){
        kill(SIGKILL, $pid);
    }
    deletepid();
    $RUNNING = 0;
    $logger->debug( "pfdns: caught SIG" . $_[0] . " - terminating" );
}

sub populate_ipset_cache {
    my ($session) = @_;
    my $in_header = 1;
    my @lines =
      pf_run("/usr/sbin/ipset list $session 2>/dev/null",
        accepted_exit_status => [1]);

    while (my $line = shift @lines) {
        last if $line =~ /Members:/;
    }

    while (my $line = shift @lines) {
        if ($line =~ /(\d+(?:\.\d+){3}),tcp:(\d+)/) {
            add_to_ipset_cache($session,$1,$2);
        }
    }
}

sub add_to_ipset_cache {
    my ($session,$ip,$port) = @_;
    $IPSET_CACHE{join(':',$session,$ip,$port)} = undef;
}

sub is_in_ipset_cache {
    my ($session,$ip,$port) = @_;
    return exists $IPSET_CACHE{join(':',$session,$ip,$port)};
}

sub is_parent_alive {
    kill (0,$PARENT_PID)
}

start_children();
while($RUNNING){
    sleep 1;
    foreach my $pid (keys %CHILDREN){
        unless(kill(0,$pid)){
            $logger->error("Child $pid ($CHILDREN{$pid}) is dead. Respawning it.");
            run_child($CHILDREN{$pid});
            delete $CHILDREN{$pid};
        }
    }
}

=head1 COPYRIGHT

Copyright (C) 2005-2016 Inverse inc.

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.

=cut
