dns.forwarding: Fix bug (cache-message crashes for nx names)

diff --git a/extra/dns/forwarding/forwarding.factor b/extra/dns/forwarding/forwarding.factor
index 31037c477a5120fb56983153d119e3e3055ab90b..6d4fece9490fe47341bb51d010d176fb2d895b13 100644 (file)
--- a/extra/dns/forwarding/forwarding.factor
+++ b/extra/dns/forwarding/forwarding.factor
@@ -62,12 +62,35 @@ IN: dns.forwarding
 : message-soa ( message -- rr/soa )
   authority-section>> [ type>> SOA = ] filter first ;
 
+! :: cache-message ( MSG -- msg )
+!    MSG rcode>> NAME-ERROR =
+!      [
+!        [let | NAME [ MSG message-query name>> ]
+!               TTL  [ MSG message-soa   ttl>>  ] |
+!          NAME TTL cache-non-existent-name
+!        ]
+!      ]
+!    when
+!    MSG answer-section>>     [ cache-add ] each
+!    MSG authority-section>>  [ cache-add ] each
+!    MSG additional-section>> [ cache-add ] each
+!    MSG ;
+
 :: cache-message ( MSG -- msg )
    MSG rcode>> NAME-ERROR =
      [
-       [let | NAME [ MSG message-query name>> ]
-              TTL  [ MSG message-soa   ttl>>  ] |
-         NAME TTL cache-non-existent-name
+       [let | RR/SOA [ MSG
+                         authority-section>>
+                         [ type>> SOA = ] filter
+                       dup empty? [ drop f ] [ first ] if ] |
+         RR/SOA
+           [
+             [let | NAME [ MSG message-query name>> ]
+                    TTL  [ MSG message-soa   ttl>>  ] |
+               NAME TTL cache-non-existent-name
+             ]
+           ]
+         when
        ]
      ]
    when