syndicate-lang
/
racket-dns-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

More liberal notion of expiry, to avoid problems loading saved zones

This commit is contained in:
Tony Garnock-Jones 2013-03-20 11:00:46 -04:00
parent bd32469757
commit 9473d1e78d
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
zonedb.rkt
View File

@ -29,7 +29,7 @@
bit-string->zone)
(define-type RelativeSeconds Real)
(define-type AbsoluteSeconds Nonnegative-Real)
(define-type AbsoluteSeconds Real)
(define-predicate absolute-seconds? AbsoluteSeconds)
;; An InfiniteLifetime is an (infinite-lifetime RelativeSeconds), a
@ -60,7 +60,7 @@
(: current-inexact-seconds : -> AbsoluteSeconds)
(define (current-inexact-seconds)
(cast (/ (current-inexact-milliseconds) 1000.0) AbsoluteSeconds))
(/ (current-inexact-milliseconds) 1000.0))
(: still-valid? : Expiry AbsoluteSeconds -> Boolean)
(define (still-valid? expiry now)
@ -304,5 +304,7 @@
([ (rr0 :: (t:rr empty-packet)) (= 1) (ttl :: bits 32) (rest :: binary) ]
(loop ((incorporate-rr #f) (struct-copy rr rr0 [ttl ttl]) db) rest))
([ (rr0 :: (t:rr empty-packet)) (= 0) (expirytime :: bits 32) (rest :: binary) ]
(define new-ttl (cast (exact-floor (- expirytime now)) Nonnegative-Integer))
(loop ((incorporate-rr now) (struct-copy rr rr0 [ttl new-ttl]) db) rest)))))
(define new-ttl (exact-floor (- expirytime now)))
(if (negative? new-ttl)
(loop db rest)
(loop ((incorporate-rr now) (struct-copy rr rr0 [ttl new-ttl]) db) rest))))))