GNU bug report logs - #28055
[WIP] Add knot tests

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Julien Lepiller <julien@HIDDEN>; Keywords: patch; dated Fri, 11 Aug 2017 19:06:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.
Added tag(s) patch. Request was from Christopher Baines <mail@HIDDEN> to control <at> debbugs.gnu.org. Full text available.

Message received at 28055 <at> debbugs.gnu.org:


Received: (at 28055) by debbugs.gnu.org; 15 Dec 2017 10:53:14 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Dec 15 05:53:14 2017
Received: from localhost ([127.0.0.1]:34731 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1ePncA-00050A-CG
	for submit <at> debbugs.gnu.org; Fri, 15 Dec 2017 05:53:14 -0500
Received: from hera.aquilenet.fr ([141.255.128.1]:54713)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1ePnc4-0004zn-FW
 for 28055 <at> debbugs.gnu.org; Fri, 15 Dec 2017 05:53:10 -0500
Received: from localhost (localhost [127.0.0.1])
 by hera.aquilenet.fr (Postfix) with ESMTP id 416B610314;
 Fri, 15 Dec 2017 11:53:11 +0100 (CET)
X-Virus-Scanned: Debian amavisd-new at aquilenet.fr
Received: from hera.aquilenet.fr ([127.0.0.1])
 by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024)
 with ESMTP id Mh2DZrLzc_Es; Fri, 15 Dec 2017 11:53:10 +0100 (CET)
Received: from ribbon (unknown [193.50.110.249])
 by hera.aquilenet.fr (Postfix) with ESMTPSA id 173F5102BA;
 Fri, 15 Dec 2017 11:53:10 +0100 (CET)
From: ludo@HIDDEN (Ludovic =?utf-8?Q?Court=C3=A8s?=)
To: Julien Lepiller <julien@HIDDEN>
Subject: Re: [bug#28055] [WIP] Add knot tests
References: <20170811210341.10ab9965@HIDDEN> <87tw17khg0.fsf@HIDDEN>
 <87r2ut27cb.fsf@HIDDEN> <878temiw5i.fsf@HIDDEN>
 <20171202121815.553c0b93@HIDDEN>
X-URL: http://www.fdn.fr/~lcourtes/
X-Revolutionary-Date: 25 Frimaire an 226 de la =?utf-8?Q?R=C3=A9volution?=
X-PGP-Key-ID: 0x090B11993D9AEBB5
X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc
X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4  0CFB 090B 1199 3D9A EBB5
X-OS: x86_64-pc-linux-gnu
Date: Fri, 15 Dec 2017 11:53:06 +0100
In-Reply-To: <20171202121815.553c0b93@HIDDEN> (Julien Lepiller's message
 of "Sat, 2 Dec 2017 12:18:15 +0100")
Message-ID: <87fu8cjm99.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: 1.0 (+)
X-Debbugs-Envelope-To: 28055
Cc: 28055 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 1.0 (+)

Hello,

Julien Lepiller <julien@HIDDEN> skribis:

> Here is a new version. The tests still don't pass though. It can't send
> the request to the server.
>
> From ecc02fe8098d8763b95d2c71215a62e669f49568 Mon Sep 17 00:00:00 2001
> From: Julien Lepiller <julien@HIDDEN>
> Date: Sat, 2 Dec 2017 10:51:18 +0100
> Subject: [PATCH 1/2] guix: Add DNS implementation.
>
> * guix/dns.scm: New file.
> * Makefile.am: Add it.

[...]

> +;;; Commentary:
> +;;;
> +;;; This module provides a DNS implementation. This modules helps constr=
uct
                                                  ^^^^^^^^^^^^
=E2=80=9CIt=E2=80=9D.  :-)

Maybe add that it=E2=80=99s primarily for test purposes.

Very nice stuff!

> From 5146714c6615161fe3e496909f5a157c24d57ea0 Mon Sep 17 00:00:00 2001
> From: Julien Lepiller <julien@HIDDEN>
> Date: Sat, 2 Dec 2017 12:15:28 +0100
> Subject: [PATCH 2/2] gnu: tests: Add knot test.
>
> * gnu/tests/dns.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

[...]

> +(define (run-knot-test)
> +  "Return a test of an OS running Knot service."
> +  (define vm
> +    (virtual-machine
> +     (operating-system (marionette-operating-system
> +                        %knot-os
> +                        #:imported-modules '((gnu services herd))))
> +     (port-forwardings '((1053 . 53)))))

Note that this creates *TCP* port forwardings (see
=E2=80=98port-forwardings->qemu-options=E2=80=99 in (gnu system vm)).

Perhaps you=E2=80=99ll want UDP forwarding?

> +          (test-eq "get the correct answer"
> +            #$%ip4-addr

Should be =E2=80=98test-equal=E2=80=99 since you=E2=80=99re comparing strin=
gs.

> +            (begin
> +              (format #t "test:\n")
> +              (let* ((query (simple-a-query "mail.guix-test.org"))
> +                     (dns (socket AF_INET SOCK_STREAM 0))
> +                     (addr (make-socket-address AF_INET INADDR_LOOPBACK =
1053)))
> +                (connect dns addr)

I learned from
<https://serverfault.com/questions/181956/is-it-true-that-a-nameserver-have=
-to-answer-queries-over-tcp>
that DNS servers are now supposed to listen for TCP requests, but are we
sure this is the case here?

What error do you get?  Does the =E2=80=98connect=E2=80=99 call fail?  Does=
 the message
go through?

Thanks!

Ludo=E2=80=99.




Information forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.

Message received at 28055 <at> debbugs.gnu.org:


Received: (at 28055) by debbugs.gnu.org; 2 Dec 2017 11:20:48 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sat Dec 02 06:20:48 2017
Received: from localhost ([127.0.0.1]:41023 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1eL5qh-0002oU-CP
	for submit <at> debbugs.gnu.org; Sat, 02 Dec 2017 06:20:48 -0500
Received: from lepiller.eu ([89.234.186.109]:60736)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <julien@HIDDEN>) id 1eL5qY-0002oD-Lo
 for 28055 <at> debbugs.gnu.org; Sat, 02 Dec 2017 06:20:42 -0500
Received: from localhost (static-176-182-42-79.ncc.abo.bbox.fr [176.182.42.79])
 by lepiller.eu (OpenSMTPD) with ESMTPSA id f32862aa
 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO)
 for <28055 <at> debbugs.gnu.org>; Sat, 2 Dec 2017 11:23:14 +0000 (UTC)
Date: Sat, 2 Dec 2017 12:18:15 +0100
From: Julien Lepiller <julien@HIDDEN>
To: 28055 <at> debbugs.gnu.org
Subject: Re: [bug#28055] [WIP] Add knot tests
Message-ID: <20171202121815.553c0b93@HIDDEN>
In-Reply-To: <878temiw5i.fsf@HIDDEN>
References: <20170811210341.10ab9965@HIDDEN> <87tw17khg0.fsf@HIDDEN>
 <87r2ut27cb.fsf@HIDDEN> <878temiw5i.fsf@HIDDEN>
X-Mailer: Claws Mail 3.15.1-dirty (GTK+ 2.24.31; x86_64-unknown-linux-gnu)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="MP_/wmRWkbLac1SLyOCrxrnow1F"
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 28055
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.0 (/)

--MP_/wmRWkbLac1SLyOCrxrnow1F
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline

Le Fri, 01 Dec 2017 11:23:53 +0100,
ludo@HIDDEN (Ludovic Court=C3=A8s) a =C3=A9crit :

> Julien,
>=20
> Did you have a chance to look into that?
>=20
> TIA,
> Ludo=E2=80=99.
>=20

Here is a new version. The tests still don't pass though. It can't send
the request to the server.


--MP_/wmRWkbLac1SLyOCrxrnow1F
Content-Type: text/x-patch
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
 filename=0001-guix-Add-DNS-implementation.patch

=46rom ecc02fe8098d8763b95d2c71215a62e669f49568 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@HIDDEN>
Date: Sat, 2 Dec 2017 10:51:18 +0100
Subject: [PATCH 1/2] guix: Add DNS implementation.

* guix/dns.scm: New file.
* Makefile.am: Add it.
---
 Makefile.am  |   1 +
 guix/dns.scm | 363 +++++++++++++++++++++++++++++++++++++++++++++++++++++++=
++++
 2 files changed, 364 insertions(+)
 create mode 100644 guix/dns.scm

diff --git a/Makefile.am b/Makefile.am
index 24a803a21..1f325ca97 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -73,6 +73,7 @@ MODULES =3D					\
   guix/graph.scm				\
   guix/cache.scm				\
   guix/cve.scm					\
+  guix/dns.scm					\
   guix/workers.scm				\
   guix/zlib.scm					\
   guix/build-system.scm				\
diff --git a/guix/dns.scm b/guix/dns.scm
new file mode 100644
index 000000000..6eb17a7e0
--- /dev/null
+++ b/guix/dns.scm
@@ -0,0 +1,363 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2017 Julien Lepiller <julien@HIDDEN>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix dns)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 iconv)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs arithmetic bitwise)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (<dns-flags> make-dns-flags dns-flags?
+            dns-flags-response?
+            dns-flags-opcode
+            dns-flags-authoritative-answer?
+            dns-flags-truncation?
+            dns-flags-recursion-desired?
+            dns-flags-recursion-available?
+            dns-flags-rcode
+
+            <dns-query> make-dns-query dns-query?
+            dns-query-flags
+            dns-query-queries
+            dns-query-answers
+            dns-query-nameservers
+            dns-query-additionals
+
+            <query> make-query query?
+            query-name
+            query-type
+            query-class
+
+            <dns-record> make-dns-record dns-record?
+            dns-record-name
+            dns-record-type
+            dns-record-class
+            dns-record-ttl
+            dns-record-rdata
+
+            simple-a-query
+            dns-query->bytevector
+            bytevector->dns-query
+            bytevector->ipv4))
+
+;;; Commentary:
+;;;
+;;; This module provides a DNS implementation. This modules helps construct
+;;; valid DNS requests and analyze responses from servers.
+;;;
+;;; Code:
+
+(define-record-type <dns-flags>
+  (make-dns-flags response? opcode authoritative-answer? truncation?
+                  recursion-desired? recursion-available? rcode)
+  dns-flags?
+  (response? dns-flags-response?)
+  (opcode dns-flags-opcode)
+  (authoritative-answer? dns-flags-authoritative-answer?)
+  (truncation? dns-flags-truncation?)
+  (recursion-desired? dns-flags-recursion-desired?)
+  (recursion-available? dns-flags-recursion-available?)
+  (rcode dns-flags-rcode))
+
+(define-record-type <dns-query>
+  (make-dns-query flags queries answers nameservers additionals)
+  dns-query?
+  (flags dns-query-flags)
+  (queries dns-query-queries)
+  (answers dns-query-answers)
+  (nameservers dns-query-nameservers)
+  (additionals dns-query-additionals))
+
+(define-record-type <query>
+  (make-query name type class)
+  query?
+  (name query-name)
+  (type query-type)
+  (class query-class))
+
+(define-record-type <dns-record>
+  (make-dns-record name type class ttl rdata)
+  dns-record?
+  (name dns-record-name)
+  (type dns-record-type)
+  (class dns-record-class)
+  (ttl dns-record-ttl)
+  (rdata dns-record-rdata))
+
+(define-record-type <pos-value>
+  (make-pos-value pos value)
+  pos-value?
+  (pos pos-value-pos)
+  (value pos-value-value))
+
+;; query type from/to number
+
+(define (type->number type)
+  (match type
+    ("A" 1)
+    ("AAAA" 28)))
+
+(define (type->string type)
+  (match type
+    (1 "A")
+    (28 "AAAA")))
+
+(define (opcode->number opcode)
+  (match opcode
+    ("QUERY" 0)
+    ("IQUERY" 1)
+    ("STATUS" 2)))
+
+(define (opcode->string opcode)
+  (match opcode
+    (0 "QUERY")
+    (1 "IQUERY")
+    (2 "STATUS")))
+
+(define (rcode->number rcode)
+  (match rcode
+    ("NOERROR" 0)
+    ("FORMATERROR" 1)
+    ("SERVFAIL" 2)
+    ("NAMEERROR" 3)
+    ("NOTIMPLEMENTED" 4)
+    ("REFUSED" 5)))
+
+(define (rcode->string rcode)
+  (match rcode
+    (0 "NOERROR")
+    (1 "FORMATERROR")
+    (2 "SERVFAIL")
+    (3 "NAMEERROR")
+    (4 "NOTIMPLEMENTED")
+    (5 "REFUSED")))
+
+(define (class->number class)
+  (match class
+    ("IN" 1)
+    ("CS" 2)
+    ("CH" 3)
+    ("HS" 4)))
+
+(define (class->string class)
+  (match class
+    (1 "IN")
+    (2 "CS")
+    (3 "CH")
+    (4 "HS")))
+
+(define (write-domain bv components pos)
+  "Updates @var{bv} starting at @var{pos} with the @var{components}.
+The DNS protocol specifies that each component is preceded by a byte conta=
ining
+the size of the component, and the last component is followed by the nul b=
yte.
+We do not implement the compression algorithm in the query."
+  (match components
+    ('()
+     (begin
+       (bytevector-u8-set! bv pos 0)
+       (+ pos 1)))
+    ((component rest ...)
+     (begin
+       (bytevector-u8-set! bv pos (string-length component))
+       (bytevector-copy! (string->bytevector component "UTF-8") 0
+                         bv (+ pos 1) (string-length component))
+       (write-domain bv rest (+ pos (string-length component) 1))))))
+
+(define (boolean->number b)
+  (if b 1 0))
+
+(define (number->boolean n)
+  (not (eq? n 0)))
+
+(define (query-flags->number flags)
+  "Returns a number corresponding to the flag bitfield in the DNS header."
+  (+ (* 256 128 (boolean->number (dns-flags-response? flags)))
+     (* 256 8 (opcode->number (dns-flags-opcode flags)))
+     (* 256 4 (boolean->number (dns-flags-authoritative-answer? flags)))
+     (* 256 2 (boolean->number (dns-flags-truncation? flags)))
+     (* 256   (boolean->number (dns-flags-recursion-desired? flags)))
+     (* 128   (boolean->number (dns-flags-recursion-available? flags)))
+     (rcode->number (dns-flags-rcode flags))))
+
+(define (create-dns-header flags qdcount ancount nscount arcount)
+  "Creates a bytevector containing the header of a DNS query."
+  (let ((bv (make-bytevector 12)))
+    (bytevector-u16-set! bv 0 15326 (endianness big))
+    (bytevector-u16-set! bv 2 (query-flags->number flags) (endianness big))
+    (bytevector-u16-set! bv 4 qdcount (endianness big))
+    (bytevector-u16-set! bv 6 ancount (endianness big))
+    (bytevector-u16-set! bv 8 nscount (endianness big))
+    (bytevector-u16-set! bv 10 arcount (endianness big))
+    bv))
+
+(define (create-dns-query query)
+  "Creates a bytevector containing a question section of a DNS query"
+  (let* ((domain (query-name query))
+         (len (+ 2 (string-length domain) 4))
+         (bv (make-bytevector len)))
+    (write-domain bv (string-split domain #\.) 0)
+    (bytevector-u16-set! bv (+ 2 (string-length domain))
+                         (type->number (query-type query)) (endianness big=
))
+    (bytevector-u16-set! bv (+ 4 (string-length domain))
+                         (class->number (query-class query)) (endianness b=
ig))
+    bv))
+
+(define (create-dns-queries queries)
+  (map create-dns-query queries))
+
+;; TODO
+(define (create-dns-answers answers)
+  '())
+(define create-dns-nameservers create-dns-answers)
+(define create-dns-additionals create-dns-answers)
+
+(define (dns-query->bytevector query tcp?)
+  "Creates a bytevector representing the DNS query to send over the networ=
k.
+If @code{tcp?} is @code{#t}, the query is suitable for being sent over TCP.
+Otherwise, it is suitable to be sent over UDP."
+  (let* ((header (create-dns-header
+                   (dns-query-flags query)
+                   (length (dns-query-queries query))
+                   (length (dns-query-answers query))
+                   (length (dns-query-nameservers query))
+                   (length (dns-query-additionals query))))
+         (queries (create-dns-queries (dns-query-queries query)))
+         (answers (create-dns-answers (dns-query-answers query)))
+         (nameservers (create-dns-answers (dns-query-nameservers query)))
+         (additionals (create-dns-answers (dns-query-additionals query)))
+         (tcp-header (if tcp? (make-bytevector 2) (make-bytevector 0)))
+         (parts-list (append (list tcp-header header) queries answers name=
servers additionals))
+         (len (fold (lambda (bv l) (+ l (bytevector-length bv))) 0 parts-l=
ist))
+         (bv (make-bytevector len)))
+    (begin
+      (if tcp?
+        (bytevector-u16-set! tcp-header 0 (- len 2) (endianness big)))
+      (fold (lambda (part l)
+              (begin
+                (bytevector-copy! part 0 bv l (bytevector-length part))
+                (+ l (bytevector-length part))))
+            0 parts-list)
+      bv)))
+
+(define (bytevector->name bv pos)
+  "Extracts a name at position @code{pos} in bytevector @code{bv}. This
+procedure supports the compression algorithm of DNS names."
+  (let* ((component-size (bytevector-u8-ref bv pos))
+         (vect (make-bytevector component-size)))
+    (if (eq? component-size 0)
+        (make-pos-value (+ pos 1) "")
+        (begin
+          ;; If the first two bytes are 0, the name is not compressed. Oth=
erwise,
+          ;; it is compressed and the rest of the field is the position at
+          ;; which the complete name can be found.
+          (if (eq? (bitwise-and 192 component-size) 0)
+              (begin
+                (bytevector-copy! bv (+ pos 1)
+                                  vect 0 component-size)
+                (let ((rest (bytevector->name bv (+ pos 1 component-size))=
))
+                  (make-pos-value (pos-value-pos rest)
+                    (string-append (bytevector->string vect "UTF-8") "."
+                                 (pos-value-value rest)))))
+              (let ((pointer (bitwise-and
+                               (bytevector-u16-ref bv pos (endianness big))
+                               (- 65535 (* 256 192)))))
+                (make-pos-value (+ pos 2)
+                  (pos-value-value (bytevector->name bv (+ 2 pointer))))))=
))))
+
+(define (bytevector->query bv pos)
+  (let* ((name (bytevector->name bv pos))
+         (type (type->string (bytevector-u16-ref bv (pos-value-pos name)
+                                                 (endianness big))))
+         (class (class->string (bytevector-u16-ref bv (+ 2 (pos-value-pos =
name))
+                                                   (endianness big)))))
+    (make-pos-value (+ 4 (pos-value-pos name))
+                    (make-query (pos-value-value name) type class))))
+
+(define (bytevector->queries bv pos num)
+  (if (eq? num 0)
+    (make-pos-value pos '())
+    (let* ((q (bytevector->query bv pos))
+           (rest (bytevector->queries bv (pos-value-pos q) (- num 1))))
+      (make-pos-value
+        (pos-value-pos rest)
+        (cons (pos-value-value q)
+              (pos-value-value rest))))))
+
+(define (bytevector->dns-records bv pos count)
+  (if (> count 0)
+      (let* ((result (bytevector->name bv pos))
+             (domain (pos-value-value result))
+             (npos (pos-value-pos result))
+             (type (bytevector-u16-ref bv npos (endianness big)))
+             (class (bytevector-u16-ref bv (+ npos 2) (endianness big)))
+             (ttl (bytevector-u32-ref bv (+ npos 4) (endianness big)))
+             (rdlength (bytevector-u16-ref bv (+ npos 8) (endianness big)))
+             (data (make-bytevector rdlength))
+             (rest (bytevector->dns-records bv (+ npos 10 rdlength) (- cou=
nt 1))))
+        (bytevector-copy! bv (+ npos 10)
+                          data 0 rdlength)
+        (make-pos-value (pos-value-pos rest)
+          (cons (make-dns-record domain (type->string type)
+                                 (class->string class) ttl data)
+                (pos-value-value rest))))
+      (make-pos-value pos '())))
+
+(define (bytevector->dns-query bv tcp?)
+  "Creates a @code{dns-query} object from the @code{bv} bytevector. If @co=
de{tcp?}
+is #t, the message is assumed to come from a TCP connection, otherwise it =
is
+treated as if it came from a UDP message."
+  (let* ((pos (if tcp? 2 0))
+         ;; decode header
+         (flags (bytevector-u16-ref bv (+ pos 2) (endianness big)))
+         (flags (make-dns-flags
+                  (number->boolean (bitwise-and (* 256 128) flags))
+                  (opcode->string (/ (bitwise-and (* 256 (+ 8 16 32 64)) f=
lags) (* 256 8)))
+                  (number->boolean (bitwise-and (* 256 4) flags))
+                  (number->boolean (bitwise-and (* 256 2) flags))
+                  (number->boolean (bitwise-and 256 flags))
+                  (number->boolean (bitwise-and 128 flags))
+                  (rcode->string (bitwise-and 15 flags))))
+         (qdcount (bytevector-u16-ref bv (+ pos 4) (endianness big)))
+         (ancount (bytevector-u16-ref bv (+ pos 6) (endianness big)))
+         (nscount (bytevector-u16-ref bv (+ pos 8) (endianness big)))
+         (arcount (bytevector-u16-ref bv (+ pos 10) (endianness big)))
+         (pos (+ pos 12))
+         (queries (bytevector->queries bv pos qdcount))
+         (pos (pos-value-pos queries))
+         (answers (bytevector->dns-records bv pos ancount))
+         (pos (pos-value-pos answers))
+         (nameservers (bytevector->dns-records bv pos nscount))
+         (pos (pos-value-pos nameservers))
+         (additionals (bytevector->dns-records bv pos arcount)))
+    (make-dns-query flags (pos-value-value queries) (pos-value-value answe=
rs)
+                    (pos-value-value nameservers) (pos-value-value additio=
nals))))
+
+(define (simple-a-query domain)
+  "Creates a simple query object that can be passed to @code{dns-query->by=
tevector}."
+  (make-dns-query (make-dns-flags #f "QUERY" #f #f #t #t "NOERROR")
+                  (list (make-query domain "A" "IN"))
+                  '() '() '()))
+
+(define (bytevector->ipv4 bv)
+  "Extracts the rdata section of an A record."
+  (string-append
+    (number->string (bytevector-u8-ref bv 0)) "."
+    (number->string (bytevector-u8-ref bv 1)) "."
+    (number->string (bytevector-u8-ref bv 2)) "."
+    (number->string (bytevector-u8-ref bv 3))))
--=20
2.15.0


--MP_/wmRWkbLac1SLyOCrxrnow1F
Content-Type: text/x-patch
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment; filename=0002-gnu-tests-Add-knot-test.patch

=46rom 5146714c6615161fe3e496909f5a157c24d57ea0 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@HIDDEN>
Date: Sat, 2 Dec 2017 12:15:28 +0100
Subject: [PATCH 2/2] gnu: tests: Add knot test.

* gnu/tests/dns.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/local.mk      |   1 +
 gnu/tests/dns.scm | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++=
++++
 2 files changed, 119 insertions(+)
 create mode 100644 gnu/tests/dns.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 2e74c4d81..2fa736523 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -507,6 +507,7 @@ GNU_SYSTEM_MODULES =3D				\
   %D%/tests/databases.scm			\
   %D%/tests/desktop.scm				\
   %D%/tests/dict.scm				\
+  %D%/tests/dns.scm				\
   %D%/tests/nfs.scm				\
   %D%/tests/install.scm				\
   %D%/tests/mail.scm				\
diff --git a/gnu/tests/dns.scm b/gnu/tests/dns.scm
new file mode 100644
index 000000000..228204e31
--- /dev/null
+++ b/gnu/tests/dns.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2017 Julien Lepiller <julien@HIDDEN>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests dns)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services dns)
+  #:use-module (gnu services networking)
+  #:use-module (guix dns)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (ice-9 ftw)
+  #:export (%test-knot))
+
+(define %ip4-addr
+;; a random IPv4 address
+  "136.12.251.84")
+
+(define-zone-entries %test-entries
+;; Test entries, with no real data
+;; Name TTL Class Type Data
+  ("@"  ""  "IN"  "A"  "1.2.3.4")
+  ("@"  ""  "IN"  "MX" "10 mail")
+  ("mail" "" "IN" "A"  %ip4-addr))
+
+(define %test-zone
+;; A test zone that uses the fake data
+  (knot-zone-configuration
+    (domain "guix-test.org")
+    (zone (zone-file
+            (origin "guix-test.org")
+            (entries %test-entries)))))
+
+(define %knot-zones
+  (list %test-zone))
+
+(define %knot-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (service knot-service-type
+            (knot-configuration
+              (zones %knot-zones)))))
+
+(define (run-knot-test)
+  "Return a test of an OS running Knot service."
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %knot-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((1053 . 53)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix dns))
+      #~(begin
+          (use-modules (guix dns)
+                       (gnu build marionette)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "knot")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'knot)
+                #t)
+             marionette))
+
+          (test-eq "get the correct answer"
+            #$%ip4-addr
+            (begin
+              (format #t "test:\n")
+              (let* ((query (simple-a-query "mail.guix-test.org"))
+                     (dns (socket AF_INET SOCK_STREAM 0))
+                     (addr (make-socket-address AF_INET INADDR_LOOPBACK 10=
53)))
+                (connect dns addr)
+                (put-bytevector dns (dns-query->bytevector query #t))
+                (bytevector->ipv4
+                  (dns-record-rdata
+                    (car (dns-query-answers
+                           (bytevector->dns-query
+                             (get-bytevector-n dns 500)))))))))
+
+          (test-end)
+          (exit (=3D (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "knot-test" test))
+
+(define %test-knot
+  (system-test
+   (name "knot")
+   (description "Send a DNS=C2=A0request to a running Knot server.")
+   (value (run-knot-test))))
--=20
2.15.0


--MP_/wmRWkbLac1SLyOCrxrnow1F--




Information forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.

Message received at 28055 <at> debbugs.gnu.org:


Received: (at 28055) by debbugs.gnu.org; 1 Dec 2017 10:23:56 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Dec 01 05:23:56 2017
Received: from localhost ([127.0.0.1]:39083 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1eKiU8-0000Sc-FN
	for submit <at> debbugs.gnu.org; Fri, 01 Dec 2017 05:23:56 -0500
Received: from [141.255.128.1] (port=33755 helo=hera.aquilenet.fr)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1eKiU7-0000SV-8k
 for 28055 <at> debbugs.gnu.org; Fri, 01 Dec 2017 05:23:55 -0500
Received: from localhost (localhost [127.0.0.1])
 by hera.aquilenet.fr (Postfix) with ESMTP id 6EB0610048;
 Fri,  1 Dec 2017 11:23:57 +0100 (CET)
X-Virus-Scanned: Debian amavisd-new at aquilenet.fr
Received: from hera.aquilenet.fr ([127.0.0.1])
 by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024)
 with ESMTP id E5Tda9zX_zgo; Fri,  1 Dec 2017 11:23:56 +0100 (CET)
Received: from ribbon (unknown [193.50.110.211])
 by hera.aquilenet.fr (Postfix) with ESMTPSA id 62D86F129;
 Fri,  1 Dec 2017 11:23:56 +0100 (CET)
From: ludo@HIDDEN (Ludovic =?utf-8?Q?Court=C3=A8s?=)
To: Julien Lepiller <julien@HIDDEN>
Subject: Re: [bug#28055] [WIP] Add knot tests
References: <20170811210341.10ab9965@HIDDEN> <87tw17khg0.fsf@HIDDEN>
 <87r2ut27cb.fsf@HIDDEN>
Date: Fri, 01 Dec 2017 11:23:53 +0100
In-Reply-To: <87r2ut27cb.fsf@HIDDEN> ("Ludovic
 \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\=
 \=\?utf-8\?Q\?s\?\= message of "Tue, 26 Sep 2017 10:27:00 +0200")
Message-ID: <878temiw5i.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: 2.2 (++)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 the administrator of that system for details.
 
 Content preview:  Julien, Did you have a chance to look into that? TIA, Ludo’.
    [...] 
 
 Content analysis details:   (2.2 points, 10.0 required)
 
  pts rule name              description
 ---- ---------------------- --------------------------------------------------
  1.0 SPF_SOFTFAIL           SPF: sender does not match SPF record (softfail)
  0.0 SPF_HELO_FAIL          SPF: HELO does not match SPF record (fail)
 [SPF failed: Please see http://www.openspf.org/Why?s=helo;id=hera.aquilenet.fr;ip=141.255.128.1;r=debbugs.gnu.org]
  1.3 RDNS_NONE              Delivered to internal network by a host with no rDNS
X-Debbugs-Envelope-To: 28055
Cc: Ricardo Wurmus <rekado@HIDDEN>, 28055 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 2.2 (++)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 the administrator of that system for details.
 
 Content preview:  Julien, Did you have a chance to look into that? TIA, Ludo’.
    [...] 
 
 Content analysis details:   (2.2 points, 10.0 required)
 
  pts rule name              description
 ---- ---------------------- --------------------------------------------------
  1.0 SPF_SOFTFAIL           SPF: sender does not match SPF record (softfail)
  0.0 SPF_HELO_FAIL          SPF: HELO does not match SPF record (fail)
 [SPF failed: Please see http://www.openspf.org/Why?s=helo;id=hera.aquilenet.fr;ip=141.255.128.1;r=debbugs.gnu.org]
  1.3 RDNS_NONE              Delivered to internal network by a host with no rDNS

Julien,

Did you have a chance to look into that?

TIA,
Ludo=E2=80=99.

ludo@HIDDEN (Ludovic Court=C3=A8s) skribis:

> Howdy,
>
> Ricardo Wurmus <rekado@HIDDEN> skribis:
>
>>> This patch aims at adding a system test for knot. I've implemented the
>>> DNS protocol to be able to communicate with the server and try some
>>> queries. Unfortunately, although the server seems to be launched (the
>>> first test passes), it then refuses to answer. Do you see anything
>>> wrong, or anything I could do to understand why it doesn't pass?
>>
>> It looks like overkill to implement DNS queries with bytevectors from
>> the ground up.  Is there not an easier way to make a DNS test?
>
> It=E2=80=99s a bit overkill indeed=E2=80=A6 but I like it.  :-)
>
> Julien: could you move the DNS code to a new module, say (guix dns), and
> then add the Knot test?
>
> (So first patch adds (guix dns), second patch adds the test.)
>
> In passing, for (guix dns) it would be nice if you could add docstrings
> as you see fit, and attempt to use full words in identifiers (=E2=80=9Cad=
dress=E2=80=9D
> rather than =E2=80=9Caddr=E2=80=9D, =E2=80=9Cresolve=E2=80=9D rather than=
 =E2=80=9Cresolv=E2=80=9D, etc.=C2=B9).
>
> This looks really nice, thanks for working on it!
>
> Ludo=E2=80=99.
>
> =C2=B9 https://www.gnu.org/software/guix/manual/html_node/Formatting-Code=
.html




Information forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.

Message received at 28055 <at> debbugs.gnu.org:


Received: (at 28055) by debbugs.gnu.org; 26 Sep 2017 08:27:14 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Sep 26 04:27:14 2017
Received: from localhost ([127.0.0.1]:59633 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1dwlD0-0004wb-BE
	for submit <at> debbugs.gnu.org; Tue, 26 Sep 2017 04:27:14 -0400
Received: from eggs.gnu.org ([208.118.235.92]:50321)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1dwlCy-0004wO-UR
 for 28055 <at> debbugs.gnu.org; Tue, 26 Sep 2017 04:27:13 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1dwlCp-0003ma-BP
 for 28055 <at> debbugs.gnu.org; Tue, 26 Sep 2017 04:27:07 -0400
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-0.5 required=5.0 tests=BAYES_05,RP_MATCHES_RCVD
 autolearn=disabled version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:55349)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1dwlCp-0003mV-8U; Tue, 26 Sep 2017 04:27:03 -0400
Received: from [193.50.110.164] (port=59324 helo=ribbon)
 by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1dwlCo-0004T6-0M; Tue, 26 Sep 2017 04:27:02 -0400
From: ludo@HIDDEN (Ludovic =?utf-8?Q?Court=C3=A8s?=)
To: Ricardo Wurmus <rekado@HIDDEN>
Subject: Re: [bug#28055] [WIP] Add knot tests
References: <20170811210341.10ab9965@HIDDEN> <87tw17khg0.fsf@HIDDEN>
Date: Tue, 26 Sep 2017 10:27:00 +0200
In-Reply-To: <87tw17khg0.fsf@HIDDEN> (Ricardo Wurmus's message of "Wed,
 16 Aug 2017 11:09:03 +0200")
Message-ID: <87r2ut27cb.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: 28055
Cc: Julien Lepiller <julien@HIDDEN>, 28055 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -5.0 (-----)

Howdy,

Ricardo Wurmus <rekado@HIDDEN> skribis:

>> This patch aims at adding a system test for knot. I've implemented the
>> DNS protocol to be able to communicate with the server and try some
>> queries. Unfortunately, although the server seems to be launched (the
>> first test passes), it then refuses to answer. Do you see anything
>> wrong, or anything I could do to understand why it doesn't pass?
>
> It looks like overkill to implement DNS queries with bytevectors from
> the ground up.  Is there not an easier way to make a DNS test?

It=E2=80=99s a bit overkill indeed=E2=80=A6 but I like it.  :-)

Julien: could you move the DNS code to a new module, say (guix dns), and
then add the Knot test?

(So first patch adds (guix dns), second patch adds the test.)

In passing, for (guix dns) it would be nice if you could add docstrings
as you see fit, and attempt to use full words in identifiers (=E2=80=9Caddr=
ess=E2=80=9D
rather than =E2=80=9Caddr=E2=80=9D, =E2=80=9Cresolve=E2=80=9D rather than =
=E2=80=9Cresolv=E2=80=9D, etc.=C2=B9).

This looks really nice, thanks for working on it!

Ludo=E2=80=99.

=C2=B9 https://www.gnu.org/software/guix/manual/html_node/Formatting-Code.h=
tml




Information forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.

Message received at 28055 <at> debbugs.gnu.org:


Received: (at 28055) by debbugs.gnu.org; 16 Aug 2017 13:02:30 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Aug 16 09:02:30 2017
Received: from localhost ([127.0.0.1]:40344 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1dhxxt-0004fw-Qe
	for submit <at> debbugs.gnu.org; Wed, 16 Aug 2017 09:02:30 -0400
Received: from static-176-182-42-79.ncc.abo.bbox.fr ([176.182.42.79]:59138
 helo=metebelis3) by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <julien@HIDDEN>) id 1dhxxr-0004fh-DM
 for 28055 <at> debbugs.gnu.org; Wed, 16 Aug 2017 09:02:28 -0400
Received: from [131.254.252.191] (131.254.252.191 [131.254.252.191])
 by metebelis3 (OpenSMTPD) with ESMTPSA id 1e4ed10c
 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO)
 for <28055 <at> debbugs.gnu.org>; Wed, 16 Aug 2017 13:02:20 +0000 (UTC)
Date: Wed, 16 Aug 2017 15:02:17 +0200
User-Agent: K-9 Mail for Android
In-Reply-To: <87tw17khg0.fsf@HIDDEN>
References: <20170811210341.10ab9965@HIDDEN> <87tw17khg0.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/alternative;
 boundary="----DZQTD30M8W4STD5VUQGOCDONRQ67IB"
Content-Transfer-Encoding: 7bit
Subject: Re: [bug#28055] [WIP] Add knot tests
From: Julien Lepiller <julien@HIDDEN>
Message-ID: <FD67B377-F3AB-4467-8720-340CF97C7835@HIDDEN>
X-Spam-Score: 4.8 (++++)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 the administrator of that system for details.
 Content preview: Hm... I followed the example of mail.scm and implemented the
 protocol. I also thought a pure scheme implementation would be prefered.
 I didn't really think of anything else. I guess I could use the host utility
 to query the test server. Or if I can change the default dns server, I could
 use hostent:addr-list that I have just found in the manual. That would be
 better I think. [...] 
 Content analysis details:   (4.8 points, 10.0 required)
 pts rule name              description
 ---- ---------------------- --------------------------------------------------
 0.0 FSL_HELO_NON_FQDN_1    No description available.
 3.6 RCVD_IN_PBL            RBL: Received via a relay in Spamhaus PBL
 [176.182.42.79 listed in zen.spamhaus.org]
 1.2 MISSING_HEADERS        Missing To: header
 -0.0 SPF_PASS               SPF: sender matches SPF record
 0.0 HTML_MESSAGE           BODY: HTML included in message
X-Debbugs-Envelope-To: 28055
Cc: 28055 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 4.8 (++++)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 the administrator of that system for details.
 
 Content preview:  Hm... I followed the example of mail.scm and implemented the
    protocol. I also thought a pure scheme implementation would be prefered.
   I didn't really think of anything else. I guess I could use the host utility
    to query the test server. Or if I can change the default dns server, I could
    use hostent:addr-list that I have just found in the manual. That would be
    better I think. [...] 
 
 Content analysis details:   (4.8 points, 10.0 required)
 
  pts rule name              description
 ---- ---------------------- --------------------------------------------------
  3.6 RCVD_IN_PBL            RBL: Received via a relay in Spamhaus PBL
                             [176.182.42.79 listed in zen.spamhaus.org]
  0.0 FSL_HELO_NON_FQDN_1    No description available.
  1.2 MISSING_HEADERS        Missing To: header
 -0.0 SPF_PASS               SPF: sender matches SPF record
  0.0 HTML_MESSAGE           BODY: HTML included in message

------DZQTD30M8W4STD5VUQGOCDONRQ67IB
Content-Type: text/plain;
 charset=utf-8
Content-Transfer-Encoding: quoted-printable

Hm=2E=2E=2E I followed the example of mail=2Escm and implemented the protoc=
ol=2E I also thought a pure scheme implementation would be prefered=2E I di=
dn't really think of anything else=2E

I guess I could use the host utility to query the test server=2E Or if I c=
an change the default dns server, I could use hostent:addr-list that I have=
 just found in the manual=2E That would be better I think=2E

I'll try these methods=2E

Le 16 ao=C3=BBt 2017 11:09:03 GMT+02:00, Ricardo Wurmus <rekado@elephly=2E=
net> a =C3=A9crit :
>
>Hi Julien,
>
>> This patch aims at adding a system test for knot=2E I've implemented
>the
>> DNS protocol to be able to communicate with the server and try some
>> queries=2E Unfortunately, although the server seems to be launched (the
>> first test passes), it then refuses to answer=2E Do you see anything
>> wrong, or anything I could do to understand why it doesn't pass?
>
>It looks like overkill to implement DNS queries with bytevectors from
>the ground up=2E  Is there not an easier way to make a DNS test?
>
>--=20
>Ricardo
>
>GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
>https://elephly=2Enet

--=20
Envoy=C3=A9 de mon appareil Android avec Courriel K-9 Mail=2E Veuillez exc=
user ma bri=C3=A8vet=C3=A9=2E
------DZQTD30M8W4STD5VUQGOCDONRQ67IB
Content-Type: text/html;
 charset=utf-8
Content-Transfer-Encoding: quoted-printable

<html><head></head><body>Hm=2E=2E=2E I followed the example of mail=2Escm a=
nd implemented the protocol=2E I also thought a pure scheme implementation =
would be prefered=2E I didn&#39;t really think of anything else=2E<br>
<br>
I guess I could use the host utility to query the test server=2E Or if I c=
an change the default dns server, I could use hostent:addr-list that I have=
 just found in the manual=2E That would be better I think=2E<br>
<br>
I&#39;ll try these methods=2E<br><br><div class=3D"gmail_quote">Le 16 ao=
=C3=BBt 2017 11:09:03 GMT+02:00, Ricardo Wurmus &lt;rekado@elephly=2Enet&gt=
; a =C3=A9crit :<blockquote class=3D"gmail_quote" style=3D"margin: 0pt 0pt =
0pt 0=2E8ex; border-left: 1px solid rgb(204, 204, 204); padding-left: 1ex;"=
>
<pre class=3D"k9mail"><br />Hi Julien,<br /><br /><blockquote class=3D"gma=
il_quote" style=3D"margin: 0pt 0pt 1ex 0=2E8ex; border-left: 1px solid #729=
fcf; padding-left: 1ex;"> This patch aims at adding a system test for knot=
=2E I've implemented the<br /> DNS protocol to be able to communicate with =
the server and try some<br /> queries=2E Unfortunately, although the server=
 seems to be launched (the<br /> first test passes), it then refuses to ans=
wer=2E Do you see anything<br /> wrong, or anything I could do to understan=
d why it doesn't pass?<br /></blockquote><br />It looks like overkill to im=
plement DNS queries with bytevectors from<br />the ground up=2E  Is there n=
ot an easier way to make a DNS test?<br /></pre></blockquote></div><br>
-- <br>
Envoy=C3=A9 de mon appareil Android avec Courriel K-9 Mail=2E Veuillez exc=
user ma bri=C3=A8vet=C3=A9=2E</body></html>
------DZQTD30M8W4STD5VUQGOCDONRQ67IB--




Information forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.

Message received at 28055 <at> debbugs.gnu.org:


Received: (at 28055) by debbugs.gnu.org; 16 Aug 2017 09:09:12 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Aug 16 05:09:12 2017
Received: from localhost ([127.0.0.1]:40218 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1dhuK8-0003YQ-Cc
	for submit <at> debbugs.gnu.org; Wed, 16 Aug 2017 05:09:12 -0400
Received: from sender-of-o51.zoho.com ([135.84.80.216]:21137)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <rekado@HIDDEN>) id 1dhuK6-0003YI-QU
 for 28055 <at> debbugs.gnu.org; Wed, 16 Aug 2017 05:09:11 -0400
Received: from localhost (141.80.247.215 [141.80.247.215]) by mx.zohomail.com
 with SMTPS id 1502874546121341.4421360696414;
 Wed, 16 Aug 2017 02:09:06 -0700 (PDT)
References: <20170811210341.10ab9965@HIDDEN>
User-agent: mu4e 0.9.18; emacs 25.2.1
From: Ricardo Wurmus <rekado@HIDDEN>
To: Julien Lepiller <julien@HIDDEN>
Subject: Re: [bug#28055] [WIP] Add knot tests
In-reply-to: <20170811210341.10ab9965@HIDDEN>
X-URL: https://elephly.net
X-PGP-Key: https://elephly.net/rekado.pubkey
X-PGP-Fingerprint: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
Date: Wed, 16 Aug 2017 11:09:03 +0200
Message-ID: <87tw17khg0.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain
X-ZohoMailClient: External
X-Spam-Score: 1.0 (+)
X-Debbugs-Envelope-To: 28055
Cc: 28055 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 1.0 (+)


Hi Julien,

> This patch aims at adding a system test for knot. I've implemented the
> DNS protocol to be able to communicate with the server and try some
> queries. Unfortunately, although the server seems to be launched (the
> first test passes), it then refuses to answer. Do you see anything
> wrong, or anything I could do to understand why it doesn't pass?

It looks like overkill to implement DNS queries with bytevectors from
the ground up.  Is there not an easier way to make a DNS test?

-- 
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net





Information forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 11 Aug 2017 19:06:00 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Aug 11 15:06:00 2017
Received: from localhost ([127.0.0.1]:56005 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1dgFFw-0007i3-3Q
	for submit <at> debbugs.gnu.org; Fri, 11 Aug 2017 15:06:00 -0400
Received: from eggs.gnu.org ([208.118.235.92]:35430)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <julien@HIDDEN>) id 1dgFFr-0007ho-Qb
 for submit <at> debbugs.gnu.org; Fri, 11 Aug 2017 15:05:58 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <julien@HIDDEN>) id 1dgFFk-0003EK-5H
 for submit <at> debbugs.gnu.org; Fri, 11 Aug 2017 15:05:50 -0400
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled
 version=3.3.2
Received: from lists.gnu.org ([2001:4830:134:3::11]:47595)
 by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32)
 (Exim 4.71) (envelope-from <julien@HIDDEN>) id 1dgFFj-0003EE-WE
 for submit <at> debbugs.gnu.org; Fri, 11 Aug 2017 15:05:48 -0400
Received: from eggs.gnu.org ([2001:4830:134:3::10]:54617)
 by lists.gnu.org with esmtp (Exim 4.71)
 (envelope-from <julien@HIDDEN>) id 1dgFFh-0004iB-M5
 for guix-patches@HIDDEN; Fri, 11 Aug 2017 15:05:47 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <julien@HIDDEN>) id 1dgFFd-0003Ch-VD
 for guix-patches@HIDDEN; Fri, 11 Aug 2017 15:05:45 -0400
Received: from static-176-182-42-79.ncc.abo.bbox.fr ([176.182.42.79]:43402
 helo=metebelis3)
 by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32)
 (Exim 4.71) (envelope-from <julien@HIDDEN>) id 1dgFFd-0003BW-F1
 for guix-patches@HIDDEN; Fri, 11 Aug 2017 15:05:41 -0400
Received: from localhost (bbox.lan [192.168.1.254])
 by metebelis3 (OpenSMTPD) with ESMTPSA id ddd79601
 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO)
 for <guix-patches@HIDDEN>; Fri, 11 Aug 2017 19:05:36 +0000 (UTC)
Date: Fri, 11 Aug 2017 21:04:53 +0200
From: Julien Lepiller <julien@HIDDEN>
To: guix-patches@HIDDEN
Subject: [WIP] Add knot tests
Message-ID: <20170811210341.10ab9965@HIDDEN>
X-Mailer: Claws Mail 3.15.0-dirty (GTK+ 2.24.31; x86_64-unknown-linux-gnu)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="MP_/KUud_29NR7r7cA7.9Xmlrfw"
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
 [fuzzy]
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x
X-Received-From: 2001:4830:134:3::11
X-Spam-Score: -4.0 (----)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -4.0 (----)

--MP_/KUud_29NR7r7cA7.9Xmlrfw
Content-Type: text/plain; charset=US-ASCII
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

Hi,

This patch aims at adding a system test for knot. I've implemented the
DNS protocol to be able to communicate with the server and try some
queries. Unfortunately, although the server seems to be launched (the
first test passes), it then refuses to answer. Do you see anything
wrong, or anything I could do to understand why it doesn't pass?

Thanks :)
--MP_/KUud_29NR7r7cA7.9Xmlrfw
Content-Type: text/x-patch
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment; filename=0001-gnu-tests-Add-dns-test.patch

=46rom 71daf1a3baac37fe079e0fc282ce5447b8fbb140 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@HIDDEN>
Date: Sun, 18 Jun 2017 09:53:00 +0200
Subject: [PATCH] gnu: tests: Add dns test.

* gnu/tests/dns.scm: New file.
* gnu/local.mk: Add it.
---
 gnu/local.mk      |   1 +
 gnu/tests/dns.scm | 326 ++++++++++++++++++++++++++++++++++++++++++++++++++=
++++
 2 files changed, 327 insertions(+)
 create mode 100644 gnu/tests/dns.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index b1ff72d6a..f787b29de 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -484,6 +484,7 @@ GNU_SYSTEM_MODULES =3D				\
   %D%/tests/base.scm				\
   %D%/tests/databases.scm			\
   %D%/tests/dict.scm				\
+  %D%/tests/dns.scm				\
   %D%/tests/nfs.scm				\
   %D%/tests/install.scm				\
   %D%/tests/mail.scm				\
diff --git a/gnu/tests/dns.scm b/gnu/tests/dns.scm
new file mode 100644
index 000000000..7782cfcea
--- /dev/null
+++ b/gnu/tests/dns.scm
@@ -0,0 +1,326 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2017 Julien Lepiller <julien@HIDDEN>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests dns)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services dns)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (ice-9 ftw)
+  #:export (%test-knot))
+
+(define %ip4-addr
+;; a random IPv4 address
+  "136.12.251.84")
+
+(define-zone-entries %test-entries
+;; Test entries, with no real data
+;; Name TTL Class Type Data
+  ("@"  ""  "IN"  "A"  "1.2.3.4")
+  ("@"  ""  "IN"  "MX" "10 mail")
+  ("mail" "" "IN" "A"  %ip4-addr))
+
+(define %test-zone
+;; A test zone that uses the fake data
+  (knot-zone-configuration
+    (domain "guix-test.org")
+    (zone (zone-file
+            (origin "guix-test.org")
+            (entries %test-entries)))))
+
+(define %knot-zones
+  (list %test-zone))
+
+(define %knot-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (service knot-service-type
+            (knot-configuration
+              (zones %knot-zones)))))
+
+(define (run-knot-test)
+  "Return a test of an OS running Knot service."
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %knot-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((1053 . 53)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (rnrs base)
+                       (srfi srfi-9)
+                       (srfi srfi-64)
+                       (ice-9 binary-ports)
+                       (ice-9 iconv)
+                       (ice-9 match)
+                       (ice-9 rdelim)
+                       (ice-9 regex)
+                       (rnrs bytevectors)
+                       (rnrs arithmetic bitwise)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (define (qtype-num type)
+            (match type
+              ("A" 1)
+              ("AAAA" 28)))
+
+          (define (type->string type)
+            (match type
+              (1 "A")
+              (28 "AAAA")))
+
+          (define (make-request type domain)
+            (let* ((size (+ 2 ;TCP needs two bytes for the size before the=
 header
+                            12 ;Header
+                            (string-length domain)
+                            2 ;size of the domain + first component and ze=
ro
+                            2 ;QTYPE
+                            2)) ;QCLASS
+                   (bv (make-bytevector size)))
+              (bytevector-u16-set! bv 0 (- size 2) (endianness big))
+              ;; Header
+              (bytevector-u16-set! bv 2 15326 (endianness big))
+              (bytevector-u16-set! bv 4 256 (endianness big))
+              (bytevector-u16-set! bv 6 1 (endianness big))
+              (bytevector-u16-set! bv 8 0 (endianness big))
+              (bytevector-u16-set! bv 10 0 (endianness big))
+              (bytevector-u16-set! bv 12 0 (endianness big))
+              (let ((pos (write-domain bv (string-split domain #\.) 14)))
+                (bytevector-u16-set! bv pos (qtype-num type) (endianness b=
ig))
+                (bytevector-u16-set! bv (+ pos 2) 1 (endianness big)))
+              bv))
+
+          (define (write-domain bv components pos)
+            "Updates @var{bv} starting at @var{pos} with the @var{componen=
ts}.
+The DNS protocol specifies that each component is preceded by a byte conta=
ining
+the size of the component, and the last component is followed by the nul b=
yte.
+We do not implement the compression algorithm in the query."
+            (match components
+              ('()
+               (begin
+                 (bytevector-u8-set! bv pos 0)
+                 (+ pos 1)))
+              ((component rest ...)
+               (begin
+                 (bytevector-u8-set! bv pos (string-length component))
+                 (bytevector-copy! (string->bytevector component "UTF-8") 0
+                                   bv (+ pos 1) (string-length component))
+                 (write-domain bv rest (+ pos (string-length component) 1)=
)))))
+
+          ;(inet-pton AF_INET host)
+          (define (run-query host port type domain)
+            (let* ((request (make-request type domain))
+                   (dns (socket AF_INET SOCK_STREAM 0))
+                   (addr (make-socket-address AF_INET host port)))
+              (connect dns addr)
+              (put-bytevector dns request)
+              (get-bytevector-n dns 500)))
+
+          (define-record-type <dns-query>
+            (make-dns-query flags queries answers nameservers additionals)
+            dns-query?
+            (flags dns-query-flags)
+            (queries dns-query-queries)
+            (answers dns-query-answers)
+            (nameservers dns-query-nameservers)
+            (additionals dns-query-additionals))
+
+          (define-record-type <query>
+            (make-query name type class)
+            query?
+            (name query-name)
+            (type query-type)
+            (class query-class))
+
+          (define-record-type <dns-record>
+            (make-dns-record name type class ttl rdata)
+            dns-record?
+            (name dns-record-name)
+            (type dns-record-type)
+            (class dns-record-class)
+            (ttl dns-record-ttl)
+            (rdata dns-record-rdata))
+
+          (define (make-pos-val pos val)
+            (cons pos val))
+          (define (get-pos m)
+            (car m))
+          (define (get-val m)
+            (cdr m))
+
+          (define (decode-domain bv pos)
+            (let* ((component-size (bytevector-u8-ref bv pos))
+                   (vect (make-bytevector component-size)))
+              (if (eq? component-size 0)
+                  (make-pos-val (+ pos 1) "")
+                  (begin
+                    (if (eq? (bitwise-and 192 component-size) 0)
+                        (begin
+                          (bytevector-copy! bv (+ pos 1)
+                                            vect 0 component-size)
+                          (let ((rest (decode-domain bv (+ pos 1 component=
-size))))
+                            (make-pos-val (get-pos rest)
+                              (string-append (bytevector->string vect "UTF=
-8") "."
+                                           (get-val rest)))))
+                        (let ((pointer (bitwise-and
+                                         (bytevector-u16-ref bv pos (endia=
nness big))
+                                         (- 65535 (* 256 192)))))
+                          (make-pos-val (+ pos 2)
+                            (get-val (decode-domain bv (+ 2 pointer)))))))=
)))
+
+          (define (decode-query count bv pos)
+            (if (> count 0)
+                (let* ((result (decode-domain bv pos))
+                       (domain (get-val result))
+                       (npos (get-pos result))
+                       (qtype (bytevector-u16-ref bv npos (endianness big)=
))
+                       (qclass (bytevector-u16-ref bv (+ npos 2) (endianne=
ss big)))
+                       (q (decode-query (- count 1) bv (+ npos 4))))
+                  (make-pos-val (get-pos q)
+                    (cons (make-query domain qtype qclass) (get-val q))))
+                (make-pos-val pos '())))
+
+          (define (decode-ans count bv pos)
+            (if (> count 0)
+                (let* ((result (decode-domain bv pos))
+                       (domain (get-val result))
+                       (npos (get-pos result))
+                       (type (bytevector-u16-ref bv npos (endianness big)))
+                       (class (bytevector-u16-ref bv (+ npos 2) (endiannes=
s big)))
+                       (ttl (bytevector-u32-ref bv (+ npos 4) (endianness =
big)))
+                       (rdlength (bytevector-u16-ref bv (+ npos 8) (endian=
ness big)))
+                       (data (make-bytevector rdlength))
+                       (q (decode-ans (- count 1) bv (+ npos 10 rdlength))=
))
+                  (bytevector-copy! bv (+ npos 10)
+                                    data 0 rdlength)
+                  (make-pos-val (get-pos q)
+                    (cons (make-dns-record domain type class ttl data) (ge=
t-val q))))
+                (make-pos-val pos '())))
+
+          (define (analyze-answer bv)
+            (let* ((len (bytevector-u16-ref bv 0 (endianness big)))
+                   (ans-id (bytevector-u16-ref bv 2 (endianness big)))
+                   (h1 (bytevector-u8-ref bv 4))
+                   (h2 (bytevector-u8-ref bv 5))
+                   (rcode (bitwise-and h2 15))
+                   (qdcount (bytevector-u16-ref bv 6 (endianness big)))
+                   (ancount (bytevector-u16-ref bv 8 (endianness big)))
+                   (nscount (bytevector-u16-ref bv 10 (endianness big)))
+                   (arcount (bytevector-u16-ref bv 12 (endianness big)))
+                   (pos 14)
+                   (query-result (decode-query qdcount bv pos))
+                   (answer-result (decode-ans ancount bv (get-pos query-re=
sult)))
+                   (nameserver-result (decode-ans nscount bv pos))
+                   (additional-result (decode-ans arcount bv pos)))
+              (make-dns-query
+                (append (if (eq? 0 (bitwise-and h1 4)) '() '(AA))
+                        (if (eq? 0 (bitwise-and h1 2)) '() '(TC))
+                    (if (eq? 0 (bitwise-and h1 1)) '() '(RD))
+                    (if (eq? 0 (bitwise-and h2 128)) '() '(RA)))
+                (get-val query-result) (get-val answer-result)
+                (get-val nameserver-result) (get-val additional-result))))
+
+          (define (make-ipv4 bv pos)
+            (if (eq? (+ pos 1) (bytevector-length bv))
+                (number->string (bytevector-u8-ref bv pos))
+                (string-append
+                  (number->string (bytevector-u8-ref bv pos)) "."
+                  (make-ipv4 bv (+ pos 1)))))
+
+          (define (make-ipv6 bv pos)
+            (let ((component (with-output-to-string
+                               (lambda _
+                                 (format #t "~x"
+                                         (bytevector-u16-ref
+                                           bv pos (endianness big)))))))
+              (if (eq? (+ pos 1) (bytevector-length bv))
+                  component
+                  (string-append
+                    component ":" (make-ipv6 bv (+ pos 1))))))
+
+          (define (get-addr-v4 q)
+            (let ((bv (dns-record-rdata (car (dns-query-answers q)))))
+              (make-ipv4 bv 0)))
+
+          (define (get-addr-v6 q)
+            (let ((bv (dns-record-rdata (car (dns-query-answers q)))))
+              (make-ipv6 bv 0)))
+
+          (define (resolv host port type domain)
+            (let* ((ans (run-query host port type domain))
+                   (q (analyze-answer ans)))
+              (match type
+                ("A" (get-addr-v4 q))
+                ("AAAA" (get-addr-v6 q)))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "knot")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'knot)
+                #t)
+             marionette))
+
+          (test-eq "get the correct answer"
+            #$%ip4-addr
+            (begin
+              (format #t "test:\n")
+              (let* ((request (make-request "A" "mail.guix-test.org"))
+                     (dns (socket AF_INET SOCK_STREAM 0))
+                     (addr (make-socket-address AF_INET INADDR_LOOPBACK 10=
53)))
+                (display request)
+                (newline)
+                (connect dns addr)
+                (display request)
+                (newline)
+                (put-bytevector dns request)
+                (display request)
+                (newline)
+                (display (get-bytevector-n dns 500))
+                (newline))
+              (display (run-query INADDR_LOOPBACK 1053 "A" "mail.guix-test=
.org"))
+              (newline)
+              (display (resolv INADDR_LOOPBACK 1053 "A" "mail.guix-test.or=
g"))
+              (newline)
+              (resolv INADDR_LOOPBACK 1053 "A" "mail.guix-test.org")))
+
+          (test-end)
+          (exit (=3D (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "knot-test" test))
+
+(define %test-knot
+  (system-test
+   (name "knot")
+   (description "Send a DNS=C2=A0request to a running Knot server.")
+   (value (run-knot-test))))
--=20
2.14.1


--MP_/KUud_29NR7r7cA7.9Xmlrfw--




Acknowledgement sent to Julien Lepiller <julien@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#28055; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Mon, 19 Mar 2018 08:30:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.