Merge branch 'master' of git://factorcode.org/git/factor

core/generator/fixup/fixup-docs.factor

@@ -5,10 +5,6 @@ HELP: frame-required
 { $values { "n" "a non-negative integer" } }
 { $description "Notify the code generator that the currently compiling code block needs a stack frame with room for at least " { $snippet "n" } " parameters." } ;
 
-HELP: (rel-fixup)
-{ $values { "arg" integer } { "class" "a relocation class" } { "type" "a relocation type" } { "offset" integer } { "byte-array" byte-array } }
-{ $description "Creates a relocation instruction for the VM's runtime compiled code linker." } ;
-
 HELP: add-literal
 { $values { "obj" object } { "n" integer } }
 { $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;

extra/dns/forwarding/forwarding.factor

@@ -0,0 +1,91 @@
+
+USING: kernel
+       combinators
+       vectors
+       io.sockets
+       accessors
+       newfx
+       dns dns.cache ;
+
+IN: dns.forwarding
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! DNS server - caching, forwarding
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (socket) ( -- vec ) V{ f } ;
+
+: socket ( -- socket ) (socket) 1st ;
+
+: init-socket ( -- ) f 5353 <inet4> <datagram> 0 (socket) as-mutate ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (upstream-server) ( -- vec ) V{ f } ;
+
+: upstream-server ( -- ip ) (upstream-server) 1st ;
+
+: set-upstream-server ( ip -- ) 0 (upstream-server) as-mutate ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: query->answer/cache ( query -- rrs/NX/f )
+    {
+      { [ dup type>> CNAME = ] [ cache-get* ] }
+      {
+        [ dup clone CNAME >>type cache-get* vector? ]
+        [
+          dup clone CNAME >>type cache-get* 1st       ! query rr/cname
+          dup rdata>>                                 ! query rr/cname cname
+          >r swap clone r>                            ! rr/cname query cname
+          >>name                                      ! rr/cname query
+          query->answer/cache                         ! rr/cname rrs/NX/f
+            {
+              { [ dup vector? ] [ clone push-on ] }
+              { [ dup NX = ]    [ nip ] }
+              { [ dup f = ]     [ nip ] }
+            }
+          cond
+        ]
+      }
+      { [ t ] [ cache-get* ] }
+    }
+  cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: answer-from-cache ( message -- message/f )
+  dup message-query                        ! message query
+  dup query->answer/cache                  ! message query rrs/NX/f
+    {
+      { [ dup f = ]  [ 3drop f ] }
+      { [ dup NX = ] [ 2drop NAME-ERROR >>rcode ] }
+      { [ t ]        [ nip >>answer-section ] }
+    }
+  cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: answer-from-server ( message -- message )
+  upstream-server ask-server
+  cache-message ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: find-answer ( message -- message )
+  dup answer-from-cache dup
+    [ nip ]
+    [ drop answer-from-server ]
+  if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: loop ( -- )
+  socket receive                              ! byte-array addr-spec
+  swap                                        ! addr-spec byte-array
+  parse-message                               ! addr-spec message
+  find-answer                                 ! addr-spec message
+  message->ba                                 ! addr-spec byte-array
+  swap                                        ! byte-array addr-spec
+  socket send
+  loop ;