From 73b0e07277b5b6f3f1d3d78dfea280bee8cd0a8a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 28 May 2008 21:44:02 -0500 Subject: [PATCH 1/4] combinators.lib: Add || variants --- extra/combinators/lib/lib.factor | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 4c4a988935..2c7f2bbb03 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -77,8 +77,21 @@ MACRO: <--&& ( quots -- ) [ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit [ 2nip ] append ; +! or + MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; +MACRO: 0|| ( quots -- ? ) [ [ t ] ] f short-circuit ; + +MACRO: 1|| ( quots -- ? ) + [ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ; + +MACRO: 2|| ( quots -- ? ) + [ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ; + +MACRO: 3|| ( quots -- ? ) + [ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ifte ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From ce4f8871bf5464495d400440d585bc85d713fd82 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 28 May 2008 23:08:54 -0500 Subject: [PATCH 2/4] dns: Add support for AAAA records --- extra/dns/dns.factor | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index 560db69bb2..f10bdea0bf 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -38,7 +38,7 @@ TUPLE: message ! TYPE ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SYMBOLS: A NS MD MF CNAME SOA MB MG MR NULL WKS PTR HINFO MINFO MX TXT ; +SYMBOLS: A NS MD MF CNAME SOA MB MG MR NULL WKS PTR HINFO MINFO MX TXT AAAA ; : type-table ( -- table ) { @@ -58,6 +58,7 @@ SYMBOLS: A NS MD MF CNAME SOA MB MG MR NULL WKS PTR HINFO MINFO MX TXT ; { MINFO 14 } { MX 15 } { TXT 16 } + { AAAA 28 } } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -126,6 +127,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED : ip->ba ( ip -- ba ) "." split [ string>number ] map >byte-array ; +: ipv6->ba ( ip -- ba ) ":" split [ 16 base> ] map [ 2 >be ] map concat ; + : label->ba ( label -- ba ) [ >byte-array ] [ length ] bi prefix ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -330,6 +333,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED : get-ip ( ba i -- ip ) dup 4 + subseq >array [ number>string ] map "." join ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-ipv6 ( ba i -- ip ) + dup 16 + subseq 2 group [ be> 16 >base ] map ":" join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : get-rdata ( ba i type -- rdata ) { { CNAME [ get-name ] } @@ -338,6 +348,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED { MX [ get-mx ] } { SOA [ get-soa ] } { A [ get-ip ] } + { AAAA [ get-ipv6 ] } } case ; From e14a9ec0fb35bc16a51cba6de45de4dbb71377ad Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 28 May 2008 23:09:19 -0500 Subject: [PATCH 3/4] dns.cache: cache-get* word --- extra/dns/cache/cache.factor | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/extra/dns/cache/cache.factor b/extra/dns/cache/cache.factor index 75bbf9de9d..aeba35f29d 100644 --- a/extra/dns/cache/cache.factor +++ b/extra/dns/cache/cache.factor @@ -68,7 +68,7 @@ SYMBOL: NX : expired? ( entry -- ? ) time>> time->ttl 0 <= ; -: cache-get ( query -- result ) +: cache-get* ( query -- rrs/NX/f ) dup table-get ! query result { { [ dup f = ] [ 2drop f ] } ! not in the cache @@ -80,6 +80,15 @@ SYMBOL: NX ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +ERROR: name-error name ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cache-get ( query -- rrs/f ) + dup cache-get* dup NX = [ drop name>> name-error ] [ nip ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : rr->entry ( rr -- entry ) [ ttl>> ttl->time ] [ rdata>> {1} >vector ] bi entry boa ; From 5a2ff64c3f0768829920aaae1eced721e54557d6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 28 May 2008 23:12:01 -0500 Subject: [PATCH 4/4] Add dns.recursive for recursive queries --- extra/dns/recursive/recursive.factor | 182 +++++++++++++++++++++++++++ 1 file changed, 182 insertions(+) create mode 100644 extra/dns/recursive/recursive.factor diff --git a/extra/dns/recursive/recursive.factor b/extra/dns/recursive/recursive.factor new file mode 100644 index 0000000000..6fe8ec96da --- /dev/null +++ b/extra/dns/recursive/recursive.factor @@ -0,0 +1,182 @@ + +USING: kernel continuations + combinators + sequences + random + unicode.case + accessors symbols + combinators.lib combinators.cleave + newfx + dns dns.cache ; + +IN: dns.recursive + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: root-dns-servers ( -- servers ) + { + "192.5.5.241" + "192.112.36.4" + "128.63.2.53" + "192.36.148.17" + "192.58.128.30" + "193.0.14.129" + "199.7.83.42" + "202.12.27.33" + "198.41.0.4" + } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cache-message ( message -- message ) + dup dup rcode>> NAME-ERROR = + [ + [ question-section>> 1st ] + [ authority-section>> [ type>> SOA = ] filter random ttl>> ] + bi + cache-nx + ] + [ + { + [ answer-section>> cache-add-rrs ] + [ authority-section>> cache-add-rrs ] + [ additional-section>> cache-add-rrs ] + } + cleave + ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: query->message ( query -- message ) ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: {name-type-class} ( obj -- seq ) + [ name>> >lower ] [ type>> ] [ class>> ] tri {3} ; + +: rr=query? ( rr query -- ? ) [ {name-type-class} ] bi@ = ; + +: rr-filter ( rrs query -- rrs ) [ rr=query? ] curry filter ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: message-query ( message -- query ) question-section>> 1st ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: answer-hits ( message -- rrs ) + [ answer-section>> ] [ message-query ] bi rr-filter ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: name-hits ( message -- rrs ) + [ answer-section>> ] [ message-query clone A >>type ] bi rr-filter ; + +: cname-hits ( message -- rrs ) + [ answer-section>> ] [ message-query clone CNAME >>type ] bi rr-filter ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: authority-hits ( message -- rrs ) + authority-section>> [ type>> NS = ] filter ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOLS: ANSWERED NO-NAME-SERVERS UNCLASSIFIED ; + +: classify-message ( message -- symbol ) + { + { [ dup rcode>> NAME-ERROR = ] [ drop NAME-ERROR ] } + { [ dup rcode>> SERVER-FAILURE = ] [ drop SERVER-FAILURE ] } + { [ dup answer-hits empty? not ] [ drop ANSWERED ] } + { [ dup cname-hits empty? not ] [ drop CNAME ] } + { [ dup authority-hits empty? ] [ drop NO-NAME-SERVERS ] } + { [ t ] [ drop UNCLASSIFIED ] } + } + cond ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: name->ip + +! : name->ip/f ( name -- ip/f ) [ name->ip ] [ drop f ] recover ; + +! : extract-ns-ips ( message -- ips ) +! authority-hits [ rdata>> name->ip/f ] map [ ] filter ; + +: extract-ns-ips ( message -- ips ) + authority-hits [ rdata>> name->ip ] map [ ] filter ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: recursive-query ( query servers -- message ) + dup random ! query servers server + pick query->message 0 >>rd ! query servers server message + over ask-server ! query servers server message + cache-message ! query servers server message + dup classify-message ! query servers server message sym + { + { NAME-ERROR [ -roll 3drop ] } + { ANSWERED [ -roll 3drop ] } + { CNAME [ -roll 3drop ] } + { NO-NAME-SERVERS [ -roll 3drop ] } + { + SERVER-FAILURE + [ + -roll ! message query servers server + remove ! message query servers + dup empty? + [ 2drop ] + [ rot drop recursive-query ] + if + ] + } + [ ! query servers server message sym + drop nip nip ! query message + extract-ns-ips ! query ips + recursive-query + ] + } + case ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: canonical/cache ( name -- name ) + dup CNAME IN query boa cache-get dup [ nip 1st rdata>> ] [ drop ] if ; + +: name->ip/cache ( name -- ip/f ) + canonical/cache + A IN query boa cache-get dup [ random rdata>> ] [ ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: name-hits? ( message -- message ? ) dup name-hits empty? not ; +: cname-hits? ( message -- message ? ) dup cname-hits empty? not ; + +: name->ip/server ( name -- ip-or-f ) + A IN query boa root-dns-servers recursive-query ! message + { + { [ name-hits? ] [ name-hits random rdata>> ] } + { [ cname-hits? ] [ cname-hits random rdata>> name->ip ] } + { [ t ] [ drop f ] } + } + cond ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : name->ip ( name -- ip ) +! { [ name->ip/cache ] [ name->ip/server ] [ name-error ] } 1|| ; + +: name->ip ( name -- ip ) + dup name->ip/cache dup + [ nip ] + [ + drop dup name->ip/server dup + [ nip ] + [ drop name-error ] + if + ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!