Merge branch 'joeyconfig'

Propellor/Property/Git.hs

@@ -86,4 +86,8 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
 			[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
 			, Just $ "cd " ++ shellEscape dir
 			, ("git checkout " ++) <$> mbranch
+			-- In case this repo is exposted via the web,
+			-- although the hook to do this ongoing is not
+			-- installed here.
+			, Just "git update-server-info"
 			]

Propellor/Property/SiteSpecific/JoeySites.hs

@@ -15,6 +15,7 @@ import qualified Propellor.Property.User as User
 import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Apache as Apache
 import Utility.SafeCommand
+import Utility.FileMode
 
 import Data.List
 import System.Posix.Files
@@ -183,10 +184,16 @@ annexWebSite :: [Host] -> Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.
 annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using git-annex")
 	[ Git.cloned "joey" origin dir Nothing
 		`onChange` setup
+	, postupdatehook `File.hasContent`
+		[ "#!/bin/sh"
+		, "exec git update-server-info"
+		] `onChange`
+			(postupdatehook `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes)))
 	, setupapache
 	]
   where
 	dir = "/srv/web/" ++ hn
+	postupdatehook = dir </> ".git/hooks/post-update"
 	setup = userScriptProperty "joey" setupscript
 		`requires` Ssh.keyImported SshRsa "joey"
 		`requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"

Propellor/SimpleSh.hs

@@ -70,13 +70,17 @@ simpleSh namedpipe = do
 
 simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
 simpleShClient namedpipe cmd params handler = do
+	debug ["simplesh connecting"]
 	s <- socket AF_UNIX Stream defaultProtocol
 	connect s (SockAddrUnix namedpipe)
 	h <- socketToHandle s ReadWriteMode
 	hPutStrLn h $ show $ Cmd cmd params
 	hFlush h
+	debug ["simplesh sent command"]
 	resps <- catMaybes . map readish . lines <$> hGetContents h
-	hClose h `after` handler resps
+	v <- hClose h `after` handler resps
+	debug ["simplesh processed response"]
+	return v
 
 simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
 simpleShClientRetry retries namedpipe cmd params handler = go retries
@@ -88,7 +92,8 @@ simpleShClientRetry retries namedpipe cmd params handler = go retries
 			v <- tryIO run
 			case v of
 				Right r -> return r
-				Left _ -> do
+				Left e -> do
+					debug ["simplesh connection retry", show e]
 					threadDelaySeconds (Seconds 1)
 					go (n - 1)
 

config-joey.hs

@@ -1,4 +1,5 @@
 -- This is the live config file used by propellor's author.
+module Main where
 
 import Propellor
 import Propellor.CmdLine
@@ -19,6 +20,7 @@ import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Git as Git
 import qualified Propellor.Property.Apache as Apache
 import qualified Propellor.Property.Postfix as Postfix
+import qualified Propellor.Property.Service as Service
 import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
 import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
 import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
@@ -73,6 +75,11 @@ hosts =               --                  (o)  `
 
 		& Docker.garbageCollected `period` Daily
 		& Apt.installed ["git-annex", "mtr", "screen"]
+
+		-- Nothing is using https on clam, so listen on that port
+		-- for ssh, for traveling on bad networks.
+		& "/etc/ssh/sshd_config" `File.containsLine` "Port 443"
+			`onChange` Service.restarted "ssh"
 	
 	-- Orca is the main git-annex build box.
 	, standardSystem "orca.kitenet.net" Unstable "amd64"

doc/todo/docker_todo_list.mdwn

@@ -6,3 +6,6 @@
   need ntp installed for a good date source.
 * Docking a container in a host should add to the host any cnames that
   are assigned to the container.
+* It seems that provisionContainer sometimes hangs when the container
+  is already running. This seems likely to be a problem with the simpleSh
+  socket hack.

propellor.hs

@@ -12,6 +12,8 @@
 -- The source is either copied from /usr/src/propellor, or is cloned from
 -- git over the network.
 
+module Main where
+
 import Utility.UserInfo
 import Utility.Monad
 import Utility.Process