From 548c4d0b2c252f8c4c424c41983185fa3496d776 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 30 May 2008 07:31:20 -0500
Subject: [PATCH] Add dns.forwarding
---
extra/dns/forwarding/forwarding.factor | 91 ++++++++++++++++++++++++++
1 file changed, 91 insertions(+)
create mode 100644 extra/dns/forwarding/forwarding.factor
diff --git a/extra/dns/forwarding/forwarding.factor b/extra/dns/forwarding/forwarding.factor
new file mode 100644
index 0000000000..5da04e25b6
--- /dev/null
+++ b/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 ;
\ No newline at end of file