view release on metacpan or  search on metacpan

lib/App/ReslirpTunnel.pm  view on Meta::CPAN

        my $domain = $record->{domain};
        my $iface = $record->{iface};
        my $method = "_resolve_remote_iface_dns__". (($self->{remote_os} eq 'windows') ? 'windows' : 'unix');
        if (my @addrs = $self->$method($iface)) {
            $self->_log(debug => "DNS servers for remote iface $iface", join(", ", @addrs));
            for my $addr (@addrs) {
                push @{$self->{forward_dns}{$domain} //= []}, $addr;
                $self->{forward_ipv4}{"$addr/32"} = 1;
            }
        }
        else {
            $self->_warn("Failed to retrieve DNS servers using remote shell, ignoring domain", $record->{domain});
        }
    }
}

sub _resolve_remote_iface_dns__unix {
    my $self = shift;
    $self->_warn('Retrieving by iface DNS servers using the shell on remote Unix hosts is not implemented yet');
    ()
}

sub _resolve_remote_iface_dns__windows {
    my ($self, $iface) = @_;
    my $ssh = $self->{ssh};

    my $out = $ssh->capture({remote_shell=> 'MSWin'}, 'powershell', '-Command', "Get-DnsClientServerAddress | ConvertTo-Json");
    my @addrs;
    eval {
        for my $record (@{JSON::PP::decode_json($out)}) {
            if ($record->{InterfaceAlias} eq $iface and
                $record->{AddressFamily} eq '2') {
                push @addrs, @{$record->{ServerAddresses}};
            }
        }
    };
    unless (@addrs) {
        $self->_warn("Failed to parse JSON output from DnsClientServerAddress", $@);
        $self->_log(debug => "Output was", $out);
    }
    return @addrs;
}


sub _config_net_mappings {
    my $self = shift;
    $self->{net_mapping} //= {};
    $self->{forward_ipv4} //= {};
    $self->_config_net_mappings_net;
    $self->_config_net_mappings_direct;
    $self->_config_net_mappings_local;
    $self->_config_net_mappings_dns;
    $self->_config_net_mappings_ssh;
}

sub _config_net_mappings_net {
    my $self = shift;
    for my $record (@{$self->{args}{route_nets}}) {
        my $addr = $record->{addr};
        my $mask = $record->{mask};
        if ($self->_validate_ipv4($addr) and $self->_validate_netmask($mask)) {
            $self->{forward_ipv4}{"$addr/$mask"} = 1;
        }
        else {
            $self->_warn("Ignoring invalid network", "$addr/$mask");
        }
    }
}

sub _config_net_mappings_direct {
    my $self = shift;
    for my $record (@{$self->{args}{route_hosts}}) {
        my $addrs = $record->{addrs} // [];
        $self->{forward_ipv4}{"$_/32"} = 1 for @$addrs;
        if (defined (my $host = $record->{host})) {
            if ($self->_validate_domain_name($host)) {
                push @{$self->{net_mapping}{$host} //= []}, @$addrs;
            }
            else {
                $self->_warn("Ignoring host with invalid name", $host);
            }
        }
    }
}

sub _config_net_mappings_local {
    my $self = shift;
    for my $host (@{$self->{args}{route_hosts_local}}) {
        my $addr;
        if (is_ipv4($host)) {
            $self->{forward_ipv4}{"$host/32"} = 1;
        }
        elsif ($self->_validate_domain_name($host)) {
            my $good;
            my ($err, @records) = Socket::getaddrinfo($host);
            unless ($err) {
                for my $record (@records) {
                    if ($record->{family} == AF_INET) {
                        my (undef, $packed_ip) = sockaddr_in($record->{addr});
                        my $addr = inet_ntoa($packed_ip);
                        push @{$self->{net_mapping}{$host} //= []}, $addr;
                        $self->{forward_ipv4}{"$addr/32"} = 1;
                        $good = 1;
                    }
                }
            }
            $good or $self->_warn("Failed to resolve host, ignoring it", $host);
        }
        else {
            $self->_warn("Ignoring host with invalid name", $host);
        }
    }
}

sub _validate_ipv4 {
    my ($self, $ipv4) = @_;
    is_ipv4($ipv4) and return 1;
    $self->_log(debug => "Bad IPv4", $ipv4);
    return undef;
}

sub _validate_netmask {
    my ($self, $mask) = @_;
    $mask =~ /\d+/ and $mask >= 1 and $mask <= 32 and return 1;
    $self->_log(debug => "Bad netmask", $mask);
    return undef;
}

sub _validate_domain_name {
    my ($self, $domain) = @_;
    is_hostname($domain, {'domain_private_tld' => 1}) and return 1;
    $self->_log(debug => "Bad domain", $domain);
    return undef;
}

sub _config_net_mappings_dns {
    my $self = shift;
    my $route_hosts = $self->{args}{route_hosts_dns};
    if (@$route_hosts) {
        my $dns = Net::DNS::Resolver->new(nameservers => [$self->{remote_dns}], recurse => 1);
        for my $host (@$route_hosts) {
            if ($self->_validate_domain_name($host)) {
                my $good;
                $self->_log(debug => "Resolving $host using remote DNS");
                my $query = $dns->query($host, 'A');
                if ($query) {
                    for my $rr ($query->answer) {
                        if ($rr->type eq 'A') {
                            my $addr = $rr->address;
                            push @{$self->{net_mapping}{$host} //= []}, $addr;
                            $self->{forward_ipv4}{"$addr/32"} = 1;
                            $good = 1;
                        }
                    }
                }
                $good or $self->_warn("Failed to resolve host using remote DNS, ignoring it", $host);
            }
            else {
                $self->_warn("Ignoring host with invalid name", $host);
            }
        }
    }
}

sub _config_net_mappings_ssh {
    my $self = shift;
    my $route_hosts = $self->{args}{route_hosts_ssh};
    for my $host (@$route_hosts) {
        if ($self->_validate_domain_name($host)) {
            $self->_log(debug => "Resolving $host using remote shell");
            my $method = "_resolve_remote_host_with_shell__" . (($self->{remote_os} eq 'windows') ? 'windows' : 'unix');
            my @addrs = $self->$method($host);
            for my $addr (@addrs) {
                push @{$self->{net_mapping}{$host} //= []}, $addr;
                $self->{forward_ipv4}{"$addr/32"} = 1;
            }
            @addrs or $self->_warn("Failed to resolve host using remote DNS, ignoring it", $host);
        }
        else {
            $self->_warn("Ignoring host with invalid name", $host);
        }
    }
}

sub _resolve_remote_host_with_shell__unix {
    my $self = shift;
    $self->_warn('Resolving using the shell on remote Unix hosts is not implemented yet');
    ()
}

sub _resolve_remote_host_with_shell__windows {
    my ($self, $host) = @_;
    my $ssh = $self->{ssh};

    my $out = $ssh->capture({remote_shell=> 'MSWin'}, 'powershell', '-Command', "Resolve-DnsName $host | ConvertTo-Json");
    my @addrs;
    eval {
        my $records = JSON::PP::decode_json($out);
        my @names = $host;
        for my $r (@$records) {
            push @names, $r->{NameHost} if $r->{Type} == 5;
        }
        for my $r (@$records) {
            push @addrs, $r->{IP4Address} if $r->{Type} == 1
        }
        return @addrs
    };
    unless (@addrs) {
        $self->_warn("Failed to parse JSON output from Resolve-DnsName", $@);
        $self->_log(debug => "Output was", $out);
    }
    return @addrs;
}

sub _init_dnsmasq {
    my $self = shift;
    my $net_mapping = $self->{net_mapping};
    my $forward_dns = $self->{forward_dns};

    if (%$net_mapping or %$forward_dns) {
        $self->_log(info => "Starting dnsmasq");

        my $pid_parent_dir = $self->{xdg}->state_home->child('dnsmasq')->mkdir;
        my $pid_fn = $pid_parent_dir->child($self->{timestamp}.".dnsmasq.pid");
        my $latest_fn = $pid_parent_dir->child("latest.dnsmasq.pid");
        unlink $latest_fn if -e $latest_fn;
        symlink $pid_fn, $latest_fn;
        my $log_fn = $self->{xdg}->state_home->child('logs')->mkdir->child($self->{timestamp}.".dnsmasq.log");
        my $butler = $self->{butler};