Merge branch 'joeyconfig'

Conflicts:
	privdata.joey/privdata.gpg

config-joey.hs

@@ -74,6 +74,9 @@ darkstar = host "darkstar.kitenet.net"
 	& Docker.configured
 	! Docker.docked gitAnnexAndroidDev
 
+	& JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")
+	& JoeySites.dkimMilter
+
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	[ "Unreliable server. Anything here may be lost at any time!" ]
@@ -226,7 +229,6 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64"
 	& alias "git.joeyh.name"
 	& JoeySites.gitServer hosts
 	
-	& alias "downloads.kitenet.net"
 	& JoeySites.annexWebSite "/srv/git/downloads.git"
 		"downloads.kitenet.net"
 		"840760dc-08f0-11e2-8c61-576b7e66acfd"
@@ -234,7 +236,7 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64"
 		`requires` Ssh.keyImported SshRsa "joey" (Context "downloads.kitenet.net")
 		`requires` Ssh.knownHost hosts "eubackup.kitenet.net" "joey"
 	& JoeySites.gitAnnexDistributor
-		& alias "tmp.kitenet.net"
+
 	& JoeySites.annexWebSite "/srv/git/joey/tmp.git"
 		"tmp.kitenet.net"
 		"26fd6e38-1226-11e2-a75f-ff007033bdba"
@@ -242,6 +244,11 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64"
 	& JoeySites.twitRss
 	& JoeySites.pumpRss
 	
+	& JoeySites.annexWebSite "/srv/git/user-liberation.git"
+		"user-liberation.joeyh.name"
+		"da89f112-808b-420a-b468-d990ae2e5b52"
+		[]
+		
 	& alias "nntp.olduse.net"
 	& alias "resources.olduse.net"
 	& JoeySites.oldUseNetServer hosts
@@ -249,10 +256,10 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64"
 	& alias "ns2.kitenet.net"
 	& myDnsPrimary False "kitenet.net" []
 	& myDnsPrimary True "joeyh.name" []
-	& myDnsPrimary False "ikiwiki.info" []
+	& myDnsPrimary True "ikiwiki.info" []
-	& myDnsPrimary False "olduse.net"
+	& myDnsPrimary True "olduse.net"
-		[ (RelDomain "article",
+		[ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk")
-			CNAME $ AbsDomain "virgil.koldfront.dk") ]
+		]
 
 	& alias "ns3.branchable.com"
 	& branchableSecondary
@@ -307,6 +314,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
 	& Docker.docked openidProvider
 		`requires` Apt.serviceInstalledRunning "ntp"
 	& Docker.docked ancientKitenet
+	& Docker.docked jerryPlay
 	& Docker.garbageCollected `period` (Weekly (Just 1))
 	
 	-- For https port 443, shellinabox with ssh login to
@@ -364,6 +372,15 @@ gitAnnexAndroidDev = GitAnnexBuilder.androidContainer dockerImage "android-git-a
   where
 	gitannexdir = GitAnnexBuilder.homedir </> "git-annex"
 	
+jerryPlay :: Docker.Container
+jerryPlay = standardContainer "jerryplay" Unstable "amd64"
+	& alias "jerryplay.kitenet.net"
+	& Docker.publish "2202:22"
+	& Docker.publish "8001:80"
+	& Apt.installed ["ssh"]
+	& User.hasSomePassword "root"
+	& Ssh.permitRootLogin True
+
 type Motd = [String]
 
 -- This is my standard system setup.
@@ -441,6 +458,7 @@ myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly No
 	, (RootDomain, MX 0 $ AbsDomain "kitenet.net")
 	-- SPF only allows IP address of kitenet.net to send mail.
 	, (RootDomain, TXT "v=spf1 a:kitenet.net -all")
+	, JoeySites.domainKey
 	] ++ extras
 
 

debian/changelog

@@ -1,8 +1,10 @@
-propellor (1.3.2) UNRELEASED; urgency=medium
+propellor (1.3.2) unstable; urgency=medium
 
   * SSHFP records are also generated for CNAMES of hosts.
+  * Merge Utiity modules from git-annex.
+  * Ignore bogus DNS when spinning the local host.
 
- -- Joey Hess <id@joeyh.name>  Sun, 04 Jan 2015 21:25:42 -0400
+ -- Joey Hess <id@joeyh.name>  Thu, 15 Jan 2015 14:02:07 -0400
 
 propellor (1.3.1) unstable; urgency=medium
 

propellor.cabal

@@ -1,5 +1,5 @@
 Name: propellor
-Version: 1.3.1
+Version: 1.3.2
 Cabal-Version: >= 1.6
 License: BSD3
 Maintainer: Joey Hess <id@joeyh.name>

src/Propellor/PrivData.hs

@@ -83,7 +83,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 		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 ++ "'"
+			putStrLn $ "  propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "' \\"
 			maybe noop (\d -> putStrLn $ "    " ++ d) (describePrivDataSource src)
 			putStrLn ""
 		return FailedChange

src/Propellor/Property/SiteSpecific/JoeySites.hs

@@ -17,7 +17,6 @@ import qualified Propellor.Property.Apache as Apache
 import qualified Propellor.Property.Postfix as Postfix
 import Utility.SafeCommand
 import Utility.FileMode
-import Utility.Path
 
 import Data.List
 import System.Posix.Files
@@ -193,6 +192,7 @@ annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)]
 annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex")
 	[ Git.cloned "joey" origin dir Nothing
 		`onChange` setup
+	, alias hn
 	, postupdatehook `File.hasContent`
 		[ "#!/bin/sh"
 		, "exec git update-server-info"
@@ -209,6 +209,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
 		, "git config annex.uuid " ++ shellEscape uuid
 		] ++ map addremote remotes ++
 		[ "git annex get"
+		, "git update-server-info"
 		]
 	addremote (name, url) = "git remote add " ++ shellEscape name ++ " " ++ shellEscape url
 	setupapache = toProp $ Apache.siteEnabled hn $ apachecfg hn True $ 
@@ -311,6 +312,7 @@ twitRss = combineProperties "twitter rss"
 		"./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss")
 
 -- Work around for expired ssl cert.
+-- (no longer expired, TODO remove this and change urls)
 pumpRss :: Property
 pumpRss = Cron.job "pump rss" "15 * * * *" "joey" "/srv/web/tmp.kitenet.net/"
 	"wget https://pump2rss.com/feed/joeyh@identi.ca.atom -O pump.atom --no-check-certificate 2>/dev/null"
@@ -319,7 +321,7 @@ ircBouncer :: Property
 ircBouncer = propertyList "IRC bouncer"
 	[ Apt.installed ["znc"]
 	, User.accountFor "znc"
-	, File.dirExists (parentDir conf)
+	, File.dirExists (takeDirectory conf)
 	, File.hasPrivContent conf anyContext
 	, File.ownerGroup conf "znc" "znc"
 	, Cron.job "znconboot" "@reboot" "znc" "~" "znc"
@@ -443,6 +445,8 @@ kiteMailServer = propertyList "kitenet.net mail server"
 		`describe` "amavisd-milter configured for postfix"
 	, Apt.serviceInstalledRunning "clamav-freshclam"
 
+	, dkimInstalled
+
 	, Apt.installed ["maildrop"]
 	, "/etc/maildroprc" `File.hasContent`
 		[ "# Global maildrop filter file (deployed with propellor)"
@@ -461,8 +465,7 @@ kiteMailServer = propertyList "kitenet.net mail server"
 	, "/etc/aliases" `File.hasPrivContentExposed` ctx
 		`onChange` Postfix.newaliases
 	, hasJoeyCAChain
-	, "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
+	, hasPostfixCert ctx
-	, "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
 
 	, "/etc/postfix/mydomain" `File.containsLines`
 		[ "/.*\\.kitenet\\.net/\tOK"
@@ -473,13 +476,13 @@ kiteMailServer = propertyList "kitenet.net mail server"
 		`describe` "postfix mydomain file configured"
 	, "/etc/postfix/obscure_client_relay.pcre" `File.hasContent`
 		-- Remove received lines for mails relayed from trusted
-		-- clients. These can be a privacy vilation, or trigger
+		-- clients. These can be a privacy violation, or trigger
 		-- spam filters.
 		[ "/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE"
 		-- Munge local Received line for postfix running on a
 		-- trusted client that relays through. These can trigger
 		-- spam filters.
-		, "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE Received: by kitenet.net"
+		, "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE X-Question: 42"
 		]
 		`onChange` Postfix.reloaded
 		`describe` "postfix obscure_client_relay file configured"
@@ -511,9 +514,13 @@ kiteMailServer = propertyList "kitenet.net mail server"
 		, "# Enable postgrey."
 		, "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023"
 
-		, "# Enable spamass-milter and amavis-milter."
+		, "# Enable spamass-milter, amavis-milter, opendkim"
-		, "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock"
+		, "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock inet:localhost:8891"
+		, "# opendkim is used for outgoing mail"
+		, "non_smtpd_milters = inet:localhost:8891"
 		, "milter_connect_macros = j {daemon_name} v {if_name} _"
+		, "# If a milter is broken, fall back to just accepting mail."
+		, "milter_default_action = accept"
 
 		, "# TLS setup -- server"
 		, "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"
@@ -581,10 +588,70 @@ kiteMailServer = propertyList "kitenet.net mail server"
 	pinescript = "/usr/local/bin/pine"
 	dovecotusers = "/etc/dovecot/users"
 
+-- Configures postfix to relay outgoing mail to kitenet.net, with
+-- verification via tls cert.
+postfixClientRelay :: Context -> Property
+postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`
+	[ "relayhost = kitenet.net"
+	, "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"
+	, "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"
+	, "smtp_tls_key_file = /etc/ssl/private/postfix.pem"
+	, "smtp_tls_loglevel = 0"
+	, "smtp_use_tls = yes"
+	]
+	`describe` "postfix client relay"
+	`onChange` Postfix.dedupMainCf
+	`onChange` Postfix.reloaded
+	`requires` hasJoeyCAChain
+	`requires` hasPostfixCert ctx
+
+-- Configures postfix to have the dkim milter, and no other milters.
+dkimMilter :: Property
+dkimMilter = Postfix.mainCfFile `File.containsLines`
+	[ "smtpd_milters = inet:localhost:8891"
+	, "non_smtpd_milters = inet:localhost:8891"
+	, "milter_default_action = accept"
+	]
+	`describe` "postfix dkim milter"
+	`onChange` Postfix.dedupMainCf
+	`onChange` Postfix.reloaded
+	`requires` dkimInstalled
+
+-- This does not configure postfix to use the dkim milter,
+-- nor does it set up domainkey DNS.
+dkimInstalled :: Property
+dkimInstalled = propertyList "opendkim installed"
+	[ Apt.serviceInstalledRunning "opendkim"
+	, File.dirExists "/etc/mail"
+	, File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net")
+	, File.ownerGroup "/etc/mail/dkim.key" "opendkim" "opendkim"
+	, "/etc/default/opendkim" `File.containsLine`
+		"SOCKET=\"inet:8891@localhost\""
+	, "/etc/opendkim.conf" `File.containsLines`
+		[ "KeyFile /etc/mail/dkim.key"
+		, "SubDomains yes"
+		, "Domain *"
+		, "Selector mail"
+		]
+	]
+	`onChange` Service.restarted "opendkim"
+
+-- This is the dkim public key, corresponding with /etc/mail/dkim.key
+-- This value can be included in a domain's additional records to make
+-- it use this domainkey.
+domainKey :: (BindDomain, Record)
+domainKey = (RelDomain "mail._domainkey", TXT "v=DKIM1; k=rsa; t=y; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB")
+
 hasJoeyCAChain :: Property
 hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
 	Context "joeyca.pem"
 
+hasPostfixCert :: Context -> Property
+hasPostfixCert ctx = combineProperties "postfix tls cert installed"
+	[ "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
+	, "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
+	]
+
 kitenetHttps :: Property
 kitenetHttps = propertyList "kitenet.net https certs"
 	[ File.hasPrivContent "/etc/ssl/certs/web.pem" ctx

src/Propellor/Shim.hs

@@ -9,7 +9,6 @@ module Propellor.Shim (setup, cleanEnv, file) where
 import Propellor
 import Utility.LinuxMkLibs
 import Utility.SafeCommand
-import Utility.Path
 import Utility.FileMode
 import Utility.FileSystemEncoding
 
@@ -34,7 +33,7 @@ setup propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do
 	let linker = (dest ++) $ 
 		fromMaybe (error "cannot find ld-linux linker") $
 			headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
-	let gconvdir = (dest ++) $ parentDir $
+	let gconvdir = (dest ++) $ takeDirectory $
 		fromMaybe (error "cannot find gconv directory") $
 			headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
 	let linkerparams = ["--library-path", intercalate ":" libdirs ]
@@ -75,5 +74,5 @@ installFile top f = do
 	createLink f dest `catchIO` (const copy)
   where
 	copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
-	destdir = inTop top $ parentDir f
+	destdir = inTop top $ takeDirectory f
 	dest = inTop top f

src/Propellor/Spin.hs

@@ -112,6 +112,12 @@ getSshTarget target hst
 	useip why = case headMaybe configips of
 		Nothing -> return target
 		Just ip -> do
+			-- If we're being asked to run on the local host,
+			-- ignore DNS.
+			s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
+			if s == target
+				then return target
+				else do
 					warningMessage $ "DNS seems out of date for " ++ target ++ " (" ++ why ++ "); using IP address from configuration instead."
 					return ip
 

src/Utility/Applicative.hs

@@ -1,6 +1,6 @@
 {- applicative stuff
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/Data.hs

@@ -1,6 +1,6 @@
 {- utilities for simple data types
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/Env.hs

@@ -1,6 +1,6 @@
 {- portable environment variables
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}
@@ -14,6 +14,7 @@ import Utility.Exception
 import Control.Applicative
 import Data.Maybe
 import qualified System.Environment as E
+import qualified System.SetEnv
 #else
 import qualified System.Posix.Env as PE
 #endif
@@ -39,27 +40,27 @@ getEnvironment = PE.getEnvironment
 getEnvironment = E.getEnvironment
 #endif
 
-{- Returns True if it could successfully set the environment variable.
+{- Sets an environment variable. To overwrite an existing variable,
+ - overwrite must be True.
  -
- - There is, apparently, no way to do this in Windows. Instead,
+ - On Windows, setting a variable to "" unsets it. -}
- - environment varuables must be provided when running a new process. -}
+setEnv :: String -> String -> Bool -> IO ()
-setEnv :: String -> String -> Bool -> IO Bool
 #ifndef mingw32_HOST_OS
-setEnv var val overwrite = do
+setEnv var val overwrite = PE.setEnv var val overwrite
-	PE.setEnv var val overwrite
-	return True
 #else
-setEnv _ _ _ = return False
+setEnv var val True = System.SetEnv.setEnv var val
+setEnv var val False = do
+	r <- getEnv var
+	case r of
+		Nothing -> setEnv var val True
+		Just _ -> return ()
 #endif
 
-{- Returns True if it could successfully unset the environment variable. -}
+unsetEnv :: String -> IO ()
-unsetEnv :: String -> IO Bool
 #ifndef mingw32_HOST_OS
-unsetEnv var = do
+unsetEnv = PE.unsetEnv
-	PE.unsetEnv var
-	return True
 #else
-unsetEnv _ = return False
+unsetEnv = System.SetEnv.unsetEnv
 #endif
 
 {- Adds the environment variable to the input environment. If already

src/Utility/FileSystemEncoding.hs

@@ -1,6 +1,6 @@
 {- GHC File system encoding handling.
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/LinuxMkLibs.hs

@@ -1,6 +1,6 @@
 {- Linux library copier and binary shimmer
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}
@@ -10,6 +10,7 @@ module Utility.LinuxMkLibs where
 import Control.Applicative
 import Data.Maybe
 import System.Directory
+import System.FilePath
 import Data.List.Utils
 import System.Posix.Files
 import Data.Char
@@ -28,14 +29,14 @@ installLib installfile top lib = ifM (doesFileExist lib)
 	( do
 		installfile top lib
 		checksymlink lib
-		return $ Just $ parentDir lib
+		return $ Just $ takeDirectory lib
 	, return Nothing
 	)
   where
 	checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
 		l <- readSymbolicLink (inTop top f)
-		let absl = absPathFrom (parentDir f) l
+		let absl = absPathFrom (takeDirectory f) l
-		let target = relPathDirToFile (parentDir f) absl
+		let target = relPathDirToFile (takeDirectory f) absl
 		installfile top absl
 		nukeFile (top ++ f)
 		createSymbolicLink target (inTop top f)

src/Utility/Misc.hs

@@ -1,6 +1,6 @@
 {- misc utility functions
  -
- - Copyright 2010-2011 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/Monad.hs

@@ -1,6 +1,6 @@
 {- monadic stuff
  -
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/Path.hs

@@ -1,6 +1,6 @@
 {- path manipulation
  -
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}
@@ -21,6 +21,7 @@ import Control.Applicative
 import qualified System.FilePath.Posix as Posix
 #else
 import System.Posix.Files
+import Utility.Exception
 #endif
 
 import qualified "MissingH" System.Path as MissingH
@@ -76,14 +77,12 @@ absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos
 	todos = replace "/" "\\"
 #endif
 
-{- Returns the parent directory of a path.
+{- Just the parent directory of a path, or Nothing if the path has no
- -
+ - parent (ie for "/") -}
- - To allow this to be easily used in loops, which terminate upon reaching the
+parentDir :: FilePath -> Maybe FilePath
- - top, the parent of / is "" -}
-parentDir :: FilePath -> FilePath
 parentDir dir
-	| null dirs = ""
+	| null dirs = Nothing
-	| otherwise = joinDrive drive (join s $ init dirs)
+	| otherwise = Just $ joinDrive drive (join s $ init dirs)
   where
 	-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
 	(drive, path) = splitDrive dir
@@ -93,8 +92,8 @@ parentDir dir
 prop_parentDir_basics :: FilePath -> Bool
 prop_parentDir_basics dir
 	| null dir = True
-	| dir == "/" = parentDir dir == ""
+	| dir == "/" = parentDir dir == Nothing
-	| otherwise = p /= dir
+	| otherwise = p /= Just dir
   where
 	p = parentDir dir
 
@@ -255,7 +254,9 @@ fileNameLengthLimit :: FilePath -> IO Int
 fileNameLengthLimit _ = return 255
 #else
 fileNameLengthLimit dir = do
-	l <- fromIntegral <$> getPathVar dir FileNameLimit
+	-- getPathVar can fail due to statfs(2) overflow
+	l <- catchDefaultIO 0 $
+		fromIntegral <$> getPathVar dir FileNameLimit
 	if l <= 0
 		then return 255
 		else return $ minimum [l, 255]
@@ -267,7 +268,8 @@ fileNameLengthLimit dir = do
  - sane FilePath.
  -
  - All spaces and punctuation and other wacky stuff are replaced
- - with '_', except for '.' "../" will thus turn into ".._", which is safe.
+ - with '_', except for '.'
+ - "../" will thus turn into ".._", which is safe.
  -}
 sanitizeFilePath :: String -> FilePath
 sanitizeFilePath = map sanitize

src/Utility/PosixFiles.hs

@@ -2,7 +2,7 @@
  -
  - This is like System.PosixCompat.Files, except with a fixed rename.
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/QuickCheck.hs

@@ -1,6 +1,6 @@
 {- QuickCheck with additional instances
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/SafeCommand.hs

@@ -1,6 +1,6 @@
 {- safely running shell commands
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/Scheduled.hs

@@ -1,6 +1,6 @@
 {- scheduled activities
  - 
- - Copyright 2013-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}

src/Utility/ThreadScheduler.hs

@@ -1,6 +1,6 @@
 {- thread scheduling
  -
- - Copyright 2012, 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
  - Copyright 2011 Bas van Dijk & Roel van Dijk
  -
  - License: BSD-2-clause
@@ -57,8 +57,7 @@ unboundDelay time = do
 waitForTermination :: IO ()
 waitForTermination = do
 #ifdef mingw32_HOST_OS
-	runEvery (Seconds 600) $
+	forever $ threadDelaySeconds (Seconds 6000)
-		void getLine
 #else
 	lock <- newEmptyMVar
 	let check sig = void $

src/Utility/UserInfo.hs

@@ -1,6 +1,6 @@
 {- user info
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
  - License: BSD-2-clause
  -}
@@ -13,8 +13,10 @@ module Utility.UserInfo (
 	myUserGecos,
 ) where
 
-import Control.Applicative
 import System.PosixCompat
+#ifndef mingw32_HOST_OS
+import Control.Applicative
+#endif
 
 import Utility.Env
 
@@ -40,16 +42,20 @@ myUserName = myVal env userName
 	env = ["USERNAME", "USER", "LOGNAME"]
 #endif
 
-myUserGecos :: IO String
+myUserGecos :: IO (Maybe String)
-#ifdef __ANDROID__
+-- userGecos crashes on Android and is not available on Windows.
-myUserGecos = return "" -- userGecos crashes on Android
+#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
+myUserGecos = return Nothing
 #else
-myUserGecos = myVal [] userGecos
+myUserGecos = Just <$> myVal [] userGecos
 #endif
 
 myVal :: [String] -> (UserEntry -> String) -> IO String
-myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars
+myVal envvars extract = go envvars
   where
-	check [] = return Nothing
+#ifndef mingw32_HOST_OS
-	check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v
+	go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID)
-	getpwent = getUserEntryForID =<< getEffectiveUserID
+#else
+	go [] = error $ "environment not set: " ++ show envvars
+#endif
+	go (v:vs) = maybe (go vs) return =<< getEnv v