Update code not to use combinators.cleave
parent
515dcce34a
commit
52d1e4f9b5
|
@ -1,7 +1,7 @@
|
||||||
|
|
||||||
USING: kernel sequences assocs sets locals combinators
|
USING: kernel sequences assocs sets locals combinators
|
||||||
accessors system math math.functions unicode.case prettyprint
|
accessors system math math.functions unicode.case prettyprint
|
||||||
combinators.cleave dns ;
|
combinators.smart dns ;
|
||||||
|
|
||||||
IN: dns.cache.rr
|
IN: dns.cache.rr
|
||||||
|
|
||||||
|
@ -16,7 +16,7 @@ TUPLE: <entry> time data ;
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: make-cache-key ( obj -- key )
|
: make-cache-key ( obj -- key )
|
||||||
{ [ name>> >lower ] [ type>> unparse ] [ class>> unparse ] } 1arr " " join ;
|
[ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,7 @@ USING: kernel byte-arrays combinators strings arrays sequences splitting
|
||||||
destructors
|
destructors
|
||||||
io io.binary io.sockets io.encodings.binary
|
io io.binary io.sockets io.encodings.binary
|
||||||
accessors
|
accessors
|
||||||
combinators.cleave
|
combinators.smart
|
||||||
newfx
|
newfx
|
||||||
;
|
;
|
||||||
|
|
||||||
|
@ -145,12 +145,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: query->ba ( query -- ba )
|
: query->ba ( query -- ba )
|
||||||
|
[
|
||||||
{
|
{
|
||||||
[ name>> dn->ba ]
|
[ name>> dn->ba ]
|
||||||
[ type>> type-table of uint16->ba ]
|
[ type>> type-table of uint16->ba ]
|
||||||
[ class>> class-table of uint16->ba ]
|
[ class>> class-table of uint16->ba ]
|
||||||
}
|
} cleave
|
||||||
<arr> concat ;
|
] output>array concat ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -169,6 +170,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: soa->ba ( rdata -- ba )
|
: soa->ba ( rdata -- ba )
|
||||||
|
[
|
||||||
{
|
{
|
||||||
[ mname>> dn->ba ]
|
[ mname>> dn->ba ]
|
||||||
[ rname>> dn->ba ]
|
[ rname>> dn->ba ]
|
||||||
|
@ -177,8 +179,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
[ retry>> uint32->ba ]
|
[ retry>> uint32->ba ]
|
||||||
[ expire>> uint32->ba ]
|
[ expire>> uint32->ba ]
|
||||||
[ minimum>> uint32->ba ]
|
[ minimum>> uint32->ba ]
|
||||||
}
|
} cleave
|
||||||
<arr> concat ;
|
] output>array concat ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -198,6 +200,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: rr->ba ( rr -- ba )
|
: rr->ba ( rr -- ba )
|
||||||
|
[
|
||||||
{
|
{
|
||||||
[ name>> dn->ba ]
|
[ name>> dn->ba ]
|
||||||
[ type>> type-table of uint16->ba ]
|
[ type>> type-table of uint16->ba ]
|
||||||
|
@ -207,12 +210,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
[ type>> ] [ rdata>> ] bi rdata->ba
|
[ type>> ] [ rdata>> ] bi rdata->ba
|
||||||
[ length uint16->ba ] [ ] bi append
|
[ length uint16->ba ] [ ] bi append
|
||||||
]
|
]
|
||||||
}
|
} cleave
|
||||||
<arr> concat ;
|
] output>array concat ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: header-bits-ba ( message -- ba )
|
: header-bits-ba ( message -- ba )
|
||||||
|
[
|
||||||
{
|
{
|
||||||
[ qr>> 15 shift ]
|
[ qr>> 15 shift ]
|
||||||
[ opcode>> opcode-table of 11 shift ]
|
[ opcode>> opcode-table of 11 shift ]
|
||||||
|
@ -222,10 +226,11 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
[ ra>> 7 shift ]
|
[ ra>> 7 shift ]
|
||||||
[ z>> 4 shift ]
|
[ z>> 4 shift ]
|
||||||
[ rcode>> rcode-table of 0 shift ]
|
[ rcode>> rcode-table of 0 shift ]
|
||||||
}
|
} cleave
|
||||||
<arr> sum uint16->ba ;
|
] sum-outputs uint16->ba ;
|
||||||
|
|
||||||
: message->ba ( message -- ba )
|
: message->ba ( message -- ba )
|
||||||
|
[
|
||||||
{
|
{
|
||||||
[ id>> uint16->ba ]
|
[ id>> uint16->ba ]
|
||||||
[ header-bits-ba ]
|
[ header-bits-ba ]
|
||||||
|
@ -237,8 +242,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
[ answer-section>> [ rr->ba ] map concat ]
|
[ answer-section>> [ rr->ba ] map concat ]
|
||||||
[ authority-section>> [ rr->ba ] map concat ]
|
[ authority-section>> [ rr->ba ] map concat ]
|
||||||
[ additional-section>> [ rr->ba ] map concat ]
|
[ additional-section>> [ rr->ba ] map concat ]
|
||||||
}
|
} cleave
|
||||||
<arr> concat ;
|
] output>array concat ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -475,7 +480,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
|
|
||||||
: ask ( message -- message ) dns-server ask-server ;
|
: ask ( message -- message ) dns-server ask-server ;
|
||||||
|
|
||||||
: query->message ( query -- message ) <message> swap {1} >>question-section ;
|
: query->message ( query -- message ) <message> swap 1array >>question-section ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
|
|
||||||
USING: kernel combinators sequences sets math threads namespaces continuations
|
USING: kernel combinators sequences sets math threads namespaces continuations
|
||||||
debugger io io.sockets unicode.case accessors destructors
|
debugger io io.sockets unicode.case accessors destructors
|
||||||
combinators.cleave combinators.short-circuit
|
combinators.short-circuit combinators.smart
|
||||||
newfx fry
|
newfx fry arrays
|
||||||
dns dns.util dns.misc ;
|
dns dns.util dns.misc ;
|
||||||
|
|
||||||
IN: dns.server
|
IN: dns.server
|
||||||
|
@ -16,7 +16,7 @@ SYMBOL: records-var
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: {name-type-class} ( obj -- array )
|
: {name-type-class} ( obj -- array )
|
||||||
{ [ name>> >lower ] [ type>> ] [ class>> ] } <arr> ;
|
[ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ;
|
||||||
|
|
||||||
: rr=query? ( obj obj -- ? ) [ {name-type-class} ] bi@ = ;
|
: rr=query? ( obj obj -- ? ) [ {name-type-class} ] bi@ = ;
|
||||||
|
|
||||||
|
@ -52,9 +52,9 @@ SYMBOL: records-var
|
||||||
|
|
||||||
: rr->rdata-names ( rr -- names/f )
|
: rr->rdata-names ( rr -- names/f )
|
||||||
{
|
{
|
||||||
{ [ dup type>> NS = ] [ rdata>> {1} ] }
|
{ [ dup type>> NS = ] [ rdata>> 1array ] }
|
||||||
{ [ dup type>> MX = ] [ rdata>> exchange>> {1} ] }
|
{ [ dup type>> MX = ] [ rdata>> exchange>> 1array ] }
|
||||||
{ [ dup type>> CNAME = ] [ rdata>> {1} ] }
|
{ [ dup type>> CNAME = ] [ rdata>> 1array ] }
|
||||||
{ [ t ] [ drop f ] }
|
{ [ t ] [ drop f ] }
|
||||||
}
|
}
|
||||||
cond ;
|
cond ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel classes strings quotations words math math.parser arrays
|
USING: kernel classes strings quotations words math math.parser arrays
|
||||||
combinators.cleave
|
combinators.smart
|
||||||
accessors
|
accessors
|
||||||
system prettyprint splitting
|
system prettyprint splitting
|
||||||
sequences combinators sequences.deep
|
sequences combinators sequences.deep
|
||||||
|
@ -58,5 +58,5 @@ DEFER: to-strings
|
||||||
|
|
||||||
: datestamp ( -- string )
|
: datestamp ( -- string )
|
||||||
now
|
now
|
||||||
{ year>> month>> day>> hour>> minute>> } <arr>
|
[ { [ year>> ] [ month>> ] [ day>> ] [ hour>> ] [ minute>> ] } cleave ] output>array
|
||||||
[ pad-00 ] map "-" join ;
|
[ pad-00 ] map "-" join ;
|
||||||
|
|
Loading…
Reference in New Issue