From: Eugene Crosser Date: Mon, 21 Apr 2014 13:59:04 +0000 (+0400) Subject: use current time to synthesize zone version in the SOA record X-Git-Tag: 0.9.0.0~23 X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=commitdiff_plain;h=17e4165f2d7cd287e2d49ef2ceac494f9236fd61 use current time to synthesize zone version in the SOA record --- diff --git a/PowerDns.hs b/PowerDns.hs index 0b05386..457cdca 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -99,8 +99,8 @@ pdnsReport :: String -> String pdnsReport err = "LOG\tError: " ++ err ++ "\nFAIL\n" -- | Produce answer to the Q request -pdnsOutQ :: Int -> Int -> String -> RRType -> Either String NmcDom -> String -pdnsOutQ ver id name rrt edom = +pdnsOutQ :: Int -> Int -> Int -> String -> RRType -> Either String NmcDom -> String +pdnsOutQ ver id gen name rrt edom = let rrl = case rrt of RRTypeANY -> [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME @@ -113,11 +113,11 @@ pdnsOutQ ver id name rrt edom = Left err -> pdnsReport $ err ++ " in the " ++ (show rrt) ++ " query for " ++ name Right dom -> - formatDom ver id rrl name dom "END\n" + formatDom ver id gen rrl name dom "END\n" -- | Produce answer to the AXFR request -pdnsOutXfr :: Int -> Int -> String -> Either String NmcDom -> String -pdnsOutXfr ver id name edom = +pdnsOutXfr :: Int -> Int -> Int -> String -> Either String NmcDom -> String +pdnsOutXfr ver id gen name edom = let allrrs = [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS @@ -133,26 +133,26 @@ pdnsOutXfr ver id name edom = Left err -> pdnsReport $ err ++ " in the AXFR request for " ++ name Right dom -> - walkDom (formatDom ver id allrrs) "END\n" name dom + walkDom (formatDom ver id gen allrrs) "END\n" name dom -formatDom ver id rrl name dom acc = - foldr (\x a -> (formatRR ver id name dom x) ++ a) acc rrl +formatDom ver id gen rrl name dom acc = + foldr (\x a -> (formatRR ver id gen name dom x) ++ a) acc rrl -formatRR ver id name dom rrtype = +formatRR ver id gen name dom rrtype = foldr (\x a -> "DATA\t" ++ v3ext ++ name ++ "\tIN\t" ++ (show rrtype) ++ "\t" ++ ttl ++ "\t" ++ (show id) ++ "\t" ++ x ++ "\n" ++ a) - "" $ dataRR rrtype name dom + "" $ dataRR rrtype gen name dom where v3ext = case ver of 3 -> "0\t1\t" _ -> "" ttl = show 3600 -justl accessor _ dom = case accessor dom of +justl accessor _ _ dom = case accessor dom of Nothing -> [] Just xs -> xs -justv accessor _ dom = case accessor dom of +justv accessor _ _ dom = case accessor dom of Nothing -> [] Just x -> [x] @@ -168,10 +168,10 @@ dataRR RRTypeA = justl domIp dataRR RRTypeAAAA = justl domIp6 dataRR RRTypeCNAME = justv domAlias dataRR RRTypeDNAME = justv domTranslate -dataRR RRTypeSOA = \ name dom -> -- FIXME make realistic version field +dataRR RRTypeSOA = \ gen name dom -> let ns = case domNs dom of - Just (x:_) -> x -- FIXME Terminate with a dot? + Just (x:_) -> x _ -> "." email = case domEmail dom of Nothing -> "hostmaster." ++ name ++ "." @@ -185,15 +185,16 @@ dataRR RRTypeSOA = \ name dom -> -- FIXME make realistic version field -- Alternative would be to carry "top-ness" as a parameter through -- all the calls from the very top where we split the fqdn. case splitOn (pack ".") (pack name) of - [_,_] -> [ns ++ " " ++ email ++ " 0 10800 3600 604800 86400"] + [_,_] -> [ns ++ " " ++ email ++ " " ++ (show gen) + ++ " 10800 3600 604800 86400"] _ -> [] -dataRR RRTypeRP = \ _ dom -> +dataRR RRTypeRP = \ _ _ dom -> case domEmail dom of Nothing -> [] Just addr -> [(dotmail addr) ++ " ."] dataRR RRTypeLOC = justv domLoc -dataRR RRTypeNS = justl domNs -- FIXME Terminate with a dot? -dataRR RRTypeDS = \ _ dom -> +dataRR RRTypeNS = justl domNs +dataRR RRTypeDS = \ _ _ dom -> case domDs dom of Nothing -> [] Just dss -> map dsStr dss @@ -203,5 +204,5 @@ dataRR RRTypeDS = \ _ dom -> ++ (show (dsHashType x)) ++ " " ++ (dsHashValue x) -- This only comes into play when data arrived _not_ from a PDNS request: -dataRR (RRTypeError e) = \ _ _ -> +dataRR (RRTypeError e) = \ _ _ _ -> ["; No data for bad request type " ++ e] diff --git a/README.md b/README.md index bac7d26..6a6addc 100644 --- a/README.md +++ b/README.md @@ -120,13 +120,10 @@ recursive resolution of the subdomain tree is enforced for when SOA record is requested. That would invalidate the reason to have caching in the first place. -One possible workaround would be to use some derivative of absolute -time, such as the number of hours elapsed since the epoch, for the -SOA generation count. - -At the time of this writing, `pdns-pipe-nmc` simply reports zero as -the SOA generation count. This leads to stale results until `pdnsd` -is restarted. +One possible workaround, currently implemented in `pdns-pipe-nmc`, is to +use a derivative of absolute time, in our case the number of 10-munute +intervals elapsed since Namecoin was concieved, as the SOA generation +count. ## Getting the Software diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index f638851..8f26fa7 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -6,6 +6,7 @@ import Prelude hiding (lookup, readFile) import System.Environment import System.IO hiding (readFile) import System.IO.Error +import Data.Time.Clock.POSIX import Control.Exception import Text.Show.Pretty hiding (String) import Control.Monad @@ -71,6 +72,12 @@ queryDom queryOp fqdn = "bit":dn:xs -> descendNmcDom queryOp xs $ seedNmcDom dn _ -> return $ Left "Only \".bit\" domain is supported" +-- Number of ten minute intervals elapsed since creation of Namecoin +-- on April 18, 2011. Another option would be to use blockcount +-- but that would require another lookup, and we are cheap. +-- Yet another - to use (const - expires_in) from the lookup. +nmcAge = fmap (\x -> floor ((x - 1303070400) / 600)) getPOSIXTime + -- Main entries mainPdnsNmc = do @@ -111,6 +118,7 @@ mainPdnsNmc = do mainloop = forever $ do l <- io getLine + gen <- io $ nmcAge (count, cache) <- get case pdnsParse ver l of Left e -> io $ putStr $ pdnsReport e @@ -118,7 +126,7 @@ mainPdnsNmc = do case preq of PdnsRequestQ qname qtype id _ _ _ -> do io $ queryDom (queryOpNmc cfg mgr id) qname - >>= putStr . (pdnsOutQ ver count qname qtype) + >>= putStr . (pdnsOutQ ver count gen qname qtype) -- debug io $ putStrLn $ "LOG\tRequest number " ++ (show count) ++ " id: " ++ (show id) @@ -134,40 +142,41 @@ mainPdnsNmc = do pdnsReport ("AXFR for unknown id: " ++ (show xrq)) Just qname -> io $ queryDom (queryOpNmc cfg mgr xrq) qname - >>= putStr . (pdnsOutXfr ver count qname) + >>= putStr . (pdnsOutXfr ver count gen qname) PdnsRequestPing -> io $ putStrLn "END" runStateT mainloop (0, empty) >> return () -- helper for command-line tools -pdnsOut key qt dom = +pdnsOut gen key qt dom = case qt of - "AXFR" -> pdnsOutXfr 1 (-1) key dom - _ -> pdnsOutQ 1 (-1) key (rrType qt) dom + "AXFR" -> pdnsOutXfr 1 (-1) gen key dom + _ -> pdnsOutQ 1 (-1) gen key (rrType qt) dom -- query by key from Namecoin -mainOne key qt = do +mainOne gen key qt = do cfg <- readConfig confFile mgr <- newManager defaultManagerSettings dom <- queryDom (queryOpNmc cfg mgr (-1)) key putStrLn $ ppShow dom - putStr $ pdnsOut key qt dom + putStr $ pdnsOut gen key qt dom -- using file backend for testing json domain data -mainFile key qt = do +mainFile gen key qt = do dom <- queryDom queryOpFile key putStrLn $ ppShow dom - putStr $ pdnsOut key qt dom + putStr $ pdnsOut gen key qt dom -- Entry point main = do args <- getArgs + gen <- nmcAge case args of [] -> mainPdnsNmc - [key, qtype] -> mainOne key qtype - ["-f" ,key, qtype] -> mainFile key qtype + [key, qtype] -> mainOne gen key qtype + ["-f" ,key, qtype] -> mainFile gen key qtype _ -> error $ "usage: empty args, or \"[-f] {|ANY|AXFR}\" (type in caps)"