11 import Control.Monad.Trans
13 import Database.HaskellDB as DB
14 import qualified DDNS.DB.Zones as Zones
15 import Network.DNS.Message
16 import System.Console.Haskeline
19 listZones :: Database -> IO [DomainName]
21 = do rows <- query db $ do t <- table Zones.zones
22 project (Zones.zone << t!Zones.zone)
23 return $ map (read . (!Zones.zone)) rows
25 completeZoneName :: MonadIO m => Database -> CompletionFunc m
27 = completeWord Nothing "" $ \ prefix ->
28 do zones <- liftM (map show) $ liftIO $ listZones db
29 return $ produceCands zones prefix
31 produceCands :: [String] -> String -> [Completion]
32 produceCands zones prefix
33 = let cands = filter (prefix `isPrefixOf`) zones
34 comps = map mkComp cands
38 mkComp :: String -> Completion
46 getZone :: Database -> DomainName -> IO (Maybe SOAFields)
48 = do rows <- query db $
49 do t <- table Zones.zones
50 restrict (t!Zones.zone .==. constant (show name))
53 [r] -> return $ Just SOAFields {
54 soaMasterNameServer = read $ r!Zones.ns
55 , soaResponsibleMailbox = read $ r!Zones.owner
56 , soaSerialNumber = fromIntegral $ r!Zones.serial
57 , soaRefreshInterval = fromIntegral $ r!Zones.refresh
58 , soaRetryInterval = fromIntegral $ r!Zones.retry
59 , soaExpirationLimit = fromIntegral $ r!Zones.expire
60 , soaMinimumTTL = fromIntegral $ r!Zones.minTTL
64 putZone :: Database -> DomainName -> SOAFields -> IO ()
67 do old <- getZone db name
70 -> if soaSerialNumber old' == soaSerialNumber soa - 1 then
71 -- Succeeded at optimistic locking
74 fail "putZone: detected a conflict. please retry it."
79 = DB.update db Zones.zones
80 (\ r -> r!Zones.zone .==. constant (show name))
81 (\ _ -> Zones.ns << constant (show $ soaMasterNameServer soa) #
82 Zones.owner << constant (show $ soaResponsibleMailbox soa) #
83 Zones.serial << constant (fromIntegral $ soaSerialNumber soa) #
84 Zones.refresh << constant (fromIntegral $ soaRefreshInterval soa) #
85 Zones.retry << constant (fromIntegral $ soaRetryInterval soa) #
86 Zones.expire << constant (fromIntegral $ soaExpirationLimit soa) #
87 Zones.minTTL << constant (fromIntegral $ soaMinimumTTL soa) )
90 = DB.insert db Zones.zones
91 ( Zones.zone <<- show name #
92 Zones.ns <<- show (soaMasterNameServer soa) #
93 Zones.owner <<- show (soaResponsibleMailbox soa) #
94 Zones.serial <<- fromIntegral (soaSerialNumber soa) #
95 Zones.refresh <<- fromIntegral (soaRefreshInterval soa) #
96 Zones.retry <<- fromIntegral (soaRetryInterval soa) #
97 Zones.expire <<- fromIntegral (soaExpirationLimit soa) #
98 Zones.minTTL <<- fromIntegral (soaMinimumTTL soa) )