diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,12 @@ +propellor (1.2.1) unstable; urgency=medium + + * Added CryptPassword to PrivDataField, for password hashes as produced + by crypt(3). + * User.hasPassword and User.hasSomePassword will now use either + a CryptPassword or a Password from privdata, depending on which is set. + + -- Joey Hess Wed, 17 Dec 2014 16:30:44 -0400 + propellor (1.2.0) unstable; urgency=medium * Display a warning when ensureProperty is used on a property which has diff --git a/config-joey.hs b/config-joey.hs --- a/config-joey.hs +++ b/config-joey.hs @@ -76,7 +76,7 @@ & Apt.buildDep ["git-annex"] `period` Daily & Docker.configured ! Docker.docked gitAnnexAndroidDev - & website "foo" + ! website "foo" website :: String -> RevertableProperty website hn = Apache.siteEnabled hn apachecfg diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +propellor (1.2.1) unstable; urgency=medium + + * Added CryptPassword to PrivDataField, for password hashes as produced + by crypt(3). + * User.hasPassword and User.hasSomePassword will now use either + a CryptPassword or a Password from privdata, depending on which is set. + + -- Joey Hess Wed, 17 Dec 2014 16:30:44 -0400 + propellor (1.2.0) unstable; urgency=medium * Display a warning when ensureProperty is used on a property which has diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 1.2.0 +Version: 1.2.1 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -48,23 +48,49 @@ -- being used, which is necessary to ensure that the privdata is sent to -- the remote host by propellor. withPrivData - :: IsContext c - => PrivDataField + :: (IsContext c, IsPrivDataSource s) + => s -> c -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property) -> Property -withPrivData field c mkprop = addinfo $ mkprop $ \a -> - maybe missing a =<< get +withPrivData s = withPrivData' snd [s] + +-- Like withPrivData, but here any of a list of PrivDataFields can be used. +withSomePrivData + :: (IsContext c, IsPrivDataSource s) + => [s] + -> c + -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property) + -> Property +withSomePrivData = withPrivData' id + +withPrivData' + :: (IsContext c, IsPrivDataSource s) + => ((PrivDataField, PrivData) -> v) + -> [s] + -> c + -> (((v -> Propellor Result) -> Propellor Result) -> Property) + -> Property +withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a -> + maybe missing (a . feed) =<< getM get fieldlist where - get = do + get field = do context <- mkHostContext hc <$> asks hostName - liftIO $ getLocalPrivData field context + maybe Nothing (\privdata -> Just (field, privdata)) + <$> liftIO (getLocalPrivData field context) missing = do Context cname <- mkHostContext hc <$> asks hostName - warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")" - liftIO $ putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'" + warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")" + liftIO $ putStrLn $ "Fix this by running:" + liftIO $ forM_ srclist $ \src -> do + putStrLn $ " propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "'" + maybe noop (\d -> putStrLn $ " " ++ d) (describePrivDataSource src) + putStrLn "" return FailedChange - addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, hc) } } + addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } } + fieldnames = map show fieldlist + fieldset = S.fromList $ zip fieldlist (repeat hc) + fieldlist = map privDataField srclist hc = asHostContext c addPrivDataField :: (PrivDataField, HostContext) -> Property diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -90,7 +90,7 @@ -- | Adds additional sources.list generators. -- -- Note that if a Property needs to enable an apt source, it's better --- to do so via a separate file in /etc/apt/sources.list.d/ +-- to do so via a separate file in stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property stdSourcesList' suite more = setSourcesList (concatMap (\gen -> gen suite) generators) diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -233,7 +233,7 @@ ] modifyFileMode wrapperScript (addModes $ readModes ++ executeModes) --- Work around for http://bugs.debian.org/770217 +-- Work around for makeDevicesTarball :: IO () makeDevicesTarball = do -- TODO append to tarball; avoid writing to /dev diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -63,9 +63,11 @@ configured :: Property configured = prop `requires` installed where - prop = withPrivData DockerAuthentication anyContext $ \getcfg -> + prop = withPrivData src anyContext $ \getcfg -> property "docker configured" $ getcfg $ \cfg -> ensureProperty $ "/root/.dockercfg" `File.hasContent` (lines cfg) + src = PrivDataSourceFileFromCommand DockerAuthentication + "/root/.dockercfg" "docker login" -- | A short descriptive name for a container. -- Should not contain whitespace or other unusual characters, @@ -176,7 +178,7 @@ -- | Tweaks a container to work well with docker. -- -- Currently, this consists of making pam_loginuid lines optional in --- the pam config, to work around https://github.com/docker/docker/issues/5663 +-- the pam config, to work around -- which affects docker 1.2.0. tweaked :: Property tweaked = trivial $ @@ -529,7 +531,7 @@ dockerInfo i = mempty { _dockerinfo = i } -- | The ContainerIdent of a container is written to --- /.propellor-ident inside it. This can be checked to see if +-- inside it. This can be checked to see if -- the container has the same ident later. propellorIdent :: FilePath propellorIdent = "/.propellor-ident" diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -29,7 +29,7 @@ hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property hasPrivContent' writer f context = - withPrivData (PrivFile f) context $ \getcontent -> + withPrivData (PrivDataSourceFile (PrivFile f) f) context $ \getcontent -> property desc $ getcontent $ \privcontent -> ensureProperty $ fileProperty' writer desc (\_oldcontent -> lines privcontent) f diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs --- a/src/Propellor/Property/Gpg.hs +++ b/src/Propellor/Property/Gpg.hs @@ -28,13 +28,14 @@ genflag = do d <- dotDir user return $ d ".propellor-imported-keyid-" ++ keyid - prop = withPrivData GpgKey (Context keyid) $ \getkey -> + prop = withPrivData src (Context keyid) $ \getkey -> property desc $ getkey $ \key -> makeChange $ withHandle StdinHandle createProcessSuccess (proc "su" ["-c", "gpg --import", user]) $ \h -> do fileEncoding h hPutStr h key hClose h + src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a" dotDir :: UserName -> IO FilePath dotDir user = do diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs --- a/src/Propellor/Property/Grub.hs +++ b/src/Propellor/Property/Grub.hs @@ -4,10 +4,10 @@ import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt --- | Eg, hd0,0 or xen/xvda1 +-- | Eg, "hd0,0" or "xen/xvda1" type GrubDevice = String --- | Eg, /dev/sda +-- | Eg, "/dev/sda" type OSDevice = String type TimeoutSecs = Int @@ -51,7 +51,7 @@ -- -- Useful when the VPS's pv-grub is too old to boot a modern kernel image. -- --- http://notes.pault.ag/linode-pv-grub-chainning/ +-- -- -- The rootdev should be in the form "hd0", while the bootdev is in the form -- "xen/xvda". diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs --- a/src/Propellor/Property/Hostname.hs +++ b/src/Propellor/Property/Hostname.hs @@ -7,14 +7,14 @@ -- | Ensures that the hostname is set using best practices. -- --- Configures `/etc/hostname` and the current hostname. +-- Configures and the current hostname. -- --- Configures `/etc/mailname` with the domain part of the hostname. +-- Configures with the domain part of the hostname. -- --- `/etc/hosts` is also configured, with an entry for 127.0.1.1, which is +-- is also configured, with an entry for 127.0.1.1, which is -- standard at least on Debian to set the FDQN. -- --- Also, the `/etc/hosts` 127.0.0.1 line is set to localhost. Putting any +-- Also, the 127.0.0.1 line is set to localhost. Putting any -- other hostnames there is not best practices and can lead to annoying -- messages from eg, apache. sane :: Property @@ -44,7 +44,7 @@ (ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls hasip ip l = headMaybe (words l) == Just ip --- | Makes `/etc/resolv.conf` contain search and domain lines for +-- | Makes contain search and domain lines for -- the domain that the hostname is in. searchDomain :: Property searchDomain = property desc (ensureProperty . go =<< asks hostName) diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -33,10 +33,10 @@ -- the property to. -- -- This property only runs once. The cleanly installed system will have --- a file /etc/propellor-cleaninstall, which indicates it was cleanly +-- a file , which indicates it was cleanly -- installed. -- --- The files from the old os will be left in /old-os +-- The files from the old os will be left in -- -- After the OS is installed, and if all properties of the host have -- been successfully satisfied, the host will be rebooted to properly load @@ -188,13 +188,13 @@ return FailedChange else return NoChange --- | /etc/network/interfaces is configured to bring up the network +-- | is configured to bring up the network -- interface that currently has a default route configured, using -- the same (static) IP address. preserveNetwork :: Property preserveNetwork = undefined -- TODO --- | /etc/resolv.conf is copied the from the old OS +-- | is copied from the old OS preserveResolvConf :: Property preserveResolvConf = check (fileExist oldloc) $ property (newloc ++ " copied from old OS") $ do @@ -204,7 +204,7 @@ newloc = "/etc/resolv.conf" oldloc = oldOSDir ++ newloc --- | Root's .ssh/authorized_keys has added to it any ssh keys that +-- | has added to it any ssh keys that -- were authorized in the old OS. Any other contents of the file are -- retained. preserveRootSshAuthorized :: Property @@ -216,7 +216,7 @@ newloc = "/root/.ssh/authorized_keys" oldloc = oldOSDir ++ newloc --- Removes the old OS's backup from /old-os +-- Removes the old OS's backup from oldOSRemoved :: Confirmation -> Property oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $ go `requires` confirmed "old OS backup removal confirmed" confirmation diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs --- a/src/Propellor/Property/Postfix.hs +++ b/src/Propellor/Property/Postfix.hs @@ -50,7 +50,7 @@ `onChange` cmdProperty "postmap" [f] -- | Run newaliases command, which should be done after changing --- /etc/aliases. +-- . newaliases :: Property newaliases = trivial $ cmdProperty "newaliases" [] diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -90,8 +90,8 @@ -- | Sets a single ssh host key from the privdata. hostKey :: IsContext c => SshKeyType -> c -> Property hostKey keytype context = combineProperties desc - [ installkey (SshPubKey keytype "") (install writeFile ".pub") - , installkey (SshPrivKey keytype "") (install writeFileProtected "") + [ installkey (keysrc ".pub" (SshPubKey keytype "")) (install writeFile ".pub") + , installkey (keysrc "" (SshPrivKey keytype "")) (install writeFileProtected "") ] `onChange` restarted where @@ -104,6 +104,8 @@ if s == key then noChange else makeChange $ writer f key + keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext) + ("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey") -- | Sets up a user with a ssh private key and public key pair from the -- PrivData. diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -227,7 +227,7 @@ ('-':_) -> p _ -> "--" ++ p --- | Bind mounts /etc/resolv.conf from the host into the container. +-- | Bind mounts from the host into the container. -- -- This property is enabled by default. Revert it to disable it. resolvConfed :: RevertableProperty diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -23,7 +23,7 @@ `describe` ("nuked user " ++ user) -- | Only ensures that the user has some password set. It may or may --- not be the password from the PrivData. +-- not be a password from the PrivData. hasSomePassword :: UserName -> Property hasSomePassword user = hasSomePassword' user hostContext @@ -34,22 +34,36 @@ hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $ hasPassword' user context --- | Ensures that a user's password is set to the password from the PrivData. +-- | Ensures that a user's password is set to a password from the PrivData. -- (Will change any existing password.) +-- +-- A user's password can be stored in the PrivData in either of two forms; +-- the full cleartext or a hash. The latter +-- is obviously more secure. hasPassword :: UserName -> Property hasPassword user = hasPassword' user hostContext hasPassword' :: IsContext c => UserName -> c -> Property hasPassword' user context = go `requires` shadowConfig True where - go = withPrivData (Password user) context $ - property (user ++ " has password") . setPassword user + go = withSomePrivData srcs context $ + property (user ++ " has password") . setPassword + srcs = + [ PrivDataSource (CryptPassword user) + "a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'" + , PrivDataSource (Password user) ("a password for " ++ user) + ] -setPassword :: UserName -> ((PrivData -> Propellor Result) -> Propellor Result) -> Propellor Result -setPassword user getpassword = getpassword $ \password -> makeChange $ - withHandle StdinHandle createProcessSuccess - (proc "chpasswd" []) $ \h -> do - hPutStrLn h $ user ++ ":" ++ password +setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result +setPassword getpassword = getpassword $ go + where + go (Password user, password) = set user password [] + go (CryptPassword user, hash) = set user hash ["--encrypted"] + go (f, _) = error $ "Unexpected type of privdata: " ++ show f + + set user v ps = makeChange $ withHandle StdinHandle createProcessSuccess + (proc "chpasswd" ps) $ \h -> do + hPutStrLn h $ user ++ ":" ++ v hClose h lockedPassword :: UserName -> Property diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -11,10 +11,37 @@ | SshPrivKey SshKeyType UserName | SshAuthorizedKeys UserName | Password UserName + | CryptPassword UserName | PrivFile FilePath | GpgKey deriving (Read, Show, Ord, Eq) +-- | Combines a PrivDataField with a description of how to generate +-- its value. +data PrivDataSource + = PrivDataSourceFile PrivDataField FilePath + | PrivDataSourceFileFromCommand PrivDataField FilePath String + | PrivDataSource PrivDataField String + +class IsPrivDataSource s where + privDataField :: s -> PrivDataField + describePrivDataSource :: s -> Maybe String + +instance IsPrivDataSource PrivDataField where + privDataField = id + describePrivDataSource _ = Nothing + +instance IsPrivDataSource PrivDataSource where + privDataField s = case s of + PrivDataSourceFile f _ -> f + PrivDataSourceFileFromCommand f _ _ -> f + PrivDataSource f _ -> f + describePrivDataSource s = Just $ case s of + PrivDataSourceFile _ f -> "< " ++ f + PrivDataSourceFileFromCommand _ f c -> + "< " ++ f ++ " (created by running, for example, `" ++ c ++ "` )" + PrivDataSource _ d -> "< (" ++ d ++ ")" + -- | A context in which a PrivDataField is used. -- -- Often this will be a domain name. For example, @@ -63,3 +90,11 @@ data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519 deriving (Read, Show, Ord, Eq) + +-- | Parameter that would be passed to ssh-keygen to generate key of this type +sshKeyTypeParam :: SshKeyType -> String +sshKeyTypeParam SshRsa = "RSA" +sshKeyTypeParam SshDsa = "DSA" +sshKeyTypeParam SshEcdsa = "ECDSA" +sshKeyTypeParam SshEd25519 = "ED25519" +