X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=blackboard-dns.git;a=blobdiff_plain;f=DDNS%2FServer%2FEditZone.hs;h=bd62568b014f732f7e5fb81a09c0368fc52bd8ba;hp=44120ebaca7168248752e38defeae6496ea896a4;hb=22ba80d23ad59661c90bd5a77305b16c417b153b;hpb=1abf9ad51c79257c0bce8e134fdd48a2ff0ef373 diff --git a/DDNS/Server/EditZone.hs b/DDNS/Server/EditZone.hs index 44120eb..bd62568 100644 --- a/DDNS/Server/EditZone.hs +++ b/DDNS/Server/EditZone.hs @@ -3,16 +3,55 @@ module DDNS.Server.EditZone ) where -import Control.Monad import DDNS.Utils import DDNS.Zone import Database.HaskellDB +import Data.Maybe +import Network.DNS.Message import System.Console.Haskeline editZone :: Database -> IO () editZone db = do zone <- runInputT (setComplete (completeZoneName db) defaultSettings) $ - do name <- getInputLine' "Which zone do you want to edit (or create?): " - return $ read name - soa <- getZone db zone - print soa + readInputLine' "Which zone do you want to edit (or create?): " + soa <- getZone db zone + ns <- let d = fromMaybe (read $ "ns." ++ show zone) $ fmap soaMasterNameServer soa + in runInputT defaultSettings $ + readInputLineWithDefault + ("Which host is the master name server? (default: " ++ show d ++ "): ") + d + mail <- let d = fromMaybe (read $ "root." ++ show ns) $ fmap soaResponsibleMailbox soa + in runInputT defaultSettings $ + readInputLineWithDefault + ("Which is the mailbox of responsibility? (default: " ++ show d ++ "): ") + d + refr <- let d = fromIntegral $ fromMaybe 3600 $ fmap soaRefreshInterval soa + in runInputT defaultSettings $ + readInputLineWithDefault + ("How many seconds should refresh interval be? (default: " ++ show d ++ "): ") + d + retr <- let d = fromIntegral $ fromMaybe 900 $ fmap soaRetryInterval soa + in runInputT defaultSettings $ + readInputLineWithDefault + ("How many seconds should retry interval be? (default: " ++ show d ++ "): ") + d + expi <- let d = fromIntegral $ fromMaybe 604800 $ fmap soaExpirationLimit soa + in runInputT defaultSettings $ + readInputLineWithDefault + ("How many seconds should expiration limit be? (default: " ++ show d ++ "): ") + d + mint <- let d = fromIntegral $ fromMaybe 3600 $ fmap soaExpirationLimit soa + in runInputT defaultSettings $ + readInputLineWithDefault + ("How many seconds should minimum TTL be? (default: " ++ show d ++ "): ") + d + let soa' = SOAFields { + soaMasterNameServer = ns + , soaResponsibleMailbox = mail + , soaSerialNumber = fromMaybe 0 $ fmap ((+1) . soaSerialNumber) soa + , soaRefreshInterval = refr + , soaRetryInterval = retr + , soaExpirationLimit = expi + , soaMinimumTTL = mint + } + putZone db zone soa'