prepare for hackage

13 files changed, 0 insertions, 486 deletions

diff --git a/Property/Apt.hs b/Property/Apt.hs
deleted file mode 100644
index b89fb30b..00000000
--- a/Property/Apt.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-module Property.Apt where
-
-import Data.Maybe
-import Control.Applicative
-import Data.List
-import System.IO
-import Control.Monad
-
-import Common
-import qualified Property.File as File
-import Property.File (Line)
-
-sourcesList :: FilePath
-sourcesList = "/etc/apt/sources.list"
-
-type Url = String
-type Section = String
-
-data Suite = Stable | Testing | Unstable | Experimental
-	deriving Show
-
-showSuite :: Suite -> String
-showSuite Stable = "stable"
-showSuite Testing = "testing"
-showSuite Unstable = "unstable"
-showSuite Experimental = "experimental"
-
-debLine :: Suite -> Url -> [Section] -> Line
-debLine suite mirror sections = unwords $
-	["deb", mirror, showSuite suite] ++ sections
-
-srcLine :: Line -> Line
-srcLine l = case words l of
-	("deb":rest) -> unwords $ "deb-src" : rest
-	_ -> ""
-
-stdSections :: [Section]
-stdSections = ["main", "contrib", "non-free"]
-
-debCdn :: Suite -> [Line]
-debCdn suite = [l, srcLine l]
-  where
-	l = debLine suite "http://cdn.debian.net/debian" stdSections
-
-{- Makes sources.list have a standard content using the mirror CDN,
- - with a particular Suite. -}
-stdSourcesList :: Suite -> Property
-stdSourcesList suite = setSourcesList (debCdn suite)
-	`describe` ("standard sources.list for " ++ show suite)
-
-setSourcesList :: [Line] -> Property
-setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
-
-runApt :: [CommandParam] -> Property
-runApt ps = cmdProperty' "apt-get" ps env
-  where
-	env =
-		[ ("DEBIAN_FRONTEND", "noninteractive")
-		, ("APT_LISTCHANGES_FRONTEND", "none")
-		]
-
-update :: Property
-update = runApt [Param "update"]
-	`describe` "apt update"
-
-upgrade :: Property
-upgrade = runApt [Params "-y dist-upgrade"]
-	`describe` "apt dist-upgrade"
-
-type Package = String
-
-installed :: [Package] -> Property
-installed ps = check (isInstallable ps) go
-	`describe` (unwords $ "apt installed":ps)
-  where
-	go = runApt $ [Param "-y", Param "install"] ++ map Param ps
-
-removed :: [Package] -> Property
-removed ps = check (or <$> isInstalled' ps) go
-	`describe` (unwords $ "apt removed":ps)
-  where
-	go = runApt $ [Param "-y", Param "remove"] ++ map Param ps
-
-isInstallable :: [Package] -> IO Bool
-isInstallable ps = do
-	l <- isInstalled' ps
-	return $ any (== False) l && not (null l)
-
-isInstalled :: Package -> IO Bool
-isInstalled p = (== [True]) <$> isInstalled' [p]
-
-{- Note that the order of the returned list will not always
- - correspond to the order of the input list. The number of items may
- - even vary. If apt does not know about a package at all, it will not
- - be included in the result list. -}
-isInstalled' :: [Package] -> IO [Bool]
-isInstalled' ps = catMaybes . map parse . lines
-	<$> readProcess "apt-cache" ("policy":ps)
-  where
-	parse l
-		| "Installed: (none)" `isInfixOf` l = Just False
-		| "Installed: " `isInfixOf` l = Just True
-		| otherwise = Nothing
-
-autoRemove :: Property
-autoRemove = runApt [Param "-y", Param "autoremove"]
-	`describe` "apt autoremove"
-
-unattendedUpgrades :: Bool -> Property
-unattendedUpgrades enabled =
-	(if enabled then installed else removed) ["unattended-upgrades"]
-	`onChange` reConfigure "unattended-upgrades"
-		[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
-	`describe` ("unattended upgrades " ++ v)
-  where
-	v
-		| enabled = "true"
-		| otherwise = "false"
-
-{- Preseeds debconf values and reconfigures the package so it takes
- - effect. -}
-reConfigure :: Package -> [(String, String, String)] -> Property
-reConfigure package vals = reconfigure `requires` setselections
-	`describe` ("reconfigure " ++ package)
-  where
-	setselections = Property "preseed" $ makeChange $
-		withHandle StdinHandle createProcessSuccess
-			(proc "debconf-set-selections" []) $ \h -> do
-				forM_ vals $ \(template, tmpltype, value) ->
-					hPutStrLn h $ unwords [package, template, tmpltype, value]
-				hClose h
-	reconfigure = cmdProperty "dpkg-reconfigure" [Param "-fnone", Param package]
diff --git a/Property/Cmd.hs b/Property/Cmd.hs
deleted file mode 100644
index 278d2fb0..00000000
--- a/Property/Cmd.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Property.Cmd (
-	cmdProperty,
-	cmdProperty',
-	scriptProperty,
-	module Utility.SafeCommand
-) where
-
-import Control.Applicative
-import Data.List
-
-import Types
-import Utility.Monad
-import Utility.SafeCommand
-import Utility.Env
-
-cmdProperty :: String -> [CommandParam] -> Property
-cmdProperty cmd params = cmdProperty' cmd params []
-
-cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
-cmdProperty' cmd params env = Property desc $ do
-	env' <- addEntries env <$> getEnvironment
-	ifM (boolSystemEnv cmd params (Just env'))
-		( return MadeChange
-		, return FailedChange
-		)
-  where
-  	desc = unwords $ cmd : map showp params
-	showp (Params s) = s
-	showp (Param s) = s
-	showp (File s) = s
-
-scriptProperty :: [String] -> Property
-scriptProperty script = cmdProperty "sh" [Param "-c", Param shellcmd]
-  where
-	shellcmd = intercalate " ; " ("set -e" : script)
diff --git a/Property/Docker.hs b/Property/Docker.hs
deleted file mode 100644
index ebb3d3a4..00000000
--- a/Property/Docker.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Property.Docker where
-
-import Common
-import qualified Property.File as File
-import qualified Property.Apt as Apt
-
-{- Configures docker with an authentication file, so that images can be
- - pushed to index.docker.io. -}
-configured :: Property
-configured = Property "docker configured" go `requires` installed
-  where
-	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ 
-		"/root/.dockercfg" `File.hasContent` (lines cfg)
-	
-installed :: Property
-installed = Apt.installed ["docker.io"]
diff --git a/Property/File.hs b/Property/File.hs
deleted file mode 100644
index 55ca4fec..00000000
--- a/Property/File.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-module Property.File where
-
-import Common
-
-type Line = String
-
-{- Replaces all the content of a file. -}
-hasContent :: FilePath -> [Line] -> Property
-f `hasContent` newcontent = fileProperty ("replace " ++ f)
-	(\_oldcontent -> newcontent) f
-
-{- Ensures that a line is present in a file, adding it to the end if not. -}
-containsLine :: FilePath -> Line -> Property
-f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
-  where
-	go ls
-		| l `elem` ls = ls
-		| otherwise = ls++[l]
-
-{- Ensures that a line is not present in a file.
- - Note that the file is ensured to exist, so if it doesn't, an empty
- - file will be written. -}
-lacksLine :: FilePath -> Line -> Property
-f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
-
-{- Note: Does not remove symlinks or non-plain-files. -}
-notPresent :: FilePath -> Property
-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 =<< doesFileExist f
-  where
-	go True = do
-		ls <- lines <$> catchDefaultIO [] (readFile f)
-		let ls' = a ls
-		if ls' == ls
-			then noChange
-			else makeChange $ viaTmp writeFile f (unlines ls')
-	go False = makeChange $ writeFile f (unlines $ a [])
diff --git a/Property/GitHome.hs b/Property/GitHome.hs
deleted file mode 100644
index 99402b8e..00000000
--- a/Property/GitHome.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-module Property.GitHome where
-
-import Common
-import qualified Property.Apt as Apt
-import Property.User
-
-{- Clones Joey Hess's git home directory, and runs its fixups script. -}
-installedFor :: UserName -> Property
-installedFor user = check (not <$> hasGitDir user) $ 
-	Property ("githome " ++ user) (go =<< homedir user)
-		`requires` Apt.installed ["git", "myrepos"]
-  where
- 	go Nothing = noChange
-	go (Just home) = do
-		let tmpdir = home </> "githome"
-		ok <- boolSystem "git" [Param "clone", Param url, Param tmpdir]
-			<&&> (and <$> moveout tmpdir home)
-			<&&> (catchBoolIO $ removeDirectory tmpdir >> return True)
-			<&&> boolSystem "su" [Param "-c", Param "cd; rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups", Param user]
-		return $ if ok then MadeChange else FailedChange
-	moveout tmpdir home = do
-		fs <- dirContents tmpdir
-		forM fs $ \f -> boolSystem "mv" [File f, File home]
-	url = "git://git.kitenet.net/joey/home"
-
-hasGitDir :: UserName -> IO Bool
-hasGitDir user = go =<< homedir user
-  where
-	go Nothing = return False
-	go (Just home) = doesDirectoryExist (home </> ".git")
diff --git a/Property/Hostname.hs b/Property/Hostname.hs
deleted file mode 100644
index 204ff5d4..00000000
--- a/Property/Hostname.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Property.Hostname where
-
-import Common
-import qualified Property.File as File
-
-set :: HostName -> Property
-set hostname = "/etc/hostname" `File.hasContent` [hostname]
-	`onChange` cmdProperty "hostname" [Param hostname]
-	`describe` ("hostname " ++ hostname)
diff --git a/Property/JoeySites.hs b/Property/JoeySites.hs
deleted file mode 100644
index 92279aeb..00000000
--- a/Property/JoeySites.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{- Specific configuation for Joey Hess's sites. Probably not useful to
- - others except as an example. -}
-
-module Property.JoeySites where
-
-import Common
-import qualified Property.Apt as Apt
-
-oldUseNetshellBox :: Property
-oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $
-	propertyList ("olduse.net shellbox")
-		[ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
-			`describe` "olduse.net build deps"
-		, scriptProperty
-			[ "rm -rf /root/tmp/oldusenet" -- idenpotency
-			, "git clone git://olduse.net/ /root/tmp/oldusenet/source"
-			, "cd /root/tmp/oldusenet/source/"
-			, "dpkg-buildpackage -us -uc"
-			, "dpkg -i ../oldusenet*.deb || true"
-			, "apt-get -fy install" -- dependencies
-			, "rm -rf /root/tmp/oldusenet"
-			] `describe` "olduse.net built"
-		]
diff --git a/Property/Network.hs b/Property/Network.hs
deleted file mode 100644
index cd98100d..00000000
--- a/Property/Network.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module Property.Network where
-
-import Common
-import Property.File
-
-interfaces :: FilePath
-interfaces = "/etc/network/interfaces"
-
--- 6to4 ipv6 connection, should work anywhere
-ipv6to4 :: Property
-ipv6to4 = fileProperty "ipv6to4" go interfaces
-	`onChange` ifUp "sit0"
-  where
-	go ls
-		| all (`elem` ls) stanza = ls
-		| otherwise = ls ++ stanza
-	stanza =
-		[ "# Automatically added by propeller"
-		, "iface sit0 inet6 static"
-		, "\taddress 2002:5044:5531::1"
-		, "\tnetmask 64"
-		, "\tgateway ::192.88.99.1"
-		, "# End automatically added by propeller"
-		]
-
-ifUp :: String -> Property
-ifUp iface = cmdProperty "ifup" [Param iface]
diff --git a/Property/Reboot.hs b/Property/Reboot.hs
deleted file mode 100644
index 9b06f07c..00000000
--- a/Property/Reboot.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Property.Reboot where
-
-import Common
-
-now :: Property
-now = cmdProperty "reboot" []
-	`describe` "reboot now"
diff --git a/Property/Ssh.hs b/Property/Ssh.hs
deleted file mode 100644
index c726bedd..00000000
--- a/Property/Ssh.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-module Property.Ssh where
-
-import Common
-import qualified Property.File as File
-import Property.User
-
-sshBool :: Bool -> String
-sshBool True = "yes"
-sshBool False = "no"
-
-sshdConfig :: FilePath
-sshdConfig = "/etc/ssh/sshd_config"
-
-setSshdConfig :: String -> Bool -> Property
-setSshdConfig setting allowed = combineProperties
-	[ sshdConfig `File.lacksLine` (sshline $ not allowed)
-	, sshdConfig `File.containsLine` (sshline allowed)
-	]
-	`onChange` restartSshd
-	`describe` unwords [ "ssh config:", setting, sshBool allowed ]
-  where
-	sshline v = setting ++ " " ++ sshBool v
-
-permitRootLogin :: Bool -> Property
-permitRootLogin = setSshdConfig "PermitRootLogin"
-
-passwordAuthentication :: Bool -> Property
-passwordAuthentication = setSshdConfig "PasswordAuthentication"
-
-hasAuthorizedKeys :: UserName -> IO Bool
-hasAuthorizedKeys = go <=< homedir
-  where
-	go Nothing = return False
-	go (Just home) = not . null <$> catchDefaultIO ""
-		(readFile $ home </> ".ssh" </> "authorized_keys")
-
-restartSshd :: Property
-restartSshd = cmdProperty "service" [Param "ssh", Param "restart"]
-
-{- Blow away existing host keys and make new ones. Use a flag
- - file to prevent doing this more than once. -}
-uniqueHostKeys :: Property
-uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
-	`onChange` restartSshd
-  where
-	prop = Property "ssh unique host keys" $ do
-		void $ boolSystem "sh"
-			[ Param "-c"
-			, Param "rm -f /etc/ssh/ssh_host_*"
-			]
-		ensureProperty $
-			cmdProperty "/var/lib/dpkg/info/openssh-server.postinst"
-				[Param "configure"]
diff --git a/Property/Sudo.hs b/Property/Sudo.hs
deleted file mode 100644
index f341a3eb..00000000
--- a/Property/Sudo.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-module Property.Sudo where
-
-import Data.List
-
-import Common
-import Property.File
-import qualified Property.Apt as Apt
-import Property.User
-
-{- Allows a user to sudo. If the user has a password, sudo is configured
- - to require it. If not, NOPASSWORD is enabled for the user.
- -
- - TOOD: Full sudoers file format parse.. 
- -}
-enabledFor :: UserName -> Property
-enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
-  where
-	go = do
-		locked <- isLockedPassword user
-		ensureProperty $
-			fileProperty desc
-				(modify locked . filter (wanted locked))
-				"/etc/sudoers"
-	desc = user ++ " is sudoer"
-	sudobaseline = user ++ " ALL=(ALL:ALL)"
-	sudoline True = sudobaseline ++ " NOPASSWD:ALL"
-	sudoline False = sudobaseline ++ " ALL"
-	wanted locked l
-		| not (sudobaseline `isPrefixOf` l) = True
-		| "NOPASSWD" `isInfixOf` l = locked
-		| otherwise = True
- 	modify locked ls
-		| sudoline locked `elem` ls = ls
-		| otherwise = ls ++ [sudoline locked]
diff --git a/Property/Tor.hs b/Property/Tor.hs
deleted file mode 100644
index f7182120..00000000
--- a/Property/Tor.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Property.Tor where
-
-import Common
-import qualified Property.File as File
-import qualified Property.Apt as Apt
-
-isBridge :: Property
-isBridge = setup `requires` Apt.installed ["tor"]
-	`describe` "tor bridge"
-  where
-	setup = "/etc/tor/torrc" `File.hasContent`
-		[ "SocksPort 0"
-		, "ORPort 443"
-		, "BridgeRelay 1"
-		, "Exitpolicy reject *:*"
-		] `onChange` restartTor
-
-restartTor :: Property
-restartTor = cmdProperty "service" [Param "tor", Param "restart"]
diff --git a/Property/User.hs b/Property/User.hs
deleted file mode 100644
index 6bdff2ea..00000000
--- a/Property/User.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-module Property.User where
-
-import System.Posix
-
-import Common
-
-data Eep = YesReallyDeleteHome
-
-sshAccountFor :: UserName -> Property
-sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
-	[ Param "--disabled-password"
-	, Param "--gecos", Param ""
-	, Param user
-	]
-	`describe` ("ssh account " ++ user)
-
-{- Removes user home directory!! Use with caution. -}
-nuked :: UserName -> Eep -> Property
-nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
-	[ Param "-r"
-	, Param user
-	]
-	`describe` ("nuked user " ++ user)
-
-{- Only ensures that the user has some password set. It may or may
- - not be the password from the PrivData. -}
-hasSomePassword :: UserName -> Property
-hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
-	hasPassword user
-
-hasPassword :: UserName -> Property
-hasPassword user = Property (user ++ " has password") $
-	withPrivData (Password user) $ \password -> makeChange $
-		withHandle StdinHandle createProcessSuccess
-			(proc "chpasswd" []) $ \h -> do
-				hPutStrLn h $ user ++ ":" ++ password
-				hClose h
-
-lockedPassword :: UserName -> Property
-lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
-	[ Param "--lock"
-	, Param user
-	]
-	`describe` ("locked " ++ user ++ " password")
-
-data PasswordStatus = NoPassword | LockedPassword | HasPassword
-	deriving (Eq)
-
-getPasswordStatus :: UserName -> IO PasswordStatus
-getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user]
-  where
-	parse (_:"L":_) = LockedPassword
-	parse (_:"NP":_) = NoPassword
-	parse (_:"P":_) = HasPassword
-	parse _ = NoPassword
-
-isLockedPassword :: UserName -> IO Bool
-isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
-
-homedir :: UserName -> IO (Maybe FilePath)
-homedir user = catchMaybeIO $ homeDirectory <$> getUserEntryForName user