More liberal notion of expiry, to avoid problems loading saved zones
This commit is contained in:
parent
bd32469757
commit
9473d1e78d
10
zonedb.rkt
10
zonedb.rkt
|
@ -29,7 +29,7 @@
|
||||||
bit-string->zone)
|
bit-string->zone)
|
||||||
|
|
||||||
(define-type RelativeSeconds Real)
|
(define-type RelativeSeconds Real)
|
||||||
(define-type AbsoluteSeconds Nonnegative-Real)
|
(define-type AbsoluteSeconds Real)
|
||||||
(define-predicate absolute-seconds? AbsoluteSeconds)
|
(define-predicate absolute-seconds? AbsoluteSeconds)
|
||||||
|
|
||||||
;; An InfiniteLifetime is an (infinite-lifetime RelativeSeconds), a
|
;; An InfiniteLifetime is an (infinite-lifetime RelativeSeconds), a
|
||||||
|
@ -60,7 +60,7 @@
|
||||||
|
|
||||||
(: current-inexact-seconds : -> AbsoluteSeconds)
|
(: current-inexact-seconds : -> AbsoluteSeconds)
|
||||||
(define (current-inexact-seconds)
|
(define (current-inexact-seconds)
|
||||||
(cast (/ (current-inexact-milliseconds) 1000.0) AbsoluteSeconds))
|
(/ (current-inexact-milliseconds) 1000.0))
|
||||||
|
|
||||||
(: still-valid? : Expiry AbsoluteSeconds -> Boolean)
|
(: still-valid? : Expiry AbsoluteSeconds -> Boolean)
|
||||||
(define (still-valid? expiry now)
|
(define (still-valid? expiry now)
|
||||||
|
@ -304,5 +304,7 @@
|
||||||
([ (rr0 :: (t:rr empty-packet)) (= 1) (ttl :: bits 32) (rest :: binary) ]
|
([ (rr0 :: (t:rr empty-packet)) (= 1) (ttl :: bits 32) (rest :: binary) ]
|
||||||
(loop ((incorporate-rr #f) (struct-copy rr rr0 [ttl ttl]) db) rest))
|
(loop ((incorporate-rr #f) (struct-copy rr rr0 [ttl ttl]) db) rest))
|
||||||
([ (rr0 :: (t:rr empty-packet)) (= 0) (expirytime :: bits 32) (rest :: binary) ]
|
([ (rr0 :: (t:rr empty-packet)) (= 0) (expirytime :: bits 32) (rest :: binary) ]
|
||||||
(define new-ttl (cast (exact-floor (- expirytime now)) Nonnegative-Integer))
|
(define new-ttl (exact-floor (- expirytime now)))
|
||||||
(loop ((incorporate-rr now) (struct-copy rr rr0 [ttl new-ttl]) db) rest)))))
|
(if (negative? new-ttl)
|
||||||
|
(loop db rest)
|
||||||
|
(loop ((incorporate-rr now) (struct-copy rr rr0 [ttl new-ttl]) db) rest))))))
|
||||||
|
|
Loading…
Reference in New Issue