io io.binary io.sockets io.encodings.binary
accessors
combinators.smart
- newfx
+ assocs
;
IN: dns
: ip->ba ( ip -- ba ) "." split [ string>number ] map >byte-array ;
-: ipv6->ba ( ip -- ba ) ":" split [ 16 base> ] map [ 2 >be ] map concat ;
+: ipv6->ba ( ip -- ba ) ":" split [ hex> ] map [ 2 >be ] map concat ;
: label->ba ( label -- ba ) [ >byte-array ] [ length ] bi prefix ;
[
{
[ name>> dn->ba ]
- [ type>> type-table of uint16->ba ]
- [ class>> class-table of uint16->ba ]
+ [ type>> type-table at uint16->ba ]
+ [ class>> class-table at uint16->ba ]
} cleave
] output>array concat ;
[
{
[ name>> dn->ba ]
- [ type>> type-table of uint16->ba ]
- [ class>> class-table of uint16->ba ]
+ [ type>> type-table at uint16->ba ]
+ [ class>> class-table at uint16->ba ]
[ ttl>> uint32->ba ]
[
[ type>> ] [ rdata>> ] bi rdata->ba
[
{
[ qr>> 15 shift ]
- [ opcode>> opcode-table of 11 shift ]
+ [ opcode>> opcode-table at 11 shift ]
[ aa>> 10 shift ]
[ tc>> 9 shift ]
[ rd>> 8 shift ]
[ ra>> 7 shift ]
[ z>> 4 shift ]
- [ rcode>> rcode-table of 0 shift ]
+ [ rcode>> rcode-table at 0 shift ]
} cleave
] sum-outputs uint16->ba ;
: bit-test ( a b -- ? ) bitand 0 = not ;
-: pointer? ( ba i -- ? ) get-single BIN: 11000000 bit-test ;
+: pointer? ( ba i -- ? ) get-single 0b11000000 bit-test ;
-: pointer ( ba i -- val ) get-double BIN: 0011111111111111 bitand ;
+: pointer ( ba i -- val ) get-double 0b0011111111111111 bitand ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ get-name ]
[
skip-name
- [ 0 + get-double type-table key-of ]
- [ 2 + get-double class-table key-of ]
+ [ 0 + get-double type-table value-at ]
+ [ 2 + get-double class-table value-at ]
2bi
]
2bi query boa ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: get-ipv6 ( ba i -- ip )
- dup 16 + subseq 2 group [ be> 16 >base ] map ":" join ;
+ dup 16 + subseq 2 group [ be> >hex ] map ":" join ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[
skip-name
{
- [ 0 + get-double type-table key-of ]
- [ 2 + get-double class-table key-of ]
+ [ 0 + get-double type-table value-at ]
+ [ 2 + get-double class-table value-at ]
[ 4 + get-quad ]
- [ [ 10 + ] [ get-double type-table key-of ] 2bi get-rdata ]
+ [ [ 10 + ] [ get-double type-table value-at ] 2bi get-rdata ]
}
2cleave
]
: get-header-bits ( ba i -- qr opcode aa tc rd ra z rcode )
get-double
{
- [ 15 >> BIN: 1 bitand ]
- [ 11 >> BIN: 111 bitand opcode-table key-of ]
- [ 10 >> BIN: 1 bitand ]
- [ 9 >> BIN: 1 bitand ]
- [ 8 >> BIN: 1 bitand ]
- [ 7 >> BIN: 1 bitand ]
- [ 4 >> BIN: 111 bitand ]
- [ BIN: 1111 bitand rcode-table key-of ]
+ [ 15 >> 0b1 bitand ]
+ [ 11 >> 0b111 bitand opcode-table value-at ]
+ [ 10 >> 0b1 bitand ]
+ [ 9 >> 0b1 bitand ]
+ [ 8 >> 0b1 bitand ]
+ [ 7 >> 0b1 bitand ]
+ [ 4 >> 0b111 bitand ]
+ [ 0b1111 bitand rcode-table value-at ]
}
cleave ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: message-query ( message -- query ) question-section>> 1st ;
+: message-query ( message -- query ) question-section>> first ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fully-qualified ( name -- name )
{
{ [ dup empty? ] [ "." append ] }
- { [ dup peek CHAR: . = ] [ ] }
+ { [ dup last CHAR: . = ] [ ] }
{ [ t ] [ "." append ] }
}
cond ;