Ssh.permitRootLogin type changed to allow configuring WithoutPassword and ForcedCommandsOnly (API change)

* Ssh.permitRootLogin type changed to allow configuring WithoutPassword
  and ForcedCommandsOnly (API change)
* setSshdConfig type changed, and setSshdConfigBool added with old type.

config-joey.hs

@@ -441,7 +441,7 @@ jerryPlay = standardDockerContainer "jerryplay" Unstable "amd64"
 	& Docker.publish "8001:80"
 	& Apt.installed ["ssh"]
 	& User.hasSomePassword (User "root")
-	& Ssh.permitRootLogin True
+	& Ssh.permitRootLogin (Ssh.RootLogin True)
 
 kiteShellBox :: Systemd.Container
 kiteShellBox = standardStableContainer "kiteshellbox"

debian/changelog

@@ -1,3 +1,11 @@
+propellor (2.7.0) UNRELEASED; urgency=medium
+
+  * Ssh.permitRootLogin type changed to allow configuring WithoutPassword
+    and ForcedCommandsOnly (API change)
+  * setSshdConfig type changed, and setSshdConfigBool added with old type.
+
+ -- Joey Hess <id@joeyh.name>  Mon, 20 Jul 2015 12:01:38 -0400
+
 propellor (2.6.0) unstable; urgency=medium
 
   * Replace String type synonym Docker.Image by a data type

src/Propellor/Property/Ssh.hs

@@ -1,7 +1,10 @@
 module Propellor.Property.Ssh (
 	PubKeyText,
 	sshdConfig,
+	ConfigKeyword,
+	setSshdConfigBool,
 	setSshdConfig,
+	RootLogin(..),
 	permitRootLogin,
 	passwordAuthentication,
 	noPasswords,
@@ -28,6 +31,7 @@ import Utility.FileMode
 
 import System.PosixCompat
 import qualified Data.Map as M
+import Data.List
 
 type PubKeyText = String
 
@@ -38,21 +42,37 @@ sshBool False = "no"
 sshdConfig :: FilePath
 sshdConfig = "/etc/ssh/sshd_config"
 
-setSshdConfig :: String -> Bool -> Property NoInfo
-setSshdConfig setting allowed = combineProperties "sshd config"
-	[ sshdConfig `File.lacksLine` (sshline $ not allowed)
-	, sshdConfig `File.containsLine` (sshline allowed)
-	]
-	`onChange` restarted
-	`describe` unwords [ "ssh config:", setting, sshBool allowed ]
-  where
-	sshline v = setting ++ " " ++ sshBool v
+type ConfigKeyword = String
 
-permitRootLogin :: Bool -> Property NoInfo
-permitRootLogin = setSshdConfig "PermitRootLogin"
+setSshdConfigBool :: ConfigKeyword -> Bool -> Property NoInfo
+setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed)
+
+setSshdConfig :: ConfigKeyword -> String -> Property NoInfo
+setSshdConfig setting val = File.fileProperty desc f sshdConfig
+	`onChange` restarted
+  where
+	desc = unwords [ "ssh config:", setting, val ]
+	cfgline = setting ++ " " ++ val
+	wantedline s
+		| s == cfgline = True
+		| (setting ++ " ") `isPrefixOf` s = False
+		| otherwise = True
+	f ls 
+		| cfgline `elem` ls = filter wantedline ls
+		| otherwise = filter wantedline ls ++ [cfgline]
+
+data RootLogin
+	= RootLogin Bool  -- ^ allow or prevent root login
+	| WithoutPassword -- ^ disable password authentication for root, while allowing other authentication methods
+	| ForcedCommandsOnly -- ^ allow root login with public-key authentication, but only if a forced command has been specified for the public key
+
+permitRootLogin :: RootLogin -> Property NoInfo
+permitRootLogin (RootLogin b) = setSshdConfigBool "PermitRootLogin" b
+permitRootLogin WithoutPassword = setSshdConfig "PermitRootLogin" "without-password"
+permitRootLogin ForcedCommandsOnly = setSshdConfig "PermitRootLogin" "forced-commands-only"
 
 passwordAuthentication :: Bool -> Property NoInfo
-passwordAuthentication = setSshdConfig "PasswordAuthentication"
+passwordAuthentication = setSshdConfigBool "PasswordAuthentication"
 
 -- | Configure ssh to not allow password logins.
 --