summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-04-13 11:58:22 -0400
committerJoey Hess2014-04-13 11:58:22 -0400
commit456dd534ce2984535a9fc36bad2aff9e6ee2863a (patch)
treea981748a5c0a62c67832969c9e852c5741780821 /Propellor
parent6d1263043112d0c70ae8d76fcbc998e6d853fafa (diff)
propellor spin
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/Property/File.hs34
-rw-r--r--Propellor/Property/OpenId.hs13
-rw-r--r--Propellor/Property/Ssh.hs1
-rw-r--r--Propellor/Types.hs2
4 files changed, 38 insertions, 12 deletions
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 10dee75e..d8caf366 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -1,8 +1,10 @@
module Propellor.Property.File where
import Propellor
+import Utility.FileMode
import System.Posix.Files
+import System.PosixCompat.Types
type Line = String
@@ -12,11 +14,15 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
(\_oldcontent -> newcontent) f
-- | Ensures a file has contents that comes from PrivData.
--- Note: Does not do anything with the permissions of the file to prevent
--- it from being seen.
+--
+-- The file's permissions are preserved if the file already existed.
+-- Otherwise, they're set to 600.
hasPrivContent :: FilePath -> Property
-hasPrivContent f = Property ("privcontent " ++ f) $
- withPrivData (PrivFile f) (\v -> ensureProperty $ f `hasContent` lines v)
+hasPrivContent f = Property desc $ withPrivData (PrivFile f) $ \privcontent ->
+ ensureProperty $ fileProperty' writeFileProtected desc
+ (\_oldcontent -> lines privcontent) f
+ where
+ desc = "privcontent " ++ f
-- | Ensures that a line is present in a file, adding it to the end if not.
containsLine :: FilePath -> Line -> Property
@@ -38,7 +44,9 @@ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
makeChange $ nukeFile f
fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
-fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
+fileProperty = fileProperty' writeFile
+fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property
+fileProperty' writer desc a f = Property desc $ go =<< liftIO (doesFileExist f)
where
go True = do
ls <- liftIO $ lines <$> readFile f
@@ -46,13 +54,15 @@ fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
if ls' == ls
then noChange
else makeChange $ viaTmp updatefile f (unlines ls')
- go False = makeChange $ writeFile f (unlines $ a [])
+ go False = makeChange $ writer f (unlines $ a [])
-- viaTmp makes the temp file mode 600.
- -- Replicate the original file mode before moving it into place.
+ -- Replicate the original file's owner and mode.
updatefile f' content = do
- writeFile f' content
- getFileStatus f >>= setFileMode f' . fileMode
+ writer f' content
+ s <- getFileStatus f
+ setFileMode f' (fileMode s)
+ setOwnerAndGroup f' (fileOwner s) (fileGroup s)
-- | Ensures a directory exists.
dirExists :: FilePath -> Property
@@ -68,3 +78,9 @@ ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
else noChange
where
og = owner ++ ":" ++ group
+
+-- | Ensures that a file/dir has the specfied mode.
+mode :: FilePath -> FileMode -> Property
+mode f v = Property (f ++ " mode " ++ show v) $ do
+ liftIO $ modifyFileMode f (\_old -> v)
+ noChange
diff --git a/Propellor/Property/OpenId.hs b/Propellor/Property/OpenId.hs
index c397bdb8..b896180f 100644
--- a/Propellor/Property/OpenId.hs
+++ b/Propellor/Property/OpenId.hs
@@ -4,8 +4,10 @@ import Propellor
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
+import Utility.FileMode
import Data.List
+import System.Posix.Files
providerFor :: [UserName] -> String -> Property
providerFor users baseurl = propertyList desc $
@@ -16,11 +18,18 @@ providerFor users baseurl = propertyList desc $
(map setbaseurl) "/etc/simpleid/config.inc"
] ++ map identfile users
where
- identfile u = File.hasPrivContent $ concat
- [ "/var/lib/simpleid/identities/", u, ".identity" ]
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
| "SIMPLEID_BASE_URL" `isInfixOf` l =
"define('SIMPLEID_BASE_URL', '"++url++"');"
| otherwise = l
+
+ identfile u = combineProperties desc
+ [ File.hasPrivContent f
+ -- the identitites directory controls access, so open up
+ -- file mode
+ , File.mode f (combineModes (ownerWriteMode:readModes))
+ ]
+ where
+ f = concat $ [ "/var/lib/simpleid/identities/", u, ".identity" ]
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index cb3b9231..6bfe1261 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -117,6 +117,7 @@ keyImported keytype user = combineProperties desc
fromKeyType :: SshKeyType -> String
fromKeyType SshRsa = "rsa"
fromKeyType SshDsa = "dsa"
+fromKeyType SshEcdsa = "ecdsa"
-- | Puts some host's ssh public key into the known_hosts file for a user.
knownHost :: [Host] -> HostName -> UserName -> Property
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index dd66eb01..b8f8f167 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -174,5 +174,5 @@ data PrivDataField
type GpgKeyId = String
-data SshKeyType = SshRsa | SshDsa
+data SshKeyType = SshRsa | SshDsa | SshEcdsa
deriving (Read, Show, Ord, Eq)