Merge branch 'joeyconfig'

This commit is contained in:
Joey Hess 2014-05-01 10:49:52 -03:00
commit 6088df9105
6 changed files with 30 additions and 2 deletions

View File

@ -86,4 +86,8 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null" [ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
, Just $ "cd " ++ shellEscape dir , Just $ "cd " ++ shellEscape dir
, ("git checkout " ++) <$> mbranch , ("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"
] ]

View File

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

View File

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

View File

@ -1,4 +1,5 @@
-- This is the live config file used by propellor's author. -- This is the live config file used by propellor's author.
module Main where
import Propellor import Propellor
import Propellor.CmdLine 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.Git as Git
import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.Apache as Apache
import qualified Propellor.Property.Postfix as Postfix 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.GitHome as GitHome
import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
@ -74,6 +76,11 @@ hosts = -- (o) `
& Docker.garbageCollected `period` Daily & Docker.garbageCollected `period` Daily
& Apt.installed ["git-annex", "mtr", "screen"] & 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. -- Orca is the main git-annex build box.
, standardSystem "orca.kitenet.net" Unstable "amd64" , standardSystem "orca.kitenet.net" Unstable "amd64"
& ipv4 "138.38.108.179" & ipv4 "138.38.108.179"

View File

@ -6,3 +6,6 @@
need ntp installed for a good date source. need ntp installed for a good date source.
* Docking a container in a host should add to the host any cnames that * Docking a container in a host should add to the host any cnames that
are assigned to the container. 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.

View File

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