Commit bbefcac8 authored by Gavin Brown's avatar Gavin Brown
Browse files

Initial commit

parents
# DNS-over-HTTPS (DoH) tools for Perl
See:
* https://tools.ietf.org/html/draft-ietf-doh-dns-over-https
This repository contains:
## `dohc.pl` (DoH client)
This script implements a simple dig-like DoH client using `Net::DNS` and `LWP`.
Usage:
```
$ dohc.pl OPTIONS
```
where `OPTIONS` can be any of the following (in any order):
* `QNAME` - query name. mandatory
* `QTYPE` - query type, any RR type supported by your version of `Net::DNS` will work. Defaults to `A` if unset.
* `QCLASS` - query class, defaults to `IN`
* `URL` - this may be either a fully-qualified URL such as `https://example.com/dns-query` or a string of the form
````
@example.com
````
This will get turned into the HTTPS URL above.
The full DNS response will be printed to `STDOUT`.
## `dohd.pl` (DoH server)
This script implements a simple DoH swerver using `Net::DNS` and `HTTP::Daemon`. It doesn't (currently) daemonise or do logging. You will need to put something in front of it to do SSL termination.
#!/usr/bin/perl
# Simple DNS-over-HTTPS client. Copyright 2018 CentralNic Ltd
use Net::IP;
use Net::DNS;
use Net::DNS::Parameters;
use HTTP::Request::Common;
use LWP::UserAgent;
use Getopt::Long;
use URI;
use strict;
my $ct = 'application/dns-message';
my ($qname, $qtype, $qclass, $url, $debug);
#
# dig-like command lines, things can appear in any order
#
# URL can be explicit, if it starts with https:// or http://, or
# if it starts with @, will be constructed, ie @example.com =>
# https://example.com/dns-query
#
while (scalar(@ARGV) > 0) {
my $param = shift(@ARGV);
if ($param =~ /^(-d|--debug)$/) {
$debug = 1;
} elsif ($param =~ /^(@|https?:\/\/)(.+)$/) {
if ($url) {
print STDERR "Error: multiple URLs provided\n";
exit;
} else {
if ('@' eq $1) {
$url = sprintf('https://%s/dns-query', $2);
} else {
$url = $param;
}
}
} elsif ($Net::DNS::Parameters::classbyname{$param}) {
if ($qclass) {
print STDERR "Error: multiple classes provided\n";
exit;
} else {
$qclass = $param;
}
} elsif ($Net::DNS::Parameters::typebyname{$param}) {
if ($qtype) {
print STDERR "Error: multiple types provided\n";
exit;
} else {
$qtype = $param;
}
} elsif ($qname) {
print STDERR "Error: multiple query names provided\n";
exit;
} else {
$qname = $param;
}
}
$qtype = $qtype || 'A';
$qclass = $qclass || 'IN';
if (!$qname) {
print STDERR "Error: no query name provided\n";
exit(1);
} elsif (!$url) {
print STDERR "Error: no URL provided\n";
exit(1);
}
$qname =~ s/\.$//g;
my $packet = Net::DNS::Packet->new($qname.'.', $qtype, $qclass);
my $request = POST($url, 'Content-Type' => $ct, 'Content' => $packet->data);
$request->header('Accept' => $ct);
print STDERR $request->as_string if ($debug);
my $response = LWP::UserAgent->new->request($request);
print STDERR $response->as_string if ($debug);
if ($response->is_error || 200 != $response->code) {
print STDERR $response->status_line."\n";
exit(1);
} else {
my $data = $response->content;
my $answer = Net::DNS::Packet->new(\$data);
$answer->print;
}
#!/usr/bin/perl
# Simple DNS-over-HTTPS server. Copyright 2018 CentralNic Ltd
use Getopt::Long;
use HTTP::Daemon;
use Net::DNS;
use Net::IP;
use MIME::Base64;
use URI;
use strict;
my $ct = 'application/dns-message';
my $laddr = '127.0.0.1';
my $lport = '8080';
my $raddr = '1.1.1.1';
my $resolver = Net::DNS::Resolver->new('nameservers' => [ $raddr ]);
my $server = HTTP::Daemon->new(
'LocalAddr' => $laddr,
'LocalPort' => $lport,
);
if (!$server) {
printf(STDERR "Unable to start server on %s:%u: %s\n", $laddr, $lport, $@);
exit(1);
}
#
# listen for connections
#
while (my $connection = $server->accept) {
#
# catch errors by using eval { ... }
#
eval {
handle_connection($connection);
$connection->close;
undef($connection);
};
}
#
# handle a connection
#
sub handle_connection {
#
# $connection is a HTTPP:Daemon::ClientConn
#
my $connection = shift;
#
# $request is a HTTP::Request
#
my $request = $connection->get_request;
#
# DNS query packet data goes here
#
my $data;
if ($request->method eq 'GET') {
#
# extract packet data from query string
#
my %params = URI->new_abs($request->uri, $server->url)->query_form;
$data = decode_base64($params{'dns'});
} elsif ($request->method eq 'POST') {
if ($ct ne $request->header('Content-Type')) {
$connection->send_error(415);
} else {
$data = $request->content;
}
} else {
$connection->send_error(405);
return;
}
my $packet = Net::DNS::Packet->new(\$data);
if (!$packet) {
$connection->send_error(400);
return;
} else {
#
# send the packet to the server
#
my $response = $resolver->send($packet);
if (!$response) {
$connection->send_error(504);
} else {
#
# send the response back to the client
#
$connection->send_status_line;
$connection->send_header('Content-Type', $ct);
$connection->send_header('Connection', 'close');
$connection->send_crlf;
$connection->print($response->data);
$connection->close;
}
}
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment