module Propellor.Property.Network where

import Propellor.Base
import Propellor.Property.File

import Data.Char

type Interface = String

-- | Options to put in a stanza of an ifupdown interfaces file.
type InterfaceOptions = [(String, String)]

ifUp :: Interface -> Property DebianLike
ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
        `assume` MadeChange

-- | Resets /etc/network/interfaces to a clean and empty state,
-- containing just the standard loopback interface, and with
-- interfacesD enabled.
--
-- This can be used as a starting point to defining other interfaces.
--
-- No interfaces are brought up or down by this property.
cleanInterfacesFile :: Property DebianLike
cleanInterfacesFile = interfaceFileContains interfacesFile
        [ "source-directory interfaces.d"
        , ""
        , "# The loopback network interface"
        , "auto lo"
        , "iface lo inet loopback"
        ]
        []
        `describe` ("clean " ++ interfacesFile)

-- | Configures an interface to get its address via dhcp.
dhcp :: Interface -> Property DebianLike
dhcp iface = dhcp' iface mempty

dhcp' :: Interface -> InterfaceOptions -> Property DebianLike
dhcp' iface options = interfaceFileContains (interfaceDFile iface)
        [ "auto " ++ iface
        , "iface " ++ iface ++ " inet dhcp"
        ] options
        `describe` ("dhcp " ++ iface)
        `requires` interfacesDEnabled

newtype Gateway = Gateway IPAddr

-- | Configures an interface with a static address and gateway.
static :: Interface -> IPAddr -> Maybe Gateway -> Property DebianLike
static iface addr gateway = static' iface addr gateway mempty

static' :: Interface -> IPAddr -> Maybe Gateway -> InterfaceOptions -> Property DebianLike
static' iface addr gateway options =
        interfaceFileContains (interfaceDFile iface) headerlines options'
        `describe` ("static IP address for " ++ iface)
        `requires` interfacesDEnabled
  where
        headerlines =
                [ "auto " ++ iface
                , "iface " ++ iface ++ " " ++ inet ++ " static"
                ]
        options' = catMaybes
                [ Just $ ("address", val addr)
                , case gateway of
                        Just (Gateway gaddr) ->
                                Just ("gateway", val gaddr)
                        Nothing -> Nothing
                ] ++ options
        inet = case addr of
                IPv4 _ -> "inet"
                IPv6 _ -> "inet6"

-- | Writes a static interface file for the specified interface
-- to preserve its current configuration.
--
-- The interface has to be up already. It could have been brought up by
-- DHCP, or by other means. The current ipv4 addresses
-- and routing configuration of the interface are written into the file.
--
-- If the interface file already exists, this property does nothing,
-- no matter its content.
--
-- (ipv6 addresses are not included because it's assumed they come up
-- automatically in most situations.)
preserveStatic :: Interface -> Property DebianLike
preserveStatic iface = tightenTargets $
        check (not <$> doesFileExist f) setup
                `describe` desc
                `requires` interfacesDEnabled
  where
        f = interfaceDFile iface
        desc = "static " ++ iface
        setup :: Property DebianLike
        setup = property' desc $ \o -> do
                ls <- liftIO $ lines <$> readProcess "ip"
                        ["-o", "addr", "show", iface, "scope", "global"]
                stanzas <- liftIO $ concat <$> mapM mkstanza ls
                ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
        mkstanza ipline = case words ipline of
                -- Note that the IP address is written CIDR style, so
                -- the netmask does not need to be specified separately.
                (_:iface':"inet":addr:_) | iface' == iface -> do
                        gw <- getgateway
                        return $ catMaybes
                                [ Just $ "iface " ++ iface ++ " inet static"
                                , Just $ "\taddress " ++ addr
                                , ("\tgateway " ++) <$> gw
                                ]
                _ -> return []
        getgateway = do
                rs <- lines <$> readProcess "ip"
                        ["route", "show", "scope", "global", "dev", iface]
                return $ case words <$> headMaybe rs of
                        Just ("default":"via":gw:_) -> Just gw
                        _ -> Nothing

-- | 6to4 ipv6 connection, should work anywhere
ipv6to4 :: Property DebianLike
ipv6to4 = tightenTargets $ interfaceFileContains (interfaceDFile "sit0")
        [ "auto sit0"
        , "iface sit0 inet6 static"
        ]
        [ ("address", "2002:5044:5531::1")
        , ("netmask", "64")
        , ("gateway", "::192.88.99.1")
        ]
        `describe` "ipv6to4"
        `requires` interfacesDEnabled
        `onChange` ifUp "sit0"

interfacesFile :: FilePath
interfacesFile = "/etc/network/interfaces"

-- | A file in the interfaces.d directory.
interfaceDFile :: Interface -> FilePath
interfaceDFile i = "/etc/network/interfaces.d" </> escapeInterfaceDName i

-- | /etc/network/interfaces.d/ files have to match -- ^[a-zA-Z0-9_-]+$
-- see "man 5 interfaces"
escapeInterfaceDName :: Interface -> FilePath
escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))

-- | Ensures that files in the the interfaces.d directory are used.
-- interfacesDEnabled :: Property DebianLike
interfacesDEnabled :: Property DebianLike
interfacesDEnabled = tightenTargets $
        containsLine interfacesFile "source-directory interfaces.d"
                `describe` "interfaces.d directory enabled"

interfaceFileContains :: FilePath -> [String] -> InterfaceOptions -> Property DebianLike
interfaceFileContains f headerlines options = tightenTargets $ hasContent f $
        warning : headerlines ++ map fmt options
  where
        fmt (k, v) = "\t" ++ k ++ " " ++ v
        warning = "# Deployed by propellor, do not edit."