diff --git a/extra/dns/cache/rr/rr.factor b/extra/dns/cache/rr/rr.factor new file mode 100644 index 0000000000..b9c12786e2 --- /dev/null +++ b/extra/dns/cache/rr/rr.factor @@ -0,0 +1,68 @@ + +USING: kernel sequences assocs sets locals combinators + accessors system math math.functions unicode.case prettyprint + combinators.cleave dns ; + +IN: dns.cache.rr + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: time data ; + +: now ( -- seconds ) millis 1000.0 / round >integer ; + +: expired? ( -- ? ) time>> now <= ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: make-cache-key ( obj -- key ) + { [ name>> >lower ] [ type>> unparse ] [ class>> unparse ] } 1arr " " join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cache ( -- table ) H{ } ; + +: cache-at ( obj -- ent ) make-cache-key cache at ; +: cache-delete ( obj -- ) make-cache-key cache delete-at ; +: cache-set-at ( ent obj -- ) make-cache-key cache set-at ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-get ( OBJ -- rrs/f ) + [let | ENT [ OBJ cache-at ] | + { + { [ ENT f = ] [ f ] } + { [ ENT expired? ] [ OBJ cache-delete f ] } + { + [ t ] + [ + [let | NAME [ OBJ name>> ] + TYPE [ OBJ type>> ] + CLASS [ OBJ class>> ] + TTL [ now ENT time>> - ] | + ENT data>> + [| RDATA | T{ rr f NAME TYPE CLASS TTL RDATA } ] + map + ] + ] + } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-add ( RR -- ) + [let | ENT [ RR cache-at ] + TIME [ RR ttl>> now + ] + RDATA [ RR rdata>> ] | + { + { [ ENT f = ] [ T{ f TIME V{ RDATA } } RR cache-set-at ] } + { [ ENT expired? ] [ RR cache-delete RR cache-add ] } + { [ t ] [ TIME ENT (>>time) RDATA ENT data>> adjoin ] } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +